From 70f310ec0d25a526935cd6a410d0a39fdf364cf8 Mon Sep 17 00:00:00 2001 From: Candace Savonen Date: Fri, 13 Dec 2024 13:53:50 -0500 Subject: [PATCH] Update git auth --- R/auth.R | 268 +++++++++++++++------- R/github_handling.R | 166 ++++++-------- R/leanpub.R | 10 +- R/token-handlers.R | 163 +++++++++++++ tests/testthat/test-quarto_leanpub_prep.R | 11 +- tests/testthat/test-rmd_leanpub_prep.R | 8 +- 6 files changed, 444 insertions(+), 182 deletions(-) create mode 100644 R/token-handlers.R diff --git a/R/auth.R b/R/auth.R index 25cb2a06..cccfe16a 100644 --- a/R/auth.R +++ b/R/auth.R @@ -1,124 +1,238 @@ -.tokenEnv <- new.env(parent = emptyenv()) -.tokenEnv$Token <- NULL - -# Set token to environment -set_token <- function(value) { - .tokenEnv$Token <- value - return(value) -} - -# Get token from environment -get_token <- function() { - .tokenEnv$Token -} - -### Declare all the scopes -scopes_list <- c( - "https://www.googleapis.com/auth/drive", - "https://www.googleapis.com/auth/drive.file", - "https://www.googleapis.com/auth/drive.readonly", - "https://www.googleapis.com/auth/presentations", - "https://www.googleapis.com/auth/presentations.readonly" -) - - -#' Authorize R package to access the Google Slides API -#' @description This is a function to authorize the R package to access the Google Slides API interactively. -#' @param token An output from \code{\link{oauth2.0_token}} to set as the authentication token. -#' @param cache Should the token be cached as an .httr-oauth file? +#' Authorize R package to access endpoints +#' @description This is a function to authorize the R package to access APIs interactively. To learn more about the privacy policy for ottrpal [read here](https://www.ottrproject.org/privacypolicy.html) +#' @param app_name app would you like to authorize? Supported apps are 'google' 'calendly' and 'github' +#' @param cache Should the token be cached as an .httr-oauth file or API keys stored as global options? #' @param ... Additional arguments to send to \code{\link{oauth2.0_token}} -#' @return OAuth token saved to the environment so the package can use the users' Google data -#' @importFrom utils menu installed.packages +#' @return API token saved to the environment or the cache so it can be grabbed by functions +#' @importFrom utils menu installed.packages browseURL #' @importFrom httr oauth_app oauth_endpoints oauth2.0_token +#' @importFrom stringr str_to_title #' @export #' @examples \dontrun{ #' #' authorize() +#' +#' authorize("github") +#' +#' authorize("google") +#' #' } -authorize <- function(token = NULL, cache = FALSE, ...) { +authorize <- function(app_name = NULL, + cache = FALSE, + ...) { + # Ask the user what app they would like to authorize + if (is.null(app_name)) { + app_names <- names(supported_endpoints()) + titlecase_app_names <- stringr::str_to_title(app_names) + + endpoint_index <- menu(titlecase_app_names, title = "Which app would you like to authorize?") + + # Extract info from supported endpoints list + endpoint <- supported_endpoints()[endpoint_index] + + # Set app name based on selection + app_name <- names(endpoint) + } + + # Check if token already exists + token_status <- check_for_tokens(app_name) + + if (any(token_status)) { + message(paste0("Credentials found for ", paste0(stringr::str_to_title(names(token_status)[token_status]), collapse = ", "))) + message("Do you want to overwrite these with new credentials?") + use_old <- menu(c("Yes, overwrite the credentials", "No, I'll use these credentials and stop this function.")) + if (use_old == 2) stop("Using old credentials") + } + if (!cache) { - cache_it <- menu(c("Yes store credentials as .httr-oauth file", "No do not store credentials, I will re-run this authorize() in my next R session")) + message("Would you like to store/cache your credentials?") + cache_it <- menu(c("Yes cache/store credentials", "No do not store credentials, I will re-run this authorize() in my next R session")) if (cache_it == 1) { - message("You chose to cache your credentials, if you change your mind, just delete the .httr-oauth. Be careful not to push this file to GitHub or share it anywhere.") + message("You chose to cache your credentials, if you change your mind, run ottrpal::delete_creds(). \nBe careful not to push the cache files to GitHub or share it anywhere. \n") } } else { cache_it <- 1 } - if (is.null(token)) { + + if (app_name == "github") { + # Open up browser to have them create a key + browseURL("https://github.com/settings/tokens/new?description=GH_PAT&scopes=repo,read:packages,read:org") + message("On the opened page, scroll down and click 'Generate Token'.") + + # Store api key here + token <- getPass::getPass(msg = "Paste token here and press enter: ") + + # Check that token + if (!grepl("ghp", token)) stop("This doesn't look like a GitHub Personal Access token. https://docs.github.com/en/authentication/keeping-your-account-and-data-secure/managing-your-personal-access-tokens") + + # If they chose to cache it, we'll store it in rds file format + if (cache_it == 1) cache_token(token, "github") + } + + if (app_name == "google") { + scopes_list <- unlist(find_scopes(app_name)) + token <- httr::oauth2.0_token( - endpoint = app_set_up()$endpoint, - app = app_set_up()$app, - cache = cache_it == 1, + endpoint = app_set_up(app_name)$endpoint, + app = app_set_up(app_name)$app, scope = scopes_list, + cache = cache_it == 1, ... ) + googledrive::drive_auth(token = token) + googlesheets4::gs4_auth(token = token) + + # If they chose to cache it, we'll store it in rds file format + if (cache_it == 1) cache_token(token, "google") } - set_token(token) - return(invisible(token)) + set_token(token = token, app_name = app_name) + + invisible(token) } -#' Use secrets to authorize R package to access Google Slides API -#' @description This is a function to authorize the R package to access the Google Slides API. If no -#' client.id and client.secret is provided, the package would provide predefined values. -#' @param access_token Access token can be obtained from running authorize() interactively: token <-authorize(); token$credentials$access_token -#' @param refresh_token Refresh token can be obtained from running authorize() interactively: token <-authorize(); token$credentials$refresh_token -#' @return OAuth token saved to the environment so the package can use the users' Google data +################################################################################ +#' Delete cached ottrpal credentials +#' @description This is a function to delete cached creds and creds in the current environment that were set by ottrpal +#' @param app_name which app would you like to delete the creds for? Default is to delete the creds for all. +#' @export +#' @return Cached credentials are deleted and report is given back +#' @examples \dontrun{ +#' +#' delete_creds("google") +#' } +delete_creds <- function(app_name = "all") { + supported <- names(supported_endpoints()) + + if (!(app_name %in% c("all", supported))) stop("That is not a supported app or endpoint") + + ## Checking for the existence of cached creds + github_creds_exist <- !is.null(getOption("github")) + google_creds_exist <- !is.null(getOption("google")) + + github_cache_exist <- file.exists(file.path(cache_secrets_folder(), "github.RDS")) + google_cache_exist <- file.exists(file.path(cache_secrets_folder(), "google.RDS")) + + # Do any exist? + none_exist <- all( + !github_creds_exist, !google_creds_exist, + !github_cache_exist, !google_cache_exist + ) + + if (none_exist) { + message("No cached creds to delete (from ottrpal anyway). Done") + } else { + if (app_name == "all" | app_name == "github") { + if (github_creds_exist) { + remove_token("github") + message("GitHub creds deleted from environment") + } + if (github_cache_exist) { + remove_cache("github") + message("GitHub creds deleted from cache") + } + } + if (app_name == "all" | app_name == "google") { + if (google_creds_exist) { + remove_token("google") + message("Cached Google token removed from environment") + } + if (google_cache_exist) { + remove_cache("google") + message("Cached Google creds removed from cache") + } + } + } +} + +#' Use secrets to authorize R package to access endpoints +#' @description This is a function to authorize ottrpal to access calendly, github or google noninteractively from passing in a keys or tokens. +#' @param app_name Which app are you trying to authorize? 'google', 'calendly' or 'github'? +#' @param token For calendly or github, pass in the API key or Personal Access Token that you have set up from going to https://github.com/settings/tokens/new or https://calendly.com/integrations/api_webhooks respectively. +#' @param cache Should the credentials be cached? TRUE or FALSE? +#' @param access_token For Google, access token can be obtained from running authorize interactively: token <-authorize(); token$credentials$access_token +#' @param refresh_token For Google, refresh token can be obtained from running authorize interactively: token <-authorize(); token$credentials$refresh_token +#' @param in_test If setting up auth in a test, set to TRUE so that way the authorization doesn't stick +#' @return OAuth token saved to the environment so the package access the API data #' @importFrom utils menu installed.packages #' @importFrom httr oauth_app oauth_endpoints oauth2.0_token -#' @importFrom openssl aes_cbc_decrypt #' @export #' @examples \dontrun{ #' -#' token <- authorize() +#' # Example for GitHub +#' # You go to https://github.com/settings/tokens/new to get a Personal Access Token +#' auth_from_secret("github", token = "ghp_a_github_pat_here") #' +#' # Example for authorizing for Google +#' token <- authorize("google") #' auth_from_secret( -#' token$credentials$access_token, -#' token$credentials$refresh_token +#' app_name = "google", +#' access_token = token$credentials$access_token, +#' refresh_token = token$credentials$refresh_token #' ) #' } #' -auth_from_secret <- function(access_token = NULL, refresh_token = NULL) { - # If no tokens are specified, we'll grab the default ones. - if (is.null(access_token) | is.null(refresh_token)) { - decrypted <- openssl::aes_cbc_decrypt( - readRDS(encrypt_creds_user_path()), - key = readRDS(key_encrypt_creds_path()) - ) - access_token <- unserialize(decrypted)[[1]]$access_token - refresh_token <- unserialize(decrypted)[[1]]$refresh_token +auth_from_secret <- function(app_name, token, access_token, refresh_token, cache = FALSE, + in_test = FALSE) { + if (app_name %in% c("github", "calendly") && is.null(token)) { + stop("For GitHub and Calendly, token cannot be NULL") } - credentials <- list( - access_token = access_token, - expires_in = 3599L, - refresh_token = refresh_token, - scope = scopes_list, - token_type = "Bearer" - ) + if (app_name == "google") { + if (is.null(access_token) || is.null(refresh_token)) { + stop("For Google auth, need access_token and refresh_token cannot be NULL") + } + scopes_list <- unlist(find_scopes(app_name)) - token <- httr::oauth2.0_token( - endpoint = app_set_up()$endpoint, - app = app_set_up()$app, - scope = scopes_list, - credentials = credentials - ) + credentials <- list( + access_token = access_token, + expires_in = 3599L, + refresh_token = refresh_token, + scope = scopes_list, + token_type = "Bearer" + ) + + token <- httr::oauth2.0_token( + endpoint = app_set_up(app_name)$endpoint, + app = app_set_up(app_name)$app, + cache = cache, + scope = scopes_list, + credentials = credentials + ) + googledrive::drive_auth(token = token) + } - set_token(token) - return(invisible(token)) + if (cache) { + message("You chose to cache your credentials, if you change your mind, run ottrpal::delete_creds(). + \n Be careful not to push .httr-oauth or RDS files to GitHub or share it anywhere.") + cache_token(token, app_name = app_name) + } + # Store the token in the environment + set_token(app_name = app_name, token, in_test = in_test) + + invisible(token) } +#' App Set Up +#' @description This is a function that sets up the app. It's generally called by another function +#' @param app_name app would you like to authorize? Supported apps are 'google' 'calendly' and 'github' +#' @importFrom utils menu installed.packages +#' @importFrom httr oauth_app oauth_endpoints oauth2.0_token +#' # This sets up the app creds no matter which way authorization is called -app_set_up <- function() { +app_set_up <- function(app_name = "google") { decrypted <- openssl::aes_cbc_decrypt( - readRDS(encrypt_creds_path()), + readRDS(encrypt_creds_path("google")), key = readRDS(key_encrypt_creds_path()) ) + app <- httr::oauth_app( appname = "ottrpal", key = unserialize(decrypted)$client_id, secret = unserialize(decrypted)$client_secret ) - endpoint <- httr::oauth_endpoints("google") - return(list(app = app, endpoint = endpoint)) + endpoint_url <- httr::oauth_endpoints("google") + + return(list(app = app, endpoint = endpoint_url)) } + diff --git a/R/github_handling.R b/R/github_handling.R index 949d9849..34124118 100644 --- a/R/github_handling.R +++ b/R/github_handling.R @@ -1,13 +1,43 @@ +#' Handler function for GET requests from GitHub +#' @description This is a function to get the GitHub user's info +#' @param token You can provide the Personal Access Token key directly or this function will attempt to grab a PAT that was stored using the `authorize("github")` function +#' @param url What is the URL endpoint we are attempting to grab here? +#' @return Information regarding a Github account +#' @importFrom utils menu installed.packages +#' @importFrom httr oauth_app oauth_endpoints oauth2.0_token +#' @export +get_github <- function(token = NULL, url) { + if (is.null(token)) { + # Get auth token + token <- get_token(app_name = "github") + } + + # Github api get + result <- httr::GET( + url, + httr::add_headers(Authorization = paste0("Bearer ", token)), + httr::accept_json() + ) + + if (httr::status_code(result) != 200) { + httr::stop_for_status(result) + } + + # Process and return results + result_content <- httr::content(result, "text") + result_list <- jsonlite::fromJSON(result_content) + + return(result_list) +} + #' Retrieve pages url for a repo #' #' Given an repository on GitHub, retrieve the pages URL for it. #' #' @param repo_name The full name of the repo to get bookdown chapters from. #' e.g. "jhudsl/OTTR_Template" -#' @param git_pat If private repositories are to be retrieved, a github personal -#' access token needs to be supplied. If none is supplied, then this will attempt to -#' grab from a git pat set in the environment with usethis::create_github_token(). -#' Authorization handled by \link[cow]{get_git_auth} +#' @param token If private repositories are to be retrieved, a github personal +#' access token needs to be supplied. Run `authorize("github")` to set this. #' @param verbose TRUE/FALSE do you want more progress messages? #' @param keep_json verbose TRUE/FALSE keep the json file locally? #' @@ -26,25 +56,22 @@ #' get_pages_url("jhudsl/Documentation_and_Usability") #' } get_pages_url <- function(repo_name, - git_pat = NULL, + token = NULL, verbose = FALSE, keep_json = FALSE) { page_url <- NA # Try to get credentials other way - auth_arg <- get_git_auth(git_pat = git_pat, quiet = !verbose) - - git_pat <- try(auth_arg$password, silent = TRUE) - - if (grepl("Error", git_pat[1])) { - warning("Cannot retrieve page info without GitHub credentials. Passing an NA.") + if (is.null(token)) { + # Get auth token + token <- get_token(app_name = "github") } # We can only retrieve pages if we have the credentials - if (!grepl("Error", git_pat[1])) { + if (!grepl("Error", token[1])) { exists <- check_git_repo( repo_name = repo_name, - git_pat = git_pat, + token = token, verbose = FALSE ) @@ -52,7 +79,7 @@ get_pages_url <- function(repo_name, # Get repo info repo_info <- get_repo_info( repo_name = repo_name, - git_pat = git_pat + token = token ) # Declare URL @@ -61,7 +88,7 @@ get_pages_url <- function(repo_name, # Github api get response <- httr::GET( url, - httr::add_headers(Authorization = paste0("token ", auth_arg$password)), + httr::add_headers(Authorization = paste0("token ", token)), httr::accept_json() ) @@ -87,7 +114,7 @@ get_pages_url <- function(repo_name, #' #' @param repo_name The full name of the repo to get bookdown chapters from. #' e.g. "jhudsl/OTTR_Template" -#' @param git_pat If private repositories are to be retrieved, a github personal +#' @param token If private repositories are to be retrieved, a github personal #' access token needs to be supplied. If none is supplied, then this will attempt to #' grab from a git pat set in the environment with usethis::create_github_token(). #' Authorization handled by \link[githubr]{get_git_auth} @@ -107,14 +134,22 @@ get_pages_url <- function(repo_name, #' @examples #' #' repo_info <- get_repo_info("jhudsl/Documentation_and_Usability") +#' get_repo_info <- function(repo_name, - git_pat = NULL, + token = NULL, verbose = FALSE) { + + # Try to get credentials other way + if (is.null(token)) { + # Get auth token + token <- get_token(app_name = "github") + } + repo_info <- NA exists <- check_git_repo( repo_name = repo_name, - git_pat = git_pat, + token = token, verbose = FALSE, silent = TRUE ) @@ -123,12 +158,7 @@ get_repo_info <- function(repo_name, # Declare URL url <- paste0("https://api.github.com/repos/", repo_name) - # Try to get credentials other way - auth_arg <- get_git_auth(git_pat = git_pat) - - git_pat <- try(auth_arg$password, silent = TRUE) - - if (grepl("Error", git_pat[1])) { + if (grepl("Error", token[1])) { # Github api get without authorization response <- httr::GET( url, @@ -138,7 +168,7 @@ get_repo_info <- function(repo_name, # Github api get response <- httr::GET( url, - httr::add_headers(Authorization = paste0("token ", git_pat)), + httr::add_headers(Authorization = paste0("token ", token)), httr::accept_json() ) } @@ -148,7 +178,7 @@ get_repo_info <- function(repo_name, } # Get content as JSON - repo_info <- httr::content(response, as = "parsed") + repo_info <- httr::content(response) } else { warning(paste0(repo_name, " could not be found with the given credentials.")) } @@ -160,7 +190,7 @@ get_repo_info <- function(repo_name, #' Given a repository name, check with git ls-remote whether the repository exists and return a TRUE/FALSE #' #' @param repo_name the name of the repository, e.g. jhudsl/OTTR_Template -#' @param git_pat A personal access token from GitHub. Only necessary if the +#' @param token A personal access token from GitHub. Only necessary if the #' repository being checked is a private repository. #' @param silent TRUE/FALSE of whether the warning from the git ls-remote #' command should be echoed back if it does fail. @@ -176,8 +206,10 @@ get_repo_info <- function(repo_name, #' @examples #' #' check_git_repo("jhudsl/OTTR_Template") +#' +#' check_git_repo <- function(repo_name, - git_pat = NULL, + token = NULL, silent = TRUE, return_repo = FALSE, verbose = TRUE) { @@ -187,16 +219,17 @@ check_git_repo <- function(repo_name, # If silent = TRUE don't print out the warning message from the 'try' report <- ifelse(silent, suppressWarnings, message) - # Try to get credentials - auth_arg <- get_git_auth(git_pat = git_pat, quiet = !verbose) - - git_pat <- try(auth_arg$password, silent = TRUE) + # Try to get credentials other way + if (is.null(token)) { + # Get auth token + token <- get_token(app_name = "github") + } # Run git ls-remote - if (!grepl("Error", git_pat[1])) { - # If git_pat is supplied, use it + if (!grepl("Error", token[1])) { + # If token is supplied, use it test_repo <- report( - try(system(paste0("git ls-remote https://", git_pat, "@github.com/", repo_name), + try(system(paste0("git ls-remote https://", token, "@github.com/", repo_name), intern = TRUE, ignore.stderr = TRUE )) ) @@ -223,66 +256,3 @@ check_git_repo <- function(repo_name, return(exists) } - -#' Handle GitHub PAT authorization -#' -#' Handle things whether or not a GitHub PAT is supplied. -#' -#' @param git_pat If private repositories are to be retrieved, a github personal -#' access token needs to be supplied. If none is supplied, then this will attempt to -#' grab from a git pat set in the environment with usethis::create_github_token(). -#' @param git_username Optional, can include username for credentials. -#' @param quiet Use TRUE if you don't want the warning about no GitHub credentials. -#' -#' @return Authorization argument to supply to curl OR a blank string if no -#' authorization is found or supplied. -#' -#' @export -#' -get_git_auth <- function(git_pat = NULL, git_username = "PersonalAccessToken", quiet = FALSE) { - auth_arg <- NULL - - # If git pat is not provided, try to get credentials with gitcreds - if (is.null(git_pat)) { - # Try getting credentials - auth_arg <- try(gitcreds::gitcreds_get(), silent = TRUE) - - if (grepl("Could not find any credentials", auth_arg[1])) { - # Only if we're running this interactively - if (interactive()) { - # Set credentials if null - auth_arg <- gitcreds::gitcreds_set() - } else { - if (!quiet) { - message("Could not find git credentials, please set by running usethis::create_github_token(), - or directly providing a personal access token using the git_pat argument") - } - } - } - } else { # If git_pat is given, use it. - # Set to Renviron file temporarily - Sys.setenv(GITHUB_PAT = git_pat) - - # Put it in gitcreds - auth_arg <- gitcreds::gitcreds_get() - - # Delete from Renviron file - Sys.unsetenv("GITHUB_PAT") - - # Set up rest of token - auth_arg$protocol <- "https" - auth_arg$host <- "github.com" - auth_arg$username <- git_username - } - - # Check if we have authentication - git_pat <- try(auth_arg$password, silent = TRUE) - - if (grepl("Error", git_pat[1])) { - if (!quiet) { - message("No github credentials found or provided; only public repositories will be successful.") - } - } - - return(auth_arg) -} diff --git a/R/leanpub.R b/R/leanpub.R index a486f9ab..df0ce127 100644 --- a/R/leanpub.R +++ b/R/leanpub.R @@ -327,10 +327,10 @@ get_chapters <- function(path = ".", #' @description This function creates screenshots of course chapters that are stored in a created output directory #' #' @param path path to the bookdown or quarto course repository, must have a `_bookdown.yml` or `_quarto.yml` file -#' @param git_pat required argument; a Git secret -- see https://docs.github.com/en/authentication/keeping-your-account-and-data-secure/managing-your-personal-access-tokens for more info +#' @param token required argument; a Git secret -- see https://docs.github.com/en/authentication/keeping-your-account-and-data-secure/managing-your-personal-access-tokens for more info #' @param repo required argument; GitHub repository name, e.g., jhudsl/OTTR_Template #' @param output_dir default is "resources/chapt_screen_images"; Output directory where the chapter's screen images should be stored. For OTTR courses, don't change this unless you've changed the downstream functions accordingly. -#' @param base_url default is NULL; rendered bookdown URL where screenshots are taken from, if NULL, the function will use the repo_name and and git_pat to find the base_url +#' @param base_url default is NULL; rendered bookdown URL where screenshots are taken from, if NULL, the function will use the repo_name and and token to find the base_url #' @param path default is to look for OTTR files in current directory based on existence of .github. But if you'd like to run this in a different path, you can point to that file path. #' @return the file path for file where chapter urls are saved #' @@ -346,12 +346,12 @@ get_chapters <- function(path = ".", #' @examples \dontrun{ #' #' make_screenshots( -#' git_pat = Sys.getenv("secrets.GH_PAT"), +#' token = Sys.getenv("secrets.GH_PAT"), #' repo = "jhudsl/OTTR_Template" #' ) #' } make_screenshots <- function(path = ".", - git_pat, + token, repo, output_dir = file.path(path, "resources", "chapt_screen_images"), base_url = NULL) { @@ -364,7 +364,7 @@ make_screenshots <- function(path = ".", } if (is.null(base_url)) { - base_url <- ottrpal::get_pages_url(repo_name = repo, git_pat = git_pat) # what if these arguments are still NULL/not supplied? + base_url <- ottrpal::get_pages_url(repo_name = repo, token = token) # what if these arguments are still NULL/not supplied? base_url <- gsub("/$", "", base_url) } diff --git a/R/token-handlers.R b/R/token-handlers.R new file mode 100644 index 00000000..315d2bda --- /dev/null +++ b/R/token-handlers.R @@ -0,0 +1,163 @@ +############### The creds handlers ############### +.Env <- new.env(parent = emptyenv()) + +.Env$ottr_tokens <- list( + "github" = NULL, + "google" = NULL +) + +# Set token to environment +set_token <- function(token, app_name, in_test = FALSE) { + .Env$ottr_tokens[[app_name]] <- token + + if (in_test) { + # Store it + if (app_name == "github") withr::local_options(github = token) + if (app_name == "google") withr::local_options(google = token) + } else { + # Store it + if (app_name == "github") options(github = token) + if (app_name == "google") options(google = token) + } + return(token) +} + +cache_token <- function(token, app_name) { + saveRDS(token, file.path(cache_secrets_folder(), paste0(app_name, ".RDS"))) +} + +remove_token <- function(app_name) { + .Env$ottr_tokens[[app_name]] <- NULL + googledrive::drive_deauth() + googlesheets4::gs4_deauth() + if (app_name == "github") options(github = NULL) + if (app_name == "google") options(google = NULL) +} + +remove_cache <- function(app_name) { + if (app_name == "github" || app_name == "google") { + cache_file <- file.path(cache_secrets_folder(), paste0(app_name, ".RDS")) + try(file.remove(cache_file), silent = TRUE) + } + + if (app_name == "google") { + cache_file <- list.files(pattern = ".httr-oauth", all.files = TRUE, recursive = TRUE, full.names = TRUE) + try(file.remove(cache_file), silent = TRUE) + } +} + +# Get token from environment +# Default is to try to retrieve credentials but if credentials are not necessary +# and you just want to attempt to grab credentials and see if you can then set try = TRUE +get_token <- function(app_name, try = FALSE, silent = FALSE) { + # If there's none in the current environment, attempt to grab a stored credential + if (is.null(.Env$ottr_tokens[[app_name]])) { + # Attempt to get stored token + .Env$ottr_tokens[[app_name]] <- get_stored_token(app_name) + + # only print this message if we are successful + if (!is.null(.Env$ottr_tokens[[app_name]])) message("Using user-supplied token stored using authorize(\"", app_name, "\")") + } + # Attempt to grab a cached credential + if (is.null(.Env$ottr_tokens[[app_name]])) { + .Env$ottr_tokens[[app_name]] <- get_cached_token(app_name) + } + # only print this message if we are successful + if (!is.null(.Env$ottr_tokens[[app_name]])) { + if (!silent) message("Using user-supplied cached tokens stored using authorize(\"", app_name, "\")") + if (app_name == "google") { + googledrive::drive_auth(token = .Env$ottr_tokens[[app_name]]) + googlesheets4::gs4_auth(token = .Env$ottr_tokens[[app_name]]) + } + } + + # If we don't get authorization, check if we said it was required or not + if (is.null(.Env$ottr_tokens[[app_name]])) { + warning("No token found. Please run `authorize()` to supply token.") + if (!try) { + stop("Authorization required for the called function. Quitting.") + } + } + invisible(.Env$ottr_tokens[[app_name]]) +} + +# Check if token already exists +check_for_tokens <- function(app_name = NULL) { + if (is.null(app_name)) { + app_name <- c("github", "google") + } + + token_tries <- sapply(app_name, function(an_app_name) { + token_try <- suppressWarnings(try(get_token(an_app_name, silent = TRUE), silent = TRUE)) + + token_status <- ifelse(class(token_try)[1] == "try-error", FALSE, TRUE) + }) + + names(token_tries) <- app_name + + return(token_tries) +} +# A function that attempts to grab stored credentials +get_stored_token <- function(app_name) { + if (app_name == "github") token <- getOption("github") + if (app_name == "google") token <- getOption("google") + + return(token) +} + +# A function that attempts to grab cached credentials +get_cached_token <- function(app_name) { + if (app_name == "github") { + token <- try(readRDS(file.path(cache_secrets_folder(), "github.RDS")), silent = TRUE) + } + if (app_name == "google") { + token <- try(readRDS(file.path(cache_secrets_folder(), "google.RDS")), silent = TRUE) + } + + if (class(token)[1] == "try-error") { + token <- NULL + } + + return(token) +} + +#' Supported endpoints +#' @description This is function stores endpoints and supported app names +supported_endpoints <- function() { + list( + "github" = httr::oauth_endpoints("github"), + "google" = httr::oauth_endpoints("google") + ) +} + +#' See where your cached secrets are being stored +#' @description This is a function to retrieve the file path of where your cached secrets are stored +#' @return an file path that shows where your cached secrets are stored +#' @examples \dontrun{ +#' +#' # You can see where your cached secrets are being stored by running: +#' cached_secrets_folder() +#' } +cache_secrets_folder <- function() { + file_path <- list.files( + pattern = "cached-secrets", + recursive = TRUE, + tools::R_user_dir("metricminer", which = "cache"), + full.names = TRUE, + include.dirs = TRUE, + ) + + if (length(file_path) == 0) { + dir.create(file.path( + tools::R_user_dir("metricminer", which = "cache"), + "cached-secrets" + ), recursive = TRUE, showWarnings = FALSE) + } + list.files( + pattern = "cached-secrets", + recursive = TRUE, + tools::R_user_dir("metricminer", which = "cache"), + full.names = TRUE, + include.dirs = TRUE, + ) +} diff --git a/tests/testthat/test-quarto_leanpub_prep.R b/tests/testthat/test-quarto_leanpub_prep.R index 24d6a74b..fb0be13a 100644 --- a/tests/testthat/test-quarto_leanpub_prep.R +++ b/tests/testthat/test-quarto_leanpub_prep.R @@ -1,4 +1,12 @@ -test_that("Create Leanpub IFrames for Quarto", { +if (Sys.getenv("GH_PAT") != "") { + + # Authorize GitHub + auth_from_secret("github", + token = Sys.getenv("GH_PAT"), + in_test = FALSE + ) + + test_that("Create Leanpub IFrames for Quarto", { dir <- setup_ottr_template(dir = ".", type = "quarto") @@ -27,3 +35,4 @@ test_that("Create Leanpub IFrames for Quarto", { clean_up() }) +} diff --git a/tests/testthat/test-rmd_leanpub_prep.R b/tests/testthat/test-rmd_leanpub_prep.R index 0e0e0761..a8f7f295 100644 --- a/tests/testthat/test-rmd_leanpub_prep.R +++ b/tests/testthat/test-rmd_leanpub_prep.R @@ -1,6 +1,11 @@ +if (Sys.getenv("GH_PAT") != "") { test_that("Get base URL", { - + # Authorize GitHub + auth_from_secret("github", + token = Sys.getenv("GH_PAT"), + in_test = FALSE + ) ### Now run functions we will test base_url <- get_pages_url(repo_name = "jhudsl/OTTR_Template", git_pat = Sys.getenv("secrets.GH_PAT")) @@ -71,3 +76,4 @@ test_that("Set Up Leanpub", { clean_up() }) +}