DAT-1493: Updated OAuth2 authentication process and token management

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

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)

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,13 +64,27 @@ 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
 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'

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
+  )
+}

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
+}
+
+

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, " "))
+}