R/get_authentication_tokens.R

In charlesschwabapi: Wrapper Functions Around 'Charles Schwab Individual Trader API'

#' Get Authentication Tokens
#'
#' Given the app key, redirect uri, and app secret, this function
#' will walk the user through the process to gather the appropriate
#' authentication tokens (access token and refresh token) and store
#' them in the user's specified location (if no location is specified,
#' it will store the tokens in the user's working directory). Note that
#' the tokens are saved in an RDS file via a list since additional
#' metadata is captured in addition to the tokens (such as the expiration
#' of those tokens to help with knowing when to refresh). After this function
#' is initially called, be sure use the same path to the token for future calls
#' along with maintaining the default name that is used for
#' the RDS file to avoid manual reauthentication whenever possible.
#' This function will always first look to see if an RDS file exists
#' at the specified path and with the default name to check if tokens
#' are valid or expired. Authentication requires no user intervention
#' when the refresh token is valid. User intervention (via the login
#' method through a separate browser) is only required when both the
#' access token and the refresh token are expired.
#'
#' @return Returns a message on whether the authentication
#'         was successful or not along with token information
#'         (if successful, NULL otherwise), including the path
#'         to where the token RDS object is saved.
#' @author Nick Bultman, \email{njbultman74@@gmail.com}, June 2024
#' @keywords authentication tokens
#' @importFrom httr POST add_headers status_code content
#' @importFrom utils browseURL
#' @importFrom stringr str_sub str_locate
#' @importFrom openssl base64_encode
#' @importFrom lubridate minutes days
#' @export
#'
#' @param app_key application key generated by Charles Schwab (character)
#' @param redirect_uri redirect URI specified when registering application (character)
#' @param app_secret application secret generated by Charles Schwab (character)
#' @param token_save_path path to current token or where you would like token stored. Default is the working directory (character)
#'
get_authentication_tokens <- function(app_key,
                                      redirect_uri,
                                      app_secret,
                                      token_save_path = getwd()) {
  # Check to make sure app_key, redirect_uri, app_secret, and token_save_path are strings # nolint
  if (!is.character(app_key) || !is.character(redirect_uri) || !is.character(app_secret) || !is.character(token_save_path)) { # nolint
     stop("app_key, redirect_uri, app_secret, and token_save_path must all be strings.") # nolint
  }
  # Create variables for base URLs
  token_url <- "https://api.schwabapi.com/v1/oauth/token"
  login_url <- "https://api.schwabapi.com/v1/oauth/authorize?&client_id="
  # Check to see if token is already saved in an RDS file
  if (file.exists(paste0(token_save_path,
                         "/charlesschwabapi_tokens.rds"))) {
    # If tokens are already saved, load the RDS file
    tokens <- readRDS(paste0(token_save_path,
                             "/charlesschwabapi_tokens.rds"))
    # Check to see if access token and/or refresh token are expired
    access_token_expire <- ifelse(tokens$access_token_exp > Sys.time(),
                                  "Valid",
                                  "Expired")
    refresh_token_expire <- ifelse(tokens$refresh_token_exp > Sys.time(),
                                   "Valid",
                                   "Expired")
    # If no RDS file found, but both access/refresh tokens as expired
  } else {
    access_token_expire <- "Expired"
    refresh_token_expire <- "Expired"
  }
  # If access/refresh tokens valid, return the RDS object with no changes and inform user # nolint
  if (access_token_expire == "Valid" && refresh_token_expire == "Valid") {
    message("Access/refresh tokens both valid. Returning same tokens.")
    resp <- tokens
  }
  # If refresh token valid, refresh access token via refresh token
  else { #nolint
    if (refresh_token_expire == "Valid") {
      # Generate payload
      payload <- list("grant_type" = "refresh_token",
                      "refresh_token" = tokens$refresh_token)
      # Send POST request
      pg <- httr::POST(url = token_url,
                       body = payload,
                       httr::add_headers(`Authorization` = paste0("Basic ", openssl::base64_encode(paste0(app_key, ":", app_secret))[1]), # nolint
                                        `Content-Type` = "application/x-www-form-urlencoded"), # nolint
                       encode = "form")
    }
    # If refresh token expired, authenticate via authorization code
    else if (refresh_token_expire == "Expired") { # nolint
      # Determine appropriate URL for login information
      login_page <- paste0(login_url,
                           app_key,
                           "&redirect_uri=",
                           redirect_uri)
      # Open login page in browser
      suppressMessages(utils::browseURL(login_page))
      # Create variable for returned URL after login (split by whether interactive session or not) # nolint
      if (interactive()) {
        # Inform user what to do when login page launched
        message("Enter login credentials in the opening web page.\nWhen finished, copy and paste the URL into the console below and hit enter.\n") # nolint
        return_url <- readLines(stdin(), n = 1)
      } else {
        # Inform user what to do when login page launched
        cat("Enter login credentials in the opening web page.\nWhen finished, copy and paste the URL into the console below and hit enter.\n") # nolint
        return_url <- readLines("stdin", n = 1)
      }
      # Get CS code
      csapi_code <- paste0(stringr::str_sub(return_url,
                                            start = stringr::str_locate(return_url, # nolint
                                                                    pattern = "code=")[2] + 1, # nolint
                                            end = stringr::str_locate(return_url, # nolint
                                                                    pattern = "%40&")[1] - 1), # nolint
                           "@")
      # Generate payload
      payload <- list("grant_type" = "authorization_code",
                      "code" = csapi_code,
                      "redirect_uri" = redirect_uri)
      # Send POST request
      pg <- httr::POST(url = token_url,
                       body = payload,
                       httr::add_headers(`Authorization` = paste0("Basic ", openssl::base64_encode(paste0(app_key, ":", app_secret))[1]), # nolint
                                        `Content-Type` = 'application/x-www-form-urlencoded'), # nolint
                       encode = "form")
    }
    # If status code is 200 (success), save token
    if (httr::status_code(pg) == 200) {
      token_time <- as.POSIXct(pg[["date"]],
                               tz = Sys.timezone(),
                               origin = "1970-01-01")
      # Access token expires in 30 minutes
      access_token_exp <- token_time + lubridate::minutes(30)
      # If refresh token is valid, keep same expiration value
      if (refresh_token_expire == "Valid") {
        refresh_token_exp <- tokens$refresh_token_exp
      } else {
        # Otherwise, add seven days to the new token time
        refresh_token_exp <- token_time + lubridate::days(7)
      }
      resp <- httr::content(pg)
      resp <- c(resp,
        list(access_token_exp = access_token_exp,
          refresh_token_exp = refresh_token_exp
        )
      )
      # Save token information list in RDS object at user specified location
      saveRDS(resp, paste0(token_save_path, "/charlesschwabapi_tokens.rds"))
      # Inform user of success and return object to user
      message(paste0("Authentication succcessful. Tokens saved at: ",
                     token_save_path, "/charlesschwabapi_tokens.rds"))
      # Otherwise, stop program and inform user
    } else {
      stop("Error in authentication: Check your refresh token (as applicable), app_key, app_secret, and redirect_uri.") # nolint
    }
  }
  # Return final response object to user (whether modified or not)
  return(resp)
}