Add save_token arg to packit_location.

R/location.R

@@ -44,6 +44,10 @@
 ##'   a GitHub token with `read:org` scope). If missing or NULL, orderly2 will
 ##'   perform an interactive authentication against GitHub to obtain one.
 ##'
+##' * `save_token`: If no token is provided and interactive authentication is
+##'    used, this controls whether the GitHub token should be saved to disk.
+##'    Defaults to TRUE if missing.
+##'
 ##' **Custom locations**:
 ##'
 ##' All outpack implementations are expected to support path and http
@@ -112,6 +116,12 @@ orderly_location_add <- function(name, type, args, root = NULL, locate = TRUE) {
     assert_scalar_character(loc$args[[1]]$token, name = "args$token",
                             allow_null = TRUE,
                             call = environment())
+    assert_scalar_logical(loc$args[[1]]$save_token, name = "args$save_token",
+                          allow_null = TRUE,
+                          call = environment())
+    if (!is.null(loc$args[[1]]$token) && !is.null(loc$args[[1]]$save_token)) {
+      cli::cli_abort("Cannot specify both 'token' and 'save_token'")
+    }
   }
 
   config <- root$config
@@ -449,21 +459,22 @@ location_driver <- function(location_name, root) {
   i <- match(location_name, root$config$location$name)
   type <- root$config$location$type[[i]]
   args <- root$config$location$args[[i]]
-  switch(type,
-         path = orderly_location_path$new(args$path),
-         http = orderly_location_http$new(args$url),
-         packit = orderly_location_packit(args$url, args$token),
-         custom = orderly_location_custom(args))
+  location <- switch(type,
+                     path = orderly_location_path$new,
+                     http = orderly_location_http$new,
+                     packit = orderly_location_packit,
+                     custom = orderly_location_custom)
+  do.call(location, args)
 }
 
 
