From dc2d5c50db2bb2de8e63c3331627d2e18f8664a9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Thu, 12 Sep 2024 16:10:11 +0100 Subject: [PATCH] Add save_token arg to packit_location. --- R/location.R | 27 +++++++++++----- R/location_http.R | 24 +++++++------- R/location_packit.R | 14 ++++---- tests/testthat/helper-outpack-http.R | 4 +-- tests/testthat/test-location-packit.R | 32 +++++++++++++++++-- tests/testthat/test-location.R | 46 +++++++++++++++------------ 6 files changed, 95 insertions(+), 52 deletions(-) diff --git a/R/location.R b/R/location.R index 87cbe092..03f84665 100644 --- a/R/location.R +++ b/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(...) } diff --git a/R/location_http.R b/R/location_http.R index 9750dd6c..60ce6ed4 100644 --- a/R/location_http.R +++ b/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) diff --git a/R/location_packit.R b/R/location_packit.R index b169ca03..f3cceb5e 100644 --- a/R/location_packit.R +++ b/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 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)) } diff --git a/tests/testthat/helper-outpack-http.R b/tests/testthat/helper-outpack-http.R index 12c9c857..af09cb98 100644 --- a/tests/testthat/helper-outpack-http.R +++ b/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 } diff --git a/tests/testthat/test-location-packit.R b/tests/testthat/test-location-packit.R index 3fdc6325..664c082d 100644 --- a/tests/testthat/test-location-packit.R +++ b/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) diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index c0b741ef..4c4fb693 100644 --- a/tests/testthat/test-location.R +++ b/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)) })