Add with_cred_funs(), local_cred_funs(), cred_funs_list_default()

NAMESPACE

@@ -14,6 +14,7 @@ export(bulletize)
 export(cred_funs_add)
 export(cred_funs_clear)
 export(cred_funs_list)
+export(cred_funs_list_default)
 export(cred_funs_set)
 export(cred_funs_set_default)
 export(credentials_app_default)
@@ -37,6 +38,7 @@ export(gargle_oauth_sitrep)
 export(gargle_oob_default)
 export(gargle_verbosity)
 export(init_AuthState)
+export(local_cred_funs)
 export(local_gargle_verbosity)
 export(oauth_app_from_json)
 export(oauth_external_token)
@@ -53,6 +55,7 @@ export(token_email)
 export(token_fetch)
 export(token_tokeninfo)
 export(token_userinfo)
+export(with_cred_funs)
 export(with_gargle_verbosity)
 import(fs)
 import(rlang)

NEWS.md

@@ -53,19 +53,28 @@ This is especially likely to come up with gmailr / the Gmail API.
 * The credential-fetcher `credentials_byo_oauth2()` has been moved to the very
   beginning of the default registry. The logic is that a user who has specified
   a non-`NULL` value of `token` must mean business and does not want automagic
-  auth methods like ADC or GCE to be tried before using their `token` (#187).
+  auth methods like ADC or GCE to be tried before using their `token`
+  (#187, #225).
 
 * The `...` in `cred_funs_all()` are now
-  [dynamic dots](https://rlang.r-lib.org/reference/dyn-dots.html).
+  [dynamic dots](https://rlang.r-lib.org/reference/dyn-dots.html) (#224).
 
 * Every registered credential function must have a unique name now.
-  This is newly enforced by `cred_funs_add()` and `cred_funs_set()`.
+  This is newly enforced by `cred_funs_add()` and `cred_funs_set()` (#224).
+
+* `cred_funs_list_default()` is a new function that returns gargle's default
+  list of credential functions (#226).
 
 * `cred_funs_add(cred_fun = NULL)` is now available to remove a credential
-  function from the registry.
+  function from the registry (#224).
+
+* `with_cred_funs()` and `local_cred_funs()` are new helpers for making narrowly
+  scoped changes to the registry (#226).
+
+* The `ls` argument of `cred_funs_set()` has been renamed to `funs` (#226).
 
 * In general, credential registry functions now return the current registry,
-  invisibly.
+  invisibly (#224).
 
 # gargle 1.2.1
 

R/credential-function-registry.R

@@ -32,6 +32,25 @@
 #'
 #' # restore the default list
 #' cred_funs_set_default()
+#'
+#' # run some code with a temporary change to the registry
+#' # creds_one ONLY
+#' with_cred_funs(
+#'   list(one = creds_one),
+#'   names(cred_funs_list())
+#' )
+#' # add creds_one to the list
+#' with_cred_funs(
+#'   list(one = creds_one),
+#'   names(cred_funs_list()),
+#'   action = "modify"
+#' )
+#' # remove credentials_gce
+#' with_cred_funs(
+#'   list(credentials_gce = NULL),
+#'   names(cred_funs_list()),
+#'   action = "modify"
+#' )
 NULL
 
 #' @describeIn cred_funs Get the list of registered credential functions.
@@ -45,7 +64,6 @@ cred_funs_list <- function() {
 #'   * "First registered, last tried."
 #'   * "Last registered, first tried."
 #'
-
 #' @param ... <[`dynamic-dots`][rlang::dyn-dots]> One or more credential
 #'   functions, in `name = value` form. Each credential function is subject to a
 #'   superficial check that it at least "smells like" a credential function: its
@@ -91,11 +109,22 @@ cred_funs_add <- function(...) {
 
 #' @describeIn cred_funs Register a list of credential fetching functions.
 #'
-#' @param ls A named list of credential functions.
+#' @param funs A named list of credential functions.
+#' @param ls `r lifecycle::badge("deprecated")` This argument has been renamed
+#'   to `funs`.
 #' @export
-cred_funs_set <- function(ls) {
-  cred_funs_check(ls, allow_null = FALSE)
-  gargle_env$cred_funs <- ls
+cred_funs_set <- function(funs, ls = deprecated()) {
+  if (lifecycle::is_present(ls)) {
+    lifecycle::deprecate_warn(
+      when = "1.3.0",
+      what = "cred_funs_set(ls)",
+      with = "cred_funs_set(funs)",
+    )
+    funs = ls
+  }
+
+  cred_funs_check(funs, allow_null = FALSE)
+  gargle_env$cred_funs <- funs
   invisible(cred_funs_list())
 }
 
@@ -106,19 +135,59 @@ cred_funs_clear <- function() {
   invisible(cred_funs_list())
 }
 
-#' @describeIn cred_funs Reset the registry to the gargle default.
+#' @describeIn cred_funs Return the default list of credential functions.
 #' @export
-cred_funs_set_default <- function() {
-  cred_funs_clear()
-  l <- list(
+cred_funs_list_default <- function() {
+  list(
     credentials_byo_oauth2       = credentials_byo_oauth2,
     credentials_service_account  = credentials_service_account,
     credentials_external_account = credentials_external_account,
     credentials_app_default      = credentials_app_default,
     credentials_gce              = credentials_gce,
     credentials_user_oauth2      = credentials_user_oauth2
   )
-  cred_funs_set(l)
+}
+
+#' @describeIn cred_funs Reset the registry to the gargle default.
+#' @export
+cred_funs_set_default <- function() {
+  cred_funs_set(cred_funs_list_default())
+}
+
+#' @describeIn cred_funs Modify the credential function registry in the current
+#'   scope. It is an example of the `local_*()` functions in \pkg{withr}.
+#' @param action Whether to use `funs` to replace or modify the registry with
+#'   funs:
+#'   * `"replace"` does `cred_funs_set(funs)`
+#'   * `"modify"` does `cred_funs_add(!!!funs)`
+#' @param .local_envir The environment to use for scoping. Defaults to current
+#'   execution environment.
+#' @export
+local_cred_funs <- function(funs = cred_funs_list_default(),
+                            action = c("replace", "modify"),
+                            .local_envir = parent.frame()) {
+  action <- arg_match(action)
+
+  cred_funs_orig <- cred_funs_list()
+  withr::defer(cred_funs_set(cred_funs_orig), envir = .local_envir)
+
+  switch(
+    action,
+    replace = cred_funs_set(funs),
+    modify = cred_funs_add(!!!funs)
+  )
+}
+
+#' @describeIn cred_funs Evaluate `code` with a temporarily modified credential
+#'   function registry. It is an example of the `with_*()` functions in
+#'   \pkg{withr}.
+#' @param code Code to run with temporary active project.
+#' @export
+with_cred_funs <- function(funs = cred_funs_list_default(),
+                           code,
+                           action = c("replace", "modify")) {
+  local_cred_funs(funs = funs, action = action)
+  force(code)
 }
 
 cred_funs_check <- function(ls, allow_null = FALSE) {

tests/testthat/_snaps/credential-function-registry.md

@@ -31,3 +31,12 @@
       Error in `cred_funs_check()`:
       ! Each credential function must have a unique name
 
+# cred_funs_set() warns for use of `ls`
+
+    Code
+      out <- cred_funs_set(ls = list(a = function(scopes, ...) { }))
+    Condition
+      Warning:
+      The `ls` argument of `cred_funs_set()` is deprecated as of gargle 1.3.0.
+      i Please use the `funs` argument instead.
+

tests/testthat/test-credential-function-registry.R

@@ -1,4 +1,4 @@
-test_that("We recognize a credential function signature", {
+test_that("is_cred_fun() recognizes a credential function signature", {
   creds_one <- function(scopes, ...) {}
   creds_two <- function(scopes, arg1, arg2 = "optional", ...) {}
   expect_true(is_cred_fun(creds_one))
@@ -12,7 +12,7 @@ test_that("We recognize a credential function signature", {
   expect_false(is_cred_fun(invalid_three))
 })
 
-test_that("We can register new credential functions", {
+test_that("cred_funs_add() and _set() can add and set credential functions", {
   creds_one <- function(scopes, ...) {}
   creds_two <- function(scopes, arg1, arg2 = "optional", ...) {}
 
@@ -39,6 +39,22 @@ test_that("We can register new credential functions", {
   expect_equal(names(cred_funs_list()), c("first", "last"))
 })
 
+test_that("We insist on valid credential function (or NULL)", {
+  creds_one <- function(scopes, ...) {}
+
+  withr::defer(cred_funs_set_default())
+  cred_funs_clear()
+
+  expect_snapshot(
+    error = TRUE,
+    cred_funs_add(a = mean)
+  )
+  expect_snapshot(
+    error = TRUE,
+    cred_funs_set(list(a = NULL))
+  )
+})
+
 test_that("We insist on uniquely named credential functions", {
   creds_one <- function(scopes, ...) {}
 
@@ -87,3 +103,51 @@ test_that("We can remove credential functions by name", {
   cred_funs_add(c = NULL, d = cred_fun)
   expect_equal(names(cred_funs_list()), c("d", "a"))
 })
+
+test_that("cred_funs_set() warns for use of `ls`", {
+  withr::local_options(lifecycle_verbosity = "warning")
+  withr::defer(cred_funs_set_default())
+  expect_snapshot(
+   out <- cred_funs_set(ls = list(a = function(scopes, ...) {}))
+  )
+  expect_equal(names(cred_funs_list()), "a")
+})
+
+test_that("local_cred_funs() works", {
+  withr::defer(cred_funs_set_default())
+  cred_fun <- function(scopes, ...) {}
+  cred_funs_clear()
+
+  cred_funs_add(a = cred_fun, b = cred_fun)
+
+  local_cred_funs(funs = list(c = cred_fun), action = "modify")
+  expect_equal(names(cred_funs_list()), c("c", "b", "a"))
+
+  local_cred_funs(funs = list(d = cred_fun)) # action = "replace"
+  expect_equal(names(cred_funs_list()), "d")
+
+  local_cred_funs()
+  expect_equal(names(cred_funs_list()), names(cred_funs_list_default()))
+})
+
+test_that("with_cred_funs() works", {
+  withr::defer(cred_funs_set_default())
+  cred_fun <- function(scopes, ...) {}
+  cred_funs_clear()
+
+  cred_funs_add(a = cred_fun, b = cred_fun)
+
+  with_cred_funs(
+    funs = list(c = cred_fun), action = "modify",
+    expect_equal(names(cred_funs_list()), c("c", "b", "a"))
+  )
+
+  with_cred_funs(
+    funs = list(d = cred_fun), # action = "replace"
+    expect_equal(names(cred_funs_list()), "d")
+  )
+
+  with_cred_funs(
+    code = expect_equal(names(cred_funs_list()), names(cred_funs_list_default()))
+  )
+})