-orderly_location_custom <- function(args) {
-  driver <- check_symbol_from_str(args$driver, "args$driver")
+orderly_location_custom <- function(driver, ...) {
+  driver <- check_symbol_from_str(driver, "args$driver")
   driver <- getExportedValue(driver$namespace, driver$symbol)
   if (inherits(driver, "R6ClassGenerator")) {
     driver <- driver$new
   }
-  do.call(driver, args[names(args) != "driver"])
+  driver(...)
 }
 
 

R/location_http.R

@@ -1,17 +1,15 @@
 orderly_location_http <- R6::R6Class(
   "orderly_location_http",
 
-  private = list(
-    client = NULL
-  ),
-
   public = list(
+    client = NULL,
+
     initialize = function(url, authorise = NULL) {
-      private$client <- outpack_http_client$new(url, authorise)
+      self$client <- outpack_http_client$new(url, authorise)
     },
 
     list = function() {
-      dat <- private$client$request("/metadata/list")$data
+      dat <- self$client$request("/metadata/list")$data
       data_frame(
         packet = vcapply(dat, "[[", "packet"),
         time = num_to_time(vnapply(dat, "[[", "time")),
@@ -21,8 +19,8 @@ orderly_location_http <- R6::R6Class(
     metadata = function(packet_ids) {
       ret <- vcapply(packet_ids, function(id) {
         tryCatch(
-          trimws(private$client$request(sprintf("/metadata/%s/text", id),
-                                        parse_json = FALSE)),
+          trimws(self$client$request(sprintf("/metadata/%s/text", id),
+                                     parse_json = FALSE)),
           outpack_http_client_error = function(e) {
             if (e$code == 404) {
               e$message <- sprintf("Some packet ids not found: '%s'", id)
@@ -43,7 +41,7 @@ orderly_location_http <- R6::R6Class(
       ## progress in the client, but there's not much point until
       ## then.
       tryCatch(
-        private$client$request(sprintf("/file/%s", hash), download = dest),
+        self$client$request(sprintf("/file/%s", hash), download = dest),
         outpack_http_client_error = function(e) {
           if (e$code == 404) {
             unlink(dest)
@@ -56,21 +54,21 @@ orderly_location_http <- R6::R6Class(
 
     ## TODO: we could get the schemas here from outpack_server too
     list_unknown_packets = function(ids) {
-      res <- private$client$request(
+      res <- self$client$request(
         "/packets/missing",
         function(r) http_body_json(r, list(ids = ids, unpacked = scalar(TRUE))))
       list_to_character(res$data)
     },
 
     list_unknown_files = function(hashes) {
-      res <- private$client$request(
+      res <- self$client$request(
         "/files/missing",
         function(r) http_body_json(r, list(hashes = hashes)))
       list_to_character(res$data)
     },
 
     push_file = function(src, hash) {
-      res <- private$client$request(
+      res <- self$client$request(
         sprintf("/file/%s", hash),
         function(r) httr2::req_body_file(r, src, "application/octet-stream"))
 
@@ -79,7 +77,7 @@ orderly_location_http <- R6::R6Class(
 
     push_metadata = function(packet_id, hash, path) {
       meta <- read_string(path)
-      res <- private$client$request(
+      res <- self$client$request(
         sprintf("/packet/%s", hash),
         function(r) httr2::req_body_raw(r, meta, "text/plain"))
       invisible(NULL)

R/location_packit.R

@@ -9,7 +9,7 @@ github_oauth_client <- function() {
   )
 }
 
-do_oauth_device_flow <- function(base_url) {
+do_oauth_device_flow <- function(base_url, cache_disk) {
   # httr2 has a pretty unintuitive output when running interactively.
   # It waits for the user to press <Enter> and then opens up a browser, but the
   # wording isn't super clear. It also does not work at all if a browser can't
@@ -25,7 +25,7 @@ do_oauth_device_flow <- function(base_url) {
       flow_params = list(
         auth_url = "https://github.com/login/device/code",
         scope = "read:org"),
-      cache_disk = TRUE)
+      cache_disk = cache_disk)
   })
   res$access_token
 }
@@ -42,13 +42,13 @@ do_oauth_device_flow <- function(base_url) {
 # It also means the user cannot easily use two different identities on the same
 # server from within the same session.
 auth_cache <- new.env(parent = emptyenv())
-packit_authorisation <- function(base_url, token) {
+packit_authorisation <- function(base_url, token, save_token) {
   key <- rlang::hash(list(base_url = base_url, token = token))
 
   if (is.null(auth_cache[[key]])) {
     cli::cli_alert_info("Logging in to {base_url}")
     if (is.null(token)) {
-      token <- do_oauth_device_flow(base_url)
+      token <- do_oauth_device_flow(base_url, cache_disk = save_token)
     }
 
     login_url <- paste0(base_url, "packit/api/auth/login/api")
@@ -63,9 +63,11 @@ packit_authorisation <- function(base_url, token) {
   auth_cache[[key]]
 }
 
-orderly_location_packit <- function(url, token) {
+orderly_location_packit <- function(url, token = NULL, save_token = TRUE) {
   assert_scalar_character(url)
   assert_scalar_character(token, allow_null = TRUE)
+  assert_scalar_logical(save_token)
+
   if (!is.null(token) && grepl("^\\$", token)) {
     token_variable <- sub("^\\$", "", token)
     token <- Sys.getenv(token_variable, NA_character_)
@@ -81,5 +83,5 @@ orderly_location_packit <- function(url, token) {
 
   orderly_location_http$new(
     paste0(url, "packit/api/outpack"),
-    function() packit_authorisation(url, token))
+    function() packit_authorisation(url, token, save_token))
 }

tests/testthat/helper-outpack-http.R

@@ -44,8 +44,8 @@ clear_auth_cache <- function() {
   rm(list = ls(auth_cache), envir = auth_cache)
 }
 
-local_mock_response <- function(..., env = rlang::caller_env()) {
-  mock <- mockery::mock(mock_response(...))
+local_mock_response <- function(..., env = rlang::caller_env(), cycle = FALSE) {
+  mock <- mockery::mock(mock_response(...), cycle = cycle)
   httr2::local_mocked_responses(function(req) mock(req), env = env)
   mock
 }

tests/testthat/test-location-packit.R

@@ -42,7 +42,8 @@ test_that("can authenticate using device flow", {
   mockery::stub(packit_authorisation, "do_oauth_device_flow", "my-github-token")
 
   res <- evaluate_promise(packit_authorisation("http://example.com/",
-                                               token = NULL))
+                                               token = NULL,
+                                               save_token = TRUE))
 
   expect_length(res$messages, 2)
   expect_match(res$messages[[1]], "Logging in to http://example.com")
@@ -97,6 +98,32 @@ test_that("location_packit uses authentication", {
   mock <- mockery::mock(mock_login, mock_get)
 })
 
+
+test_that("Can configure oauth caching behaviour", {
+  clear_auth_cache()
+  withr::defer(clear_auth_cache())
+
+  mock_token <- mockery::mock("token", cycle = TRUE)
+  testthat::local_mocked_bindings(do_oauth_device_flow = mock_token)
+
+  local_mock_response(to_json(list(token = jsonlite::unbox("my-packit-token"))),
+                      cycle = TRUE)
+
+  location <- orderly_location_packit("http://example.com", save_token = TRUE)
+  suppressMessages(location$client$authorise())
+
+  clear_auth_cache()
+
+  location <- orderly_location_packit("http://example.com", save_token = FALSE)
+  suppressMessages(location$client$authorise())
+
+  mockery::expect_called(mock_token, 2)
+  args <- mockery::mock_args(mock_token)
+  expect_equal(args[[1]]$cache_disk, TRUE)
+  expect_equal(args[[2]]$cache_disk, FALSE)
+})
+
+
 test_that("can create a packit location using an environment variable token", {
   loc <- withr::with_envvar(
     c("PACKIT_TOKEN" = "abc123"),
@@ -106,8 +133,7 @@ test_that("can create a packit location using an environment variable token", {
     to_json(list(token = jsonlite::unbox("my-packit-token"))),
     wrap = FALSE)
 
-  client <- loc$.__enclos_env__$private$client
-  evaluate_promise(client$authorise())
+  evaluate_promise(loc$client$authorise())
 
   mockery::expect_called(mock_login, 1)
 

tests/testthat/test-location.R

@@ -816,7 +816,21 @@ test_that("validate arguments to packit locations", {
     orderly_location_add("other", "packit",
                          list(url = "example.com", token = 123),
                          root = root),
-    "'args$token' must be character", fixed = TRUE)
+    "Expected 'args$token' to be character", fixed = TRUE)
+
+  expect_error(
+    orderly_location_add("other", "packit",
+                         list(url = "example.com", save_token = "value"),
+                         root = root),
+    "Expected 'args$save_token' to be logical", fixed = TRUE)
+
+  expect_error(
+    orderly_location_add("other", "packit",
+                         list(url = "example.com",
+                              token = "xx",
+                              save_token = "TRUE"),
+                         root = root),
+    "Cannot specify both 'token' and 'save_token'", fixed = TRUE)
 
   expect_equal(orderly_location_list(root = root), "local")
 })
@@ -837,7 +851,7 @@ test_that("can add a packit location", {
   mockery::expect_called(mock_driver, 1)
   expect_equal(
     mockery::mock_args(mock_driver)[[1]],
-    list("https://example.com", "abc123"))
+    list(url = "https://example.com", token = "abc123"))
 })
 
 test_that("can add a packit location without a token", {
@@ -855,33 +869,25 @@ test_that("can add a packit location without a token", {
   mockery::expect_called(mock_driver, 1)
   expect_equal(
     mockery::mock_args(mock_driver)[[1]],
-    list("https://example.com", NULL))
+    list(url = "https://example.com"))
 })
 
 test_that("cope with trailing slash in url if needed", {
   loc <- orderly_location_packit("https://example.com/", "abc123")
-  client <- loc$.__enclos_env__$private$client
-  expect_equal(
-    client$url,
-    "https://example.com/packit/api/outpack")
+  expect_equal(loc$client$url, "https://example.com/packit/api/outpack")
 })
 
 
 test_that("can create an outpack location, disabling auth", {
   loc <- orderly_location_http$new("https://example.com", NULL)
-  client <- loc$.__enclos_env__$private$client
-  expect_equal(client$authorise(), NULL)
-  expect_equal(
-    client$url,
-    "https://example.com")
+  expect_equal(loc$client$authorise(), NULL)
+  expect_equal(loc$client$url, "https://example.com")
 })
 
 
 test_that("strip trailing slash from outpack url", {
   loc <- orderly_location_http$new("https://example.com/", NULL)
-  expect_equal(
-    loc$.__enclos_env__$private$client$url,
-    "https://example.com")
+  expect_equal(loc$client$url, "https://example.com")
 })
 
 
@@ -890,8 +896,8 @@ test_that("can load a custom location driver", {
   mock_driver <- mockery::mock("value")
   mock_gev <- mockery::mock(mock_driver)
   mockery::stub(orderly_location_custom, "getExportedValue", mock_gev)
-  args <- list(driver = "foo::bar", a = 1, b = "other")
-  expect_equal(orderly_location_custom(args), "value")
+  expect_equal(orderly_location_custom(driver = "foo::bar", a = 1, b = "other"),
+               "value")
 
   mockery::expect_called(mock_gev, 1)
   expect_equal(mockery::mock_args(mock_gev)[[1]], list("foo", "bar"))
@@ -908,8 +914,8 @@ test_that("can load a custom location driver using an R6 generator", {
     class = "R6ClassGenerator")
   mock_gev <- mockery::mock(mock_driver)
   mockery::stub(orderly_location_custom, "getExportedValue", mock_gev)
-  args <- list(driver = "foo::bar", a = 1, b = "other")
-  expect_equal(orderly_location_custom(args), "value")
+  expect_equal(orderly_location_custom(driver = "foo::bar", a = 1, b = "other"),
+               "value")
 
   mockery::expect_called(mock_gev, 1)
   expect_equal(mockery::mock_args(mock_gev)[[1]], list("foo", "bar"))
@@ -937,7 +943,7 @@ test_that("can add a custom outpack location", {
   expect_equal(location_driver(loc$name, root), "value")
   mockery::expect_called(mock_orderly_location_custom, 1)
   expect_equal(mockery::mock_args(mock_orderly_location_custom)[[1]],
-               list(list(driver = "foo::bar", a = 1, b = 2)))
+               list(driver = "foo::bar", a = 1, b = 2))
 })