tests/testthat/test-cred_funs.R

In r-pkgs/gargle: Utilities for Working with Google APIs

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))
  expect_true(is_cred_fun(creds_two))

  invalid_one <- function(scope, ...) {}
  invalid_two <- function(scopes, arg1, arg2 = "optional") {}
  invalid_three <- 17
  expect_false(is_cred_fun(invalid_one))
  expect_false(is_cred_fun(invalid_two))
  expect_false(is_cred_fun(invalid_three))
})

test_that("cred_funs_add() and _set() can add and set credential functions", {
  creds_one <- function(scopes, ...) {}
  creds_two <- function(scopes, arg1, arg2 = "optional", ...) {}

  withr::defer(cred_funs_set_default())
  cred_funs_clear()

  cred_funs_add(a = creds_one)
  expect_equal(names(cred_funs_list()), "a")

  cred_funs_add(b = creds_two)
  expect_equal(names(cred_funs_list()), c("b", "a"))

  cred_funs_clear()
  expect_equal(0, length(cred_funs_list()))

  for (i in 1:5) {
    nm <- glue("cf{i}")
    cred_funs_add(!!nm := creds_one)
    expect_equal(i, length(cred_funs_list()))
    expect_match(names(cred_funs_list()), "^cf[12345]")
  }

  cred_funs_set(list(first = creds_one, last = creds_two))
  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, ...) {}

  withr::defer(cred_funs_set_default())
  cred_funs_clear()

  cred_funs_add(a = creds_one)
  cred_funs_add(b = function(scopes, ...) {})
  expect_snapshot(
    error = TRUE,
    cred_funs_add(creds_one)
  )
  expect_snapshot(
    error = TRUE,
    cred_funs_add(a = creds_one)
  )
  expect_equal(names(cred_funs_list()), c("b", "a"))

  cred_funs_clear()

  expect_snapshot(
    error = TRUE,
    cred_funs_set(list(
      creds_one,
      a = function(scopes, ...) {}
    ))
  )
  expect_snapshot(
    error = TRUE,
    cred_funs_set(list(
      a = creds_one,
      a = function(scopes, ...) {}
    ))
  )
})

test_that("We can remove credential functions by name", {
  cred_fun <- function(scopes, ...) {}
  withr::defer(cred_funs_set_default())
  cred_funs_clear()

  cred_funs_add(a = cred_fun, b = cred_fun, c = cred_fun)
  cred_funs_add(b = NULL)
  expect_equal(names(cred_funs_list()), c("c", "a"))

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