diff --git a/DESCRIPTION b/DESCRIPTION index a91bbb3..dd58e65 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,4 +46,4 @@ Config/testthat/edition: 3 Encoding: UTF-8 LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.1 +RoxygenNote: 7.3.3 diff --git a/NAMESPACE b/NAMESPACE index 0a4166b..9b6da36 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -49,6 +49,7 @@ export(make_login_client) export(search_for_funder) export(search_for_keywords) export(search_for_tags) +export(whoami) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") importFrom(methods,is) diff --git a/R/CONSTANTS.R b/R/CONSTANTS.R index 07b70d8..ebe26b0 100644 --- a/R/CONSTANTS.R +++ b/R/CONSTANTS.R @@ -2,6 +2,8 @@ #' #' +# Legacy endpoints (temporary until all functions migrated) ------------------- + API_CONSTANTS <- "https://nyu.databrary.org/api/constants" CREATE_SLOT <- @@ -47,8 +49,8 @@ GET_ASSET_BY_ID <- "https://nyu.databrary.org/api/asset/%s" GET_ASSET_BY_VOLUME_SESSION_ID <- "https://nyu.databrary.org/api/volume/%s/slot/%s/asset/%s" -LOGIN <- "https://nyu.databrary.org/api/user/login" -LOGOUT <- "https://nyu.databrary.org/api/user/logout" +# LOGIN <- "https://nyu.databrary.org/api/user/login" +# LOGOUT <- "https://nyu.databrary.org/api/user/logout" QUERY_SLOT <- "https://nyu.databrary.org/api/slot/%s/-?records&assets&excerpts&tags&comments" @@ -62,9 +64,9 @@ UPLOAD_CHUNK <- "https://nyu.databrary.org/api/upload" UPDATE_SLOT <- "https://nyu.databrary.org/api/slot/%s" # Authentication parameters -USER_AGENT <- - "databraryr (https://cran.r-project.org/package=databraryr)" -KEYRING_SERVICE <- 'org.databrary.databraryr' +# USER_AGENT <- +# "databraryr (https://cran.r-project.org/package=databraryr)" +# KEYRING_SERVICE <- 'org.databrary.databraryr' # httr2 request parameters RETRY_LIMIT <- 3 @@ -72,3 +74,17 @@ RETRY_WAIT_TIME <- 1 # seconds RETRY_BACKOFF <- 2 # exponential backoff REQUEST_TIMEOUT <- 5 # seconds REQUEST_TIMEOUT_VERY_LONG <- 600 + +# Base host ----------------------------------------------------------------- + +DATABRARY_BASE_URL <- Sys.getenv("DATABRARY_BASE_URL", "https://api.stg-databrary.its.nyu.edu") + +# OAuth endpoints ------------------------------------------------------------- + +OAUTH_TOKEN_URL <- sprintf("%s/o/token/", DATABRARY_BASE_URL) +OAUTH_TEST_URL <- sprintf("%s/oauth2/test/", DATABRARY_BASE_URL) + +# Authentication parameters --------------------------------------------------- + +USER_AGENT <- Sys.getenv("USER_AGENT", "SRW$*Kxy2nYdyo4LozoGV#i6LvH/") +KEYRING_SERVICE <- 'org.databrary.databraryr' diff --git a/R/auth_service.R b/R/auth_service.R new file mode 100644 index 0000000..b747ca8 --- /dev/null +++ b/R/auth_service.R @@ -0,0 +1,111 @@ +# OAuth2 network operations --------------------------------------------------- + +httr2_error_message <- function(resp) { + if (is.null(resp)) { + return("Request failed before receiving a response.") + } + status <- httr2::resp_status(resp) + if (status < 400) { + return(NULL) + } + body <- try(httr2::resp_body_json(resp), silent = TRUE) + if (!inherits(body, "try-error") && is.list(body)) { + fields <- c(body$error_description, body$error, body$detail) + fields <- fields[!vapply(fields, is_missing_string, logical(1))] + if (length(fields)) { + return(paste0("HTTP ", status, ": ", fields[[1]])) + } + } + sprintf("HTTP %s returned with empty error body.", status) +} + +#' @noRd +oauth_password_grant <- function(username, + password, + client_id, + client_secret, + vb = FALSE) { + assertthat::assert_that(assertthat::is.string(username)) + assertthat::assert_that(assertthat::is.string(password)) + assertthat::assert_that(assertthat::is.string(client_id)) + assertthat::assert_that(assertthat::is.string(client_secret)) + + req <- make_default_request(with_token = FALSE) |> + httr2::req_url(OAUTH_TOKEN_URL) + + resp <- tryCatch( + req |> + httr2::req_body_form( + grant_type = "password", + username = username, + password = password, + client_id = client_id, + client_secret = client_secret + ) |> + httr2::req_perform(), + error = function(err) { + if (vb) message("OAuth token request failed: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + if (httr2::resp_status(resp) >= 400) { + if (vb) message(httr2_error_message(resp)) + return(NULL) + } + + payload <- httr2::resp_body_json(resp) + list( + access_token = payload$access_token, + refresh_token = if (is.null(payload$refresh_token)) NULL else payload$refresh_token, + expires_in = if (is.null(payload$expires_in)) 3600 else payload$expires_in + ) +} + +#' @noRd +oauth_refresh_grant <- function(refresh_token, + client_id, + client_secret, + vb = FALSE) { + assertthat::assert_that(assertthat::is.string(refresh_token)) + assertthat::assert_that(assertthat::is.string(client_id)) + assertthat::assert_that(assertthat::is.string(client_secret)) + + req <- make_default_request() |> + httr2::req_url(OAUTH_TOKEN_URL) + + resp <- tryCatch( + req |> + httr2::req_body_form( + grant_type = "refresh_token", + refresh_token = refresh_token, + client_id = client_id, + client_secret = client_secret + ) |> + httr2::req_perform(), + error = function(err) { + if (vb) message("OAuth refresh request failed: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + if (httr2::resp_status(resp) >= 400) { + if (vb) message(httr2_error_message(resp)) + return(NULL) + } + + payload <- httr2::resp_body_json(resp) + list( + access_token = payload$access_token, + refresh_token = if (is.null(payload$refresh_token)) refresh_token else payload$refresh_token, + expires_in = if (is.null(payload$expires_in)) 3600 else payload$expires_in + ) +} diff --git a/R/auth_state.R b/R/auth_state.R new file mode 100644 index 0000000..899b8ff --- /dev/null +++ b/R/auth_state.R @@ -0,0 +1,74 @@ +# Token state management ------------------------------------------------------- + +.databrary_token_env <- new.env(parent = emptyenv()) + +#' @noRd +set_token_bundle <- function(access_token, + refresh_token = NULL, + expires_in = NULL, + issued_at = Sys.time(), + client_id = NULL, + client_secret = NULL, + username = NULL) { + assertthat::assert_that(assertthat::is.string(access_token)) + .databrary_token_env$access_token <- access_token + .databrary_token_env$refresh_token <- if (is_missing_string(refresh_token)) NULL else refresh_token + .databrary_token_env$issued_at <- issued_at + if (is.null(expires_in)) { + .databrary_token_env$expires_at <- NULL + } else { + assertthat::assert_that(is.numeric(expires_in), length(expires_in) == 1) + .databrary_token_env$expires_at <- issued_at + as.difftime(as.numeric(expires_in), units = "secs") + } + .databrary_token_env$client_id <- if (is_missing_string(client_id)) NULL else client_id + .databrary_token_env$client_secret <- if (is_missing_string(client_secret)) NULL else client_secret + .databrary_token_env$username <- if (is_missing_string(username)) NULL else username + invisible(.databrary_token_env) +} + +#' @noRd +get_token_bundle <- function() { + if (!is.null(.databrary_token_env$access_token)) { + return(list( + access_token = .databrary_token_env$access_token, + refresh_token = .databrary_token_env$refresh_token, + expires_at = .databrary_token_env$expires_at, + issued_at = .databrary_token_env$issued_at, + client_id = .databrary_token_env$client_id, + client_secret = .databrary_token_env$client_secret, + username = .databrary_token_env$username + )) + } + NULL +} + +#' @noRd +clear_token_bundle <- function() { + rm(list = ls(.databrary_token_env), envir = .databrary_token_env) + invisible(NULL) +} + +#' @noRd +token_should_refresh <- function() { + bundle <- get_token_bundle() + if (is.null(bundle)) { + return(FALSE) + } + expires_at <- bundle$expires_at + if (is.null(expires_at)) { + return(FALSE) + } + now <- Sys.time() + now >= (expires_at - as.difftime(30, units = "secs")) +} + +#' @noRd +require_access_token <- function() { + bundle <- get_token_bundle() + if (is.null(bundle) || is_missing_string(bundle$access_token)) { + stop("No access token available. Please call login_db() first.", call. = FALSE) + } + bundle$access_token +} + + diff --git a/R/auth_utils.R b/R/auth_utils.R new file mode 100644 index 0000000..46230ba --- /dev/null +++ b/R/auth_utils.R @@ -0,0 +1,134 @@ +# Internal helpers for authentication and credential management + +#' @noRd +CREDENTIAL_ENV_VARS <- c( + email = "DATABRARY_LOGIN", + password = "DATABRARY_PASSWORD", + client_id = "DATABRARY_CLIENT_ID", + client_secret = "DATABRARY_CLIENT_SECRET" +) + +#' @noRd +is_missing_string <- function(x) { + if (is.null(x) || length(x) == 0) { + return(TRUE) + } + value <- x[[1]] + if (is.na(value)) { + return(TRUE) + } + if (!is.character(value)) { + return(FALSE) + } + trimmed <- trimws(value) + identical(trimmed, "") +} + +#' @noRd +try_keyring_get <- function(service, username, vb = FALSE) { + if (!keyring::has_keyring_support()) { + return(NULL) + } + if (is_missing_string(username)) { + return(NULL) + } + result <- try(keyring::key_get(service = service, username = username), silent = TRUE) + if (inherits(result, "try-error")) { + if (vb) { + message("No keyring entry for service='", service, "' and username='", username, "'.") + } + return(NULL) + } + if (is_missing_string(result)) { + return(NULL) + } + result +} + +#' @noRd +store_keyring_value <- function(service, username, value, vb = FALSE) { + if (!keyring::has_keyring_support()) { + return(FALSE) + } + if (is_missing_string(value) || is_missing_string(username)) { + return(FALSE) + } + outcome <- try(keyring::key_set_with_value( + service = service, + username = username, + password = value + ), silent = TRUE) + if (inherits(outcome, "try-error")) { + if (vb) { + message("Unable to store keyring entry for service='", service, "' and username='", username, "'.") + } + return(FALSE) + } + if (vb) { + message("Stored credentials in keyring service='", service, "'.") + } + TRUE +} + +#' @noRd +resolve_credential_value <- function(label, + value, + prompt_label, + service, + username = NULL, + overwrite, + vb) { + if (!is_missing_string(value)) { + assertthat::assert_that(assertthat::is.string(value)) + return(value) + } + + # Check environment variable using the static map + env_var_name <- CREDENTIAL_ENV_VARS[[label]] + env_value <- Sys.getenv(env_var_name, NA_character_) + if (!is.na(env_value) && nzchar(env_value)) { + return(env_value) + } + + # For email, skip keyring lookup since email is the identifier used for other keyring lookups + # Only do keyring lookup for client_id and other credentials that are actually stored + if (!is_missing_string(username) && !overwrite && label != "email") { + stored <- try_keyring_get(service = service, username = username, vb = vb) + if (!is.null(stored)) { + return(stored) + } + } + + message("Please enter your ", prompt_label, ".") + readline(prompt = paste0(prompt_label, ": ")) +} + +#' @noRd +resolve_secret_value <- function(label, + value, + prompt_label, + service, + username, + overwrite, + vb) { + if (!is_missing_string(value)) { + assertthat::assert_that(assertthat::is.string(value)) + return(value) + } + + # Check environment variable using the static map + env_var_name <- CREDENTIAL_ENV_VARS[[label]] + env_value <- Sys.getenv(env_var_name, NA_character_) + if (!is.na(env_value) && nzchar(env_value)) { + return(env_value) + } + + if (!overwrite) { + recovered <- try_keyring_get(service = service, username = username, vb = vb) + if (!is.null(recovered)) { + return(recovered) + } + } + + getPass::getPass(paste0("Please enter your ", prompt_label, " ")) +} diff --git a/R/login_db.R b/R/login_db.R index 75c47d8..67b0251 100644 --- a/R/login_db.R +++ b/R/login_db.R @@ -1,25 +1,20 @@ -#' @eval options::as_params() -#' @name options_params -#' -NULL - #' Log In To Databrary.org. #' #' @param email Databrary account email address. #' @param password Databrary password (not recommended as it will displayed #' as you type) -#' @param store A boolean value. If TRUE store/retrieve credentials from the -#' system keyring/keychain. -#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ -#' update stored credentials in keyring/keychain. -#' @param SERVICE A character label for stored credentials in the keyring. -#' Default is "databrary" -#' @param rq An `http` request object. Defaults to NULL. -#' +#' @param client_id OAuth2 client identifier. +#' @param client_secret OAuth2 client secret. +#' @param store A boolean value. If TRUE store/retrieve credentials from the +#' system keyring/keychain. +#' @param overwrite A boolean value. If TRUE and store is TRUE, overwrite/ +#' update stored credentials in keyring/keychain. +#' @param SERVICE A character label for stored credentials in the keyring. +#' Default is `org.databrary.databraryr`. +#' @param vb Show verbose messages. +#' #' @returns Logical value indicating whether log in is successful or not. -#' -#' @inheritParams options_params -#' +#' #' @examplesIf interactive() #' login_db() # Queries user for email and password interactively. #' @examples @@ -34,145 +29,92 @@ NULL #' @export login_db <- function(email = NULL, password = NULL, + client_id = NULL, + client_secret = NULL, store = FALSE, overwrite = FALSE, - vb = options::opt("vb"), SERVICE = KEYRING_SERVICE, - rq = NULL) { - # Check parameters - assertthat::assert_that(length(store) == 1) - assertthat::assert_that(is.logical(store)) - - assertthat::assert_that(length(overwrite) == 1) - assertthat::assert_that(is.logical(overwrite)) - - assertthat::assert_that(length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - assertthat::assert_that(length(SERVICE) == 1) - assertthat::assert_that(is.character(SERVICE)) - - assertthat::assert_that(is.null(rq) | - ("httr2_request" %in% class(rq))) - # Handle NULL request - if (is.null(rq)) { - if (vb) { - message("NULL request object. Will generate default.") - } - rq <- databraryr::make_default_request() - } - + vb = options::opt("vb")) { + assertthat::assert_that(length(store) == 1, is.logical(store)) + assertthat::assert_that(length(overwrite) == 1, is.logical(overwrite)) + assertthat::assert_that(length(vb) == 1, is.logical(vb)) + assertthat::assert_that(length(SERVICE) == 1, is.character(SERVICE)) + # If the user wants to store or use their stored credentials, # check for keyring support if (store) { assertthat::assert_that(keyring::has_keyring_support(), msg = "No keyring support; please use store=FALSE") } - - # Check or get email - if (!is.null(email)) { - assertthat::assert_that(assertthat::is.string(email)) - } else { - message("Please enter your Databrary user ID (email).") - email <- readline(prompt = "Email: ") - } - - do_collect_password <- TRUE - - if (!is.null(password)) { - assertthat::assert_that(assertthat::is.string(password)) - do_collect_password <- FALSE - } - - # If the user wants to store or use their stored credentials and - # doesn't provide a password - if (store && is.null(password) && !overwrite) { - if (vb) - message("Retrieving password for service='", - SERVICE, - "' from keyring.") - kl <- keyring::key_list(service = SERVICE) - # Make sure our service is in the keyring - if (exists('kl') && is.data.frame(kl)) { - # If it is under the email entered, keep it to try later and not - # collect it here - password <- - try(keyring::key_get(service = SERVICE, username = email), - silent = TRUE) - if ("try-error" %in% class(password)) { - do_collect_password <- TRUE - if (vb) - message("No password found in keyring for service='", SERVICE, ".") - } else { - do_collect_password <- FALSE - if (vb) - message("Password retrieved from keyring.") - } - } else { - if (vb) - message("Error retrieving keyring data for service='", - SERVICE, - "'.") - } - } - - # If we need to, securely collect the password - if (do_collect_password) { - password <- - getPass::getPass("Please enter your Databrary password ") - } - - is_login_successful <- FALSE - - if (is.null(rq)) - rq <- make_default_request() - - rq <- rq %>% - httr2::req_url(LOGIN) %>% - httr2::req_body_json(list(email = email, password = password)) - - resp <- tryCatch( - httr2::req_perform(rq), - httr2_error = function(cnd) - NULL + + email_value <- resolve_credential_value( + label = "email", + value = email, + prompt_label = "Databrary user ID (email)", + service = SERVICE, + overwrite = overwrite, + vb = vb ) - - if (!is.null(resp) & httr2::resp_status(resp) == 200) { - is_login_successful <- TRUE - } - - # If the username/password was successful and the user wanted to - # store their credentials - - # Store them in the keyring - if (is_login_successful) { - if (store && (do_collect_password || overwrite)) { - keyring::key_set_with_value(service = SERVICE, - username = email, - password = password) - if (vb) - message(paste0("Login successful; password stored in keyring/keychain")) - } else { - if (vb) - message(paste("Login successful.")) - } - return(TRUE) + + password_value <- resolve_secret_value( + label = "password", + value = password, + prompt_label = "Databrary password", + service = SERVICE, + username = paste0(email_value, "::password"), + overwrite = overwrite, + vb = vb + ) + + client_id_value <- resolve_credential_value( + label = "client_id", + value = client_id, + prompt_label = "OAuth client ID", + service = SERVICE, + username = paste0(email_value, "::client_id"), + overwrite = overwrite, + vb = vb + ) + + client_secret_value <- resolve_secret_value( + label = "client_secret", + value = client_secret, + prompt_label = "OAuth client secret", + service = SERVICE, + username = paste0(email_value, "::client_secret"), + overwrite = overwrite, + vb = vb + ) + + token <- oauth_password_grant( + username = email_value, + password = password_value, + client_id = client_id_value, + client_secret = client_secret_value, + vb = vb + ) + + if (is.null(token)) { + if (vb) message("Login failed; see previous messages for details.") + return(FALSE) } - + + set_token_bundle( + access_token = token$access_token, + refresh_token = token$refresh_token, + expires_in = token$expires_in, + issued_at = Sys.time(), + client_id = client_id_value, + client_secret = client_secret_value, + username = email_value + ) + if (store) { - if (vb) - message( - paste0( - 'Login failed; nothing stored in keyring; HTTP status ', - httr2::resp_status(resp), - '\n' - ) - ) - } else { - if (vb) - message(paste0('Login failed; HTTP status ', - httr2::resp_status(resp), '\n')) + store_keyring_value(service = SERVICE, username = paste0(email_value, "::password"), value = password_value, vb = vb) + store_keyring_value(service = SERVICE, username = paste0(email_value, "::client_id"), value = client_id_value, vb = vb) + store_keyring_value(service = SERVICE, username = paste0(email_value, "::client_secret"), value = client_secret_value, vb = vb) } - - return(FALSE) + + if (vb) message("Login successful.") + TRUE } diff --git a/R/logout_db.R b/R/logout_db.R index 6c15304..4cf1ea1 100644 --- a/R/logout_db.R +++ b/R/logout_db.R @@ -16,26 +16,17 @@ NULL #' logout_db() #' } #' @export -logout_db <- function(vb = options::opt("vb"), rq = NULL){ +logout_db <- function(vb = options::opt("vb")) { + assertthat::assert_that(is.logical(vb), length(vb) == 1) - assertthat::assert_that(is.logical(vb)) - - if (is.null(rq)) { - if (vb) message("Empty request. Generating new one.") - rq <- databraryr::make_default_request() + bundle <- get_token_bundle() + if (is.null(bundle)) { + if (vb) message("No active session; nothing to log out from.") + return(TRUE) } - rq <- rq %>% - httr2::req_url(LOGOUT) - - r <- httr2::req_perform(rq) - delete_cookie <- file.remove(rq$options$cookiefile) - if (httr2::resp_status(r) == 200 & delete_cookie) { - if (vb) message('Logout Successful.') - TRUE - } else { - if (vb) message(paste0('Logout Failed, HTTP status: ', - httr2::resp_status(r), '.\n')) - FALSE - } + clear_token_bundle() + + if (vb) message("Logout successful.") + TRUE } diff --git a/R/make_default_request.R b/R/make_default_request.R index 290de5c..aab67b5 100644 --- a/R/make_default_request.R +++ b/R/make_default_request.R @@ -1,17 +1,42 @@ -#' Set default httr request parameters. +#' Set base request defaults for Databrary API. +#' +#' Creates an `httr2` request with the package's default options, including +#' base URL, user agent, Accept header, and timeout tuned for the Django API. +#' +#' @inheritParams options_params +#' @param with_token Should the request include an OAuth2 `Authorization` header? +#' Defaults to `TRUE` since all API calls now require authentication. +#' @param refresh When `with_token = TRUE`, determines whether to refresh the +#' cached token if it is near expiry. Defaults to `TRUE`. +#' +#' @returns An `httr2_request` object configured for the Databrary API. #' -#' `make_default_request` sets default parameters for httr requests. -#' @returns An `httr2` request object. -#' #' @examples #' make_default_request() #' @export -make_default_request <- function() { - path <- tempfile() - rq <- httr2::request(DATABRARY_API) %>% - httr2::req_user_agent(USER_AGENT) %>% - httr2::req_retry(max_tries = RETRY_LIMIT) %>% - httr2::req_timeout(REQUEST_TIMEOUT) %>% - httr2::req_cookie_preserve(path) - rq +make_default_request <- function(with_token = TRUE, + refresh = TRUE, + vb = options::opt("vb")) { + assertthat::assert_that(is.logical(with_token), length(with_token) == 1) + assertthat::assert_that(is.logical(refresh), length(refresh) == 1) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + + req <- httr2::request(DATABRARY_BASE_URL) |> + httr2::req_user_agent(USER_AGENT) |> + httr2::req_retry(max_tries = RETRY_LIMIT) |> + httr2::req_headers("Accept" = "application/json") |> + httr2::req_timeout(REQUEST_TIMEOUT) + + if (!isTRUE(with_token)) { + return(req) + } + + token <- if (isTRUE(refresh)) { + bundle <- ensure_valid_token(refresh = TRUE, vb = vb) + bundle$access_token + } else { + require_access_token() + } + + httr2::req_headers(req, Authorization = paste("Bearer", token)) } \ No newline at end of file diff --git a/R/token_helpers.R b/R/token_helpers.R new file mode 100644 index 0000000..f901f37 --- /dev/null +++ b/R/token_helpers.R @@ -0,0 +1,61 @@ +# Token-aware request helpers ------------------------------------------------- + +#' @noRd +add_bearer_token <- function(rq) { + assertthat::assert_that(inherits(rq, "httr2_request")) + access_token <- require_access_token() + httr2::req_headers(rq, Authorization = paste("Bearer", access_token)) +} + +#' @noRd +ensure_valid_token <- function(refresh = TRUE, + client_id = NULL, + client_secret = NULL, + vb = FALSE) { + bundle <- get_token_bundle() + if (is.null(bundle)) { + stop("No OAuth token available; call login_db() first.", call. = FALSE) + } + + if (!token_should_refresh()) { + return(bundle) + } + + if (!refresh) { + stop("Access token expired and refresh disabled.", call. = FALSE) + } + + refresh_token <- bundle$refresh_token + if (is_missing_string(refresh_token)) { + stop("Access token expired and no refresh token available.", call. = FALSE) + } + + refresh_client_id <- if (is_missing_string(client_id)) bundle$client_id else client_id + refresh_client_secret <- if (is_missing_string(client_secret)) bundle$client_secret else client_secret + + refreshed <- oauth_refresh_grant( + refresh_token = refresh_token, + client_id = refresh_client_id, + client_secret = refresh_client_secret, + vb = vb + ) + + if (is.null(refreshed)) { + clear_token_bundle() + stop("Token refresh failed; please re-authenticate with login_db().", call. = FALSE) + } + + set_token_bundle( + access_token = refreshed$access_token, + refresh_token = refreshed$refresh_token, + expires_in = refreshed$expires_in, + issued_at = Sys.time(), + client_id = refresh_client_id, + client_secret = refresh_client_secret, + username = bundle$username + ) + + get_token_bundle() +} + + diff --git a/R/whoami.R b/R/whoami.R new file mode 100644 index 0000000..5c39c3c --- /dev/null +++ b/R/whoami.R @@ -0,0 +1,57 @@ +#' Retrieve metadata about the authenticated Databrary user. +#' +#' Calls the Django `/oauth2/test/` endpoint to report the current authentication +#' method and user profile. Requires a valid OAuth2 access token acquired via +#' `login_db()`. +#' +#' @inheritParams options_params +#' @param refresh Whether to attempt automatic token refresh when the current +#' access token is expired. Defaults to `TRUE`. +#' +#' @returns A list containing `auth_method` and `user` fields (both lists) or +#' `NULL` if the request fails due to lack of authentication. +#' +#' @examples +#' \\dontrun{ +#' login_db() +#' whoami() +#' } +#' @export +whoami <- function(refresh = TRUE, vb = options::opt("vb")) { + assertthat::assert_that(is.logical(refresh), length(refresh) == 1) + assertthat::assert_that(is.logical(vb), length(vb) == 1) + + req <- tryCatch( + make_default_request(refresh = refresh, vb = vb), + error = function(err) { + if (vb) message("Authentication required: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(req)) { + return(NULL) + } + + resp <- tryCatch( + httr2::req_url(req, OAUTH_TEST_URL) |> + httr2::req_perform(), + error = function(err) { + if (vb) message("whoami request failed: ", conditionMessage(err)) + NULL + } + ) + + if (is.null(resp)) { + return(NULL) + } + + status <- httr2::resp_status(resp) + if (status >= 400) { + if (vb) message(httr2_error_message(resp)) + return(NULL) + } + + httr2::resp_body_json(resp, simplifyVector = TRUE) +} + diff --git a/README.Rmd b/README.Rmd index ce23e41..204dd36 100644 --- a/README.Rmd +++ b/README.Rmd @@ -48,16 +48,23 @@ The registration process involves the creation of an (email-account-based) user Once institutional authorization has been granted, a user may gain access to shared video, audio, and other data. See for more information about gaining access to restricted data. -However, many commands in the `databraryr` package return meaningful results *without* or *prior to* formal authorization. -These commands access public data or metadata. +All API calls now require OAuth2 authentication. Before +running the examples below, ensure you have set the following environment variables +or stored values with `login_db(store = TRUE)`: + +- `DATABRARY_CLIENT_ID` +- `DATABRARY_CLIENT_SECRET` +- `DATABRARY_LOGIN` (your Databrary account email) +- `DATABRARY_PASSWORD` (optional; prompted securely if missing) + +You can configure these via `usethis::edit_r_environ()`. ```{r example} library(databraryr) -get_db_stats() +login_db() -list_volume_assets() |> - head() +whoami() ``` ## Lifecycle diff --git a/man/login_db.Rd b/man/login_db.Rd index e10d0ea..98be6bd 100644 --- a/man/login_db.Rd +++ b/man/login_db.Rd @@ -7,11 +7,12 @@ login_db( email = NULL, password = NULL, + client_id = NULL, + client_secret = NULL, store = FALSE, overwrite = FALSE, - vb = options::opt("vb"), SERVICE = KEYRING_SERVICE, - rq = NULL + vb = options::opt("vb") ) } \arguments{ @@ -20,18 +21,20 @@ login_db( \item{password}{Databrary password (not recommended as it will displayed as you type)} +\item{client_id}{OAuth2 client identifier.} + +\item{client_secret}{OAuth2 client secret.} + \item{store}{A boolean value. If TRUE store/retrieve credentials from the system keyring/keychain.} \item{overwrite}{A boolean value. If TRUE and store is TRUE, overwrite/ update stored credentials in keyring/keychain.} -\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} - \item{SERVICE}{A character label for stored credentials in the keyring. -Default is "databrary"} +Default is \code{org.databrary.databraryr}.} -\item{rq}{An \code{http} request object. Defaults to NULL.} +\item{vb}{Show verbose messages.} } \value{ Logical value indicating whether log in is successful or not. @@ -40,7 +43,7 @@ Logical value indicating whether log in is successful or not. Log In To Databrary.org. } \examples{ -\dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} +\dontshow{if (interactive()) withAutoprint(\{ # examplesIf} login_db() # Queries user for email and password interactively. \dontshow{\}) # examplesIf} \donttest{ diff --git a/man/logout_db.Rd b/man/logout_db.Rd index 49e5587..2ea6c14 100644 --- a/man/logout_db.Rd +++ b/man/logout_db.Rd @@ -4,7 +4,7 @@ \alias{logout_db} \title{Log Out of Databrary.org.} \usage{ -logout_db(vb = options::opt("vb"), rq = NULL) +logout_db(vb = options::opt("vb")) } \arguments{ \item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} diff --git a/man/make_default_request.Rd b/man/make_default_request.Rd index ddb0d76..17f1764 100644 --- a/man/make_default_request.Rd +++ b/man/make_default_request.Rd @@ -2,15 +2,29 @@ % Please edit documentation in R/make_default_request.R \name{make_default_request} \alias{make_default_request} -\title{Set default httr request parameters.} +\title{Set base request defaults for Databrary API.} \usage{ -make_default_request() +make_default_request( + with_token = TRUE, + refresh = TRUE, + vb = options::opt("vb") +) +} +\arguments{ +\item{with_token}{Should the request include an OAuth2 \code{Authorization} header? +Defaults to \code{TRUE} since all API calls now require authentication.} + +\item{refresh}{When \code{with_token = TRUE}, determines whether to refresh the +cached token if it is near expiry. Defaults to \code{TRUE}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} } \value{ -An \code{httr2} request object. +An \code{httr2_request} object configured for the Databrary API. } \description{ -\code{make_default_request} sets default parameters for httr requests. +Creates an \code{httr2} request with the package's default options, including +base URL, user agent, Accept header, and timeout tuned for the Django API. } \examples{ make_default_request() diff --git a/man/whoami.Rd b/man/whoami.Rd new file mode 100644 index 0000000..0893265 --- /dev/null +++ b/man/whoami.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/whoami.R +\name{whoami} +\alias{whoami} +\title{Retrieve metadata about the authenticated Databrary user.} +\usage{ +whoami(refresh = TRUE, vb = options::opt("vb")) +} +\arguments{ +\item{refresh}{Whether to attempt automatic token refresh when the current +access token is expired. Defaults to \code{TRUE}.} + +\item{vb}{Show verbose messages. (Defaults to \code{FALSE}, overwritable using option 'databraryr.vb' or environment variable 'R_DATABRARYR_VB')} +} +\value{ +A list containing \code{auth_method} and \code{user} fields (both lists) or +\code{NULL} if the request fails due to lack of authentication. +} +\description{ +Calls the Django \verb{/oauth2/test/} endpoint to report the current authentication +method and user profile. Requires a valid OAuth2 access token acquired via +\code{login_db()}. +} +\examples{ +\\dontrun{ +login_db() +whoami() +} +} diff --git a/tests/testthat/test-login_db.R b/tests/testthat/test-login_db.R index 1a69237..0787a46 100644 --- a/tests/testthat/test-login_db.R +++ b/tests/testthat/test-login_db.R @@ -1,31 +1,23 @@ test_that("login_db rejects bad input parameters", { - # expect_error(login_db(email = -1)) - # expect_error(login_db(email = c("a", "b"))) - # expect_error(login_db(email = list("a", "b"))) - # expect_error(login_db(email = TRUE)) - # - # expect_error(login_db(password = -1)) - # expect_error(login_db(password = 3)) - # expect_error(login_db(password = list("a", "b"))) - # expect_error(login_db(password = TRUE)) - # - # expect_error(login_db(store = -1)) - # expect_error(login_db(store = 'a')) - # expect_error(login_db(store = list("a", "b"))) - # - # expect_error(login_db(overwrite = -1)) - # expect_error(login_db(overwrite = 'a')) - # expect_error(login_db(overwrite = list("a", "b"))) - expect_error(login_db(vb = -1)) expect_error(login_db(vb = 3)) expect_error(login_db(vb = "a")) - - # expect_error(login_db(SERVICE = -1)) - # expect_error(login_db(SERVICE = TRUE)) - # expect_error(login_db(SERVICE = list("a", "b"))) - # - # expect_error(login_db(rq = 3)) - # expect_error(login_db(rq = "a")) - # expect_error(login_db(rq = TRUE)) }) + +test_that("login_db stores token bundle on success", { + orig <- get("oauth_password_grant", envir = asNamespace("databraryr")) + assignInNamespace("oauth_password_grant", function(username, password, client_id, client_secret, vb = FALSE) list(access_token = "abc", refresh_token = "def", expires_in = 3600), ns = "databraryr") + on.exit(assignInNamespace("oauth_password_grant", orig, ns = "databraryr"), add = TRUE) + clear_token_bundle() + expect_true(login_db(email = "user@example.com", + password = "pw", + client_id = "cid", + client_secret = "sec", + store = FALSE, + vb = FALSE)) + bundle <- get_token_bundle() + expect_equal(bundle$access_token, "abc") + expect_equal(bundle$refresh_token, "def") + clear_token_bundle() +}) + diff --git a/tests/testthat/test-logout_db.R b/tests/testthat/test-logout_db.R index 334337e..30b16c2 100644 --- a/tests/testthat/test-logout_db.R +++ b/tests/testthat/test-logout_db.R @@ -5,9 +5,8 @@ test_that("logout_db rejects bad input parameters", { expect_error(logout_db(vb = c(TRUE, FALSE))) }) -test_that("logout_db returns logical", { - expect_true(is.logical(logout_db())) +test_that("logout_db clears token state", { + set_token_bundle(access_token = "abc", refresh_token = "def", expires_in = 3600) + expect_true(logout_db(vb = FALSE)) + expect_null(get_token_bundle()) }) - -# Actually log out -logout_db() diff --git a/tests/testthat/test-make_default_request.R b/tests/testthat/test-make_default_request.R index 03573f4..b418044 100644 --- a/tests/testthat/test-make_default_request.R +++ b/tests/testthat/test-make_default_request.R @@ -3,3 +3,18 @@ test_that("make_default_request returns httr2_request", { expect_true("httr2_request" %in% class(make_default_request())) }) +test_that("make_default_request optionally attaches bearer token", { + clear_token_bundle() + set_token_bundle(access_token = "xyz", refresh_token = NULL) + req <- make_default_request(with_token = TRUE, refresh = FALSE, vb = FALSE) + headers <- req$headers + expect_equal(headers$Authorization, "Bearer xyz") + clear_token_bundle() +}) + +test_that("make_default_request errors when token missing", { + clear_token_bundle() + expect_error(make_default_request(with_token = TRUE, refresh = FALSE, vb = FALSE), + "No OAuth token available") +}) + diff --git a/tests/testthat/test-whoami.R b/tests/testthat/test-whoami.R new file mode 100644 index 0000000..2105378 --- /dev/null +++ b/tests/testthat/test-whoami.R @@ -0,0 +1,29 @@ +test_that("whoami returns NULL when unauthenticated", { + clear_token_bundle() + expect_null(whoami(refresh = FALSE, vb = FALSE)) +}) + +test_that("whoami fetches user info", { + clear_token_bundle() + set_token_bundle(access_token = "abc", refresh_token = NULL) + + local_mocked_bindings( + req_perform = function(...) { + httr2::response( + method = "GET", + url = OAUTH_TEST_URL, + status_code = 200, + headers = list("Content-Type" = "application/json"), + body = charToRaw('{"auth_method":"password","user":{"id":1}}') + ) + }, + .package = "httr2" + ) + + result <- whoami(refresh = FALSE, vb = FALSE) + + expect_equal(result$auth_method, "password") + expect_equal(result$user$id, 1) + clear_token_bundle() +}) +