From 82d9b71fe603225cdb7fd53ce738f0be7e8a77f0 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Fri, 30 Aug 2024 14:02:20 +0100 Subject: [PATCH 01/11] Implement OAuth device flow for GitHub logins. GitHub-based logins to Packit rely on users specifying a personal access token when adding the location. This has a number of usability and security disadvantages. Users need to manually take steps in order to create a PAT, and they need to make sure they have selected the right scope. It is quite likely users would be tempted to create tokens with way more scopes than is necessary. The configured PAT would be stored in the orderly configuration, which many users share and keep on network drives that are accessible to everyone. By using an OAuth flow to generate our own tokens, we remove the extra steps the user needed to take and we can make sure it has just the right scopes needed. Additionally the token cache implemented by httr2 is located outside of the orderly repository, in the user's home directory. The device flow works by showing the user an 8 character code in the console, and a link to https://github.com/login/device. The user needs to type in the code and approve the login. Meanwhile, the orderly2 client polls the GitHub API until the authentication has been approved. There are other OAuth flows we could have used, in particular the authorization code flow (with PKCE). In this case, a link is printed to the console and the user needs to follow it and approve the login. They are then redirected to a localhost server, which has been started by orderly2. This removes the need to need with the 8 character code of the device flow, but it is a bit finicky and assumes orderly2 is running on the same machine as the user's browser, which may not be the case when runing over SSH. For this reason, the device flow is preferred. It is still possible to specify a PAT as before, in which case the OAuth flow is skipped. This can be useful in non-interactive situations, such as a CI pipeline. Note that there are still fundamental issues with this model. In particular, the Github tokens are not bound to the application. This means that a malicious application could manage to get a user to sign in to it, obtain a access token for the user, and use this to login to Packit. From just a GitHub `read:org` scope, the app is able to escalate to full impersonation of the user on the Packit server. Additionally it still tightly couples the orderly2 client with GitHub as an authentication method, prohibiting the use of other authentication methods, such as basic username / password. Ideally we would remove the use of Github Access tokens as a way to login to Packit. Instead, Packit should itself implement an OAuth2 Authorization Server. orderly2 would perform the device flow directly against Packit, and directly retrieve a Packit JWT in exchange. During the device flow, when the user is directed to the Packit website to enter the user code, Packit may require the user to login. When this happens, a new, parallel OAuth flow would take place, this time with GitHub as the OAuth AS and Packit as the OAuth client (using the authorization code flow). When the nested flow is complete and login is succesful, the user would be prompted to type in the code and complete the flow initiated by orderly2. With this approach, orderly2 has no involvement with GitHub at all, and Packit can use another authentication method (or even no authentication). This would be completely transparent to the orderly2 client. It also provides tighter binding between GitHub and Packit, as Packit fetches the access token directly from the former, and cannot be supplied a token from an arbitrary application. --- R/location.R | 7 +- R/location_http.R | 27 +---- R/location_packit.R | 75 +++++++++++++ R/outpack_http_client.R | 24 ++-- tests/testthat/test-location-packit.R | 127 ++++++++++++++++++++++ tests/testthat/test-location.R | 69 +++++------- tests/testthat/test-outpack-http-client.R | 96 +--------------- 7 files changed, 251 insertions(+), 174 deletions(-) create mode 100644 R/location_packit.R create mode 100644 tests/testthat/test-location-packit.R diff --git a/R/location.R b/R/location.R index 63f7d07b..737e5e79 100644 --- a/R/location.R +++ b/R/location.R @@ -41,8 +41,8 @@ ##' * `url`: The location of the server ##' ##' * `token`: The value for your your login token (currently this is -##' a GitHub token with `read:org` scope). Later we'll expand this -##' as other authentication modes are supported. +##' a GitHub token with `read:org` scope). If missing or NULL, orderly2 will +##' perform an interactive authentication against GitHub to obtain one. ##' ##' **Custom locations**: ##' @@ -110,6 +110,7 @@ orderly_location_add <- function(name, type, args, root = NULL, locate = TRUE) { assert_scalar_character(loc$args[[1]]$url, name = "args$url", call = environment()) assert_scalar_character(loc$args[[1]]$token, name = "args$token", + allow_null = TRUE, call = environment()) } @@ -764,7 +765,7 @@ new_location_entry <- function(name, type, args, call = NULL) { } else if (type == "http") { required <- "url" } else if (type == "packit") { - required <- c("url", "token") + required <- c("url") } else if (type == "custom") { required <- "driver" } diff --git a/R/location_http.R b/R/location_http.R index 5ed9df6f..9750dd6c 100644 --- a/R/location_http.R +++ b/R/location_http.R @@ -6,8 +6,8 @@ orderly_location_http <- R6::R6Class( ), public = list( - initialize = function(url, auth = NULL) { - private$client <- outpack_http_client$new(url, auth) + initialize = function(url, authorise = NULL) { + private$client <- outpack_http_client$new(url, authorise) }, list = function() { @@ -86,26 +86,3 @@ orderly_location_http <- R6::R6Class( } ) ) - - -orderly_location_packit <- function(url, token) { - assert_scalar_character(url) - assert_scalar_character(token) - if (grepl("^\\$", token)) { - token_variable <- sub("^\\$", "", token) - token <- Sys.getenv(token_variable, NA_character_) - if (is.na(token)) { - cli::cli_abort( - "Environment variable '{token_variable}' was not set") - } - } - - if (!grepl("/$", url)) { - url <- paste0(url, "/") - } - url_login <- paste0(url, "packit/api/auth/login/api") - url_outpack <- paste0(url, "packit/api/outpack") - - auth <- list(url = url_login, data = list(token = scalar(token))) - orderly_location_http$new(url_outpack, auth) -} diff --git a/R/location_packit.R b/R/location_packit.R new file mode 100644 index 00000000..f2e54b36 --- /dev/null +++ b/R/location_packit.R @@ -0,0 +1,75 @@ +github_oauth_client <- function() { + # Surprisingly, we don't actually need the Client ID here to match the one + # used by Packit. It should be fine to hardcode a value regardless of which + # server we are talking to. + httr2::oauth_client( + id = "Ov23liUrbkR0qUtAO1zu", + token_url = "https://github.com/login/oauth/access_token", + name = "orderly2" + ) +} + +do_oauth_device_flow <- function(base_url) { + res <- httr2::oauth_token_cached( + client = github_oauth_client(), + flow = httr2::oauth_flow_device, + flow_params = list( + auth_url = "https://github.com/login/device/code", + scope = "read:org"), + cache_disk = TRUE) + res$access_token +} + +# Logging in with packit is quite slow and we'll want to cache this; but we +# won't be holding a persistent handle to the root. So for now at least we'll +# keep a pool of generated bearer token headers, stored against the hash of the +# auth details. We only store this on successful login. +# +# This does mean there's no way to flush the cache and force a login, but that +# should hopefully not be that big a problem. We'll probably want to refresh +# the tokens from the request anyway. +# +# 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) { + 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) + } + + login_url <- paste0(base_url, "packit/api/auth/login/api") + res <- http_client_request( + login_url, + function(r) r %>% httr2::req_body_json(list(token = scalar(token)))) + + cli::cli_alert_success("Logged in successfully") + + auth_cache[[key]] <- list("Authorization" = paste("Bearer", res$token)) + } + auth_cache[[key]] +} + +orderly_location_packit <- function(url, token) { + assert_scalar_character(url) + assert_scalar_character(token, allow_null = TRUE) + if (!is.null(token) && grepl("^\\$", token)) { + token_variable <- sub("^\\$", "", token) + token <- Sys.getenv(token_variable, NA_character_) + if (is.na(token)) { + cli::cli_abort( + "Environment variable '{token_variable}' was not set") + } + } + + if (!grepl("/$", url)) { + url <- paste0(url, "/") + } + + orderly_location_http$new( + paste0(url, "packit/api/outpack"), + function() packit_authorisation(url, token)) +} diff --git a/R/outpack_http_client.R b/R/outpack_http_client.R index 991dc3f2..5631e0fe 100644 --- a/R/outpack_http_client.R +++ b/R/outpack_http_client.R @@ -3,31 +3,24 @@ outpack_http_client <- R6::R6Class( public = list( url = NULL, - auth = NULL, + authorise = NULL, - initialize = function(url, auth) { + initialize = function(url, authorise = NULL) { self$url <- sub("/$", "", url) - if (is.null(auth)) { - self$auth <- list(enabled = FALSE) + if (is.null(authorise)) { + self$authorise <- function() NULL } else { - self$auth <- list(enabled = TRUE, url = auth$url, data = auth$data) - } - }, - - authorise = function() { - needs_auth <- self$auth$enabled && is.null(self$auth$header) - if (needs_auth) { - self$auth$header <- http_client_login(self$url, self$auth) + self$authorise <- authorise } }, request = function(path, customize = identity, ...) { - self$authorise() + auth_headers <- self$authorise() http_client_request( self$url, function(r) { r <- httr2::req_url_path_append(r, path) - r <- httr2::req_headers(r, !!!self$auth$header) + r <- httr2::req_headers(r, !!!auth_headers) customize(r) }, ...) } @@ -92,6 +85,7 @@ http_client_error <- function(msg, code, errors) { class(err) <- c("outpack_http_client_error", "error", "condition") err } +<<<<<<< HEAD ## Logging in with packit is quite slow and we'll want to cache this; @@ -118,3 +112,5 @@ http_client_login <- function(name, auth) { } auth_cache[[key]] } +======= +>>>>>>> 509a1a1 (Implement OAuth device flow for GitHub logins.) diff --git a/tests/testthat/test-location-packit.R b/tests/testthat/test-location-packit.R new file mode 100644 index 00000000..50aaf9d7 --- /dev/null +++ b/tests/testthat/test-location-packit.R @@ -0,0 +1,127 @@ +test_that("can authenticate with existing token", { + clear_auth_cache() + withr::defer(clear_auth_cache()) + + token = "my-github-token" + + mock_post <- local_mock_response( + to_json(list(token = jsonlite::unbox("my-packit-token"))), + wrap = FALSE) + + res <- evaluate_promise( + packit_authorisation("http://example.com/", token)) + + expect_length(res$messages, 2) + expect_match(res$messages[[1]], "Logging in to http://example.com") + expect_match(res$messages[[2]], "Logged in successfully") + expect_equal(res$result, + list("Authorization" = paste("Bearer", "my-packit-token"))) + + mockery::expect_called(mock_post, 1) + args <- mockery::mock_args(mock_post)[[1]] + expect_equal(args[[1]]$url, "http://example.com/packit/api/auth/login/api") + expect_equal(args[[1]]$body$data, list(token = scalar("my-github-token"))) + expect_equal(args[[1]]$body$type, "json") + + ## And a second time, does not call mock_post again: + res2 <- expect_silent( + packit_authorisation("http://example.com/", token)) + expect_equal(res2, res$result) + mockery::expect_called(mock_post, 1) +}) + + +test_that("can authenticate using device flow", { + clear_auth_cache() + withr::defer(clear_auth_cache()) + + mock_post <- local_mock_response( + to_json(list(token = jsonlite::unbox("my-packit-token"))), + wrap = FALSE) + + mockery::stub(packit_authorisation, "do_oauth_device_flow", "my-github-token") + + res <- evaluate_promise(packit_authorisation("http://example.com/", + token=NULL)) + + expect_length(res$messages, 2) + expect_match(res$messages[[1]], "Logging in to http://example.com") + expect_match(res$messages[[2]], "Logged in successfully") + expect_equal(res$result, + list("Authorization" = paste("Bearer", "my-packit-token"))) + + mockery::expect_called(mock_post, 1) + args <- mockery::mock_args(mock_post)[[1]] + expect_equal(args[[1]]$url, "http://example.com/packit/api/auth/login/api") + expect_equal(args[[1]]$body$data, list(token = scalar("my-github-token"))) + expect_equal(args[[1]]$body$type, "json") +}) + +test_that("location_packit uses authentication", { + clear_auth_cache() + withr::defer(clear_auth_cache()) + + token = "my-github-token" + id <- outpack_id() + metadata <- "packet metadata" + + mock_login <- mock_response( + to_json(list(token = jsonlite::unbox("my-packit-token"))), + wrap = FALSE) + mock_get <- mock_response(metadata) + mock <- mockery::mock(mock_login, mock_get) + httr2::local_mocked_responses(function(req) mock(req)) + + location <- orderly_location_packit("http://example.com", token) + res <- evaluate_promise(location$metadata(id)) + + expect_length(res$messages, 2) + expect_match(res$messages[[1]], "Logging in to http://example.com") + expect_match(res$messages[[2]], "Logged in successfully") + expect_equal(res$result, setNames(metadata, id)) + + mockery::expect_called(mock, 2) + + args <- mockery::mock_args(mock)[[1]] + expect_equal(args[[1]]$url, "http://example.com/packit/api/auth/login/api") + expect_equal(args[[1]]$body$data, list(token = scalar("my-github-token"))) + expect_equal(args[[1]]$body$type, "json") + + args <- mockery::mock_args(mock)[[2]] + expect_match(args[[1]]$url, + "http://example.com/packit/api/outpack/metadata/.*/text") + expect_equal(args[[1]]$headers, + list(Authorization = "Bearer my-packit-token"), + ignore_attr = TRUE) + + mock <- mockery::mock(mock_login, mock_get) +}) + +test_that("can create a packit location using an environment variable token", { + loc <- withr::with_envvar( + c("PACKIT_TOKEN" = "abc123"), + orderly_location_packit("http://example.com", "$PACKIT_TOKEN")) + + mock_login <- local_mock_response( + to_json(list(token = jsonlite::unbox("my-packit-token"))), + wrap = FALSE) + + client <- loc$.__enclos_env__$private$client + evaluate_promise(client$authorise()) + + mockery::expect_called(mock_login, 1) + + args <- mockery::mock_args(mock_login)[[1]] + expect_equal(args[[1]]$url, "http://example.com/packit/api/auth/login/api") + expect_equal(args[[1]]$body$data, list(token = scalar("abc123"))) + expect_equal(args[[1]]$body$type, "json") +}) + + +test_that("error of token variable not found", { + withr::with_envvar( + c("PACKIT_TOKEN" = NA_character_), + expect_error( + orderly_location_packit("https://example.com", "$PACKIT_TOKEN"), + "Environment variable 'PACKIT_TOKEN' was not set")) +}) diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index 9d20f278..ae14e1bb 100644 --- a/tests/testthat/test-location.R +++ b/tests/testthat/test-location.R @@ -810,11 +810,14 @@ test_that("validate arguments to packit locations", { expect_error( orderly_location_add("other", "packit", list(server = "example.com"), root = root), - "Fields missing from args: 'url' and 'token'") + "Field missing from args: 'url'") + expect_error( - orderly_location_add("other", "packit", list(url = "example.com"), + orderly_location_add("other", "packit", + list(url = "example.com", token = 123), root = root), - "Field missing from args: 'token'") + "'args$token' must be character") + expect_equal(orderly_location_list(root = root), "local") }) @@ -825,63 +828,49 @@ test_that("can add a packit location", { list(url = "https://example.com", token = "abc123"), root = root) expect_equal(orderly_location_list(root = root), c("local", "other")) + + mock_driver <- mockery::mock() + mockery::stub(location_driver, "orderly_location_packit", mock_driver) + dr <- location_driver("other", root) - expect_s3_class(dr, "orderly_location_http") # not actually packit - cl <- dr$.__enclos_env__$private$client - expect_equal(cl$url, "https://example.com/packit/api/outpack") + + mockery::expect_called(mock_driver, 1) expect_equal( - cl$auth, - list(enabled = TRUE, - url = "https://example.com/packit/api/auth/login/api", - data = list(token = scalar("abc123")))) + mockery::mock_args(mock_driver)[[1]], + list("https://example.com", "abc123")) }) +test_that("can add a packit location without a token", { + root <- create_temporary_root() + orderly_location_add("other", "packit", + list(url = "https://example.com"), + root = root) + expect_equal(orderly_location_list(root = root), c("local", "other")) -test_that("can create a packit location using an environment variable token", { - loc <- withr::with_envvar( - c("PACKIT_TOKEN" = "abc123"), - orderly_location_packit("https://example.com", "$PACKIT_TOKEN")) - client <- loc$.__enclos_env__$private$client - expect_equal( - client$auth, - list(enabled = TRUE, - url = "https://example.com/packit/api/auth/login/api", - data = list(token = scalar("abc123")))) + mock_driver <- mockery::mock() + mockery::stub(location_driver, "orderly_location_packit", mock_driver) + + dr <- location_driver("other", root) + + mockery::expect_called(mock_driver, 1) expect_equal( - client$url, - "https://example.com/packit/api/outpack") + mockery::mock_args(mock_driver)[[1]], + list("https://example.com", NULL)) }) - 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$auth, - list(enabled = TRUE, - url = "https://example.com/packit/api/auth/login/api", - data = list(token = scalar("abc123")))) expect_equal( client$url, "https://example.com/packit/api/outpack") }) -test_that("error of token variable not found", { - withr::with_envvar( - c("PACKIT_TOKEN" = NA_character_), - expect_error( - orderly_location_packit("https://example.com", "$PACKIT_TOKEN"), - "Environment variable 'PACKIT_TOKEN' was not set")) -}) - - 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$auth, - list(enabled = FALSE)) + expect_equal(client$authorise(), NULL) expect_equal( client$url, "https://example.com") diff --git a/tests/testthat/test-outpack-http-client.R b/tests/testthat/test-outpack-http-client.R index 58bcee86..699fa64d 100644 --- a/tests/testthat/test-outpack-http-client.R +++ b/tests/testthat/test-outpack-http-client.R @@ -145,111 +145,23 @@ test_that("can use the client to make requests", { test_that("can add auth details to the client", { - auth <- list(url = "http://example.com/api/login", - data = list(token = "mytoken")) - - cl <- outpack_http_client$new("http://example.com", auth) - h <- list("Authorization" = "Bearer yogi") - mock_login <- mockery::mock(h, cycle = TRUE) - mockery::stub(cl$authorise, "http_client_login", mock_login) - - cl$authorise() - - mockery::expect_called(mock_login, 1) - expect_equal( - mockery::mock_args(mock_login)[[1]], - list("http://example.com", - list(enabled = TRUE, url = auth$url, data = auth$data))) - expect_equal(cl$auth$header, h) + mock_authorise <- mockery::mock(h, cycle = TRUE) - ## Second call, does not log in - cl$authorise() - mockery::expect_called(mock_login, 1) + cl <- outpack_http_client$new("http://example.com", mock_authorise) - ## Actually perform an api call now: mock_get <- local_mock_response(json_string("[1,2,3]")) res <- cl$request("/path") expect_mapequal( res, list(status = "success", errors = NULL, data = list(1, 2, 3))) + mockery::expect_called(mock_authorise, 1) mockery::expect_called(mock_get, 1) + args <- mockery::mock_args(mock_get)[[1]] expect_equal(args[[1]]$url, "http://example.com/path") expect_equal(args[[1]]$headers, list(Authorization = "Bearer yogi"), ignore_attr = TRUE) }) - - -test_that("can send authentication request", { - clear_auth_cache() - withr::defer(clear_auth_cache()) - - mock_post <- local_mock_response( - to_json(list(token = jsonlite::unbox("mytoken"))), - wrap = FALSE) - - auth <- list( - url = "https://example.com/login", - data = list(token = "98e02a382db6a3a18e9d2e02c698478b")) - - res <- evaluate_promise( - http_client_login("foo", auth)) - - expect_length(res$messages, 2) - expect_match(res$messages[[1]], "Logging in to foo") - expect_match(res$messages[[2]], "Logged in successfully") - expect_equal(res$result, list("Authorization" = paste("Bearer", "mytoken"))) - - mockery::expect_called(mock_post, 1) - args <- mockery::mock_args(mock_post)[[1]] - expect_equal(args[[1]]$url, auth$url) - expect_equal(args[[1]]$body$data, list(token = auth$data$token)) - expect_equal(args[[1]]$body$type, "json") - - ## And a second time, does not call mock_post again: - expect_silent( - res2 <- http_client_login("foo", auth)) - expect_equal(res2, res$result) - mockery::expect_called(mock_post, 1) -}) - - -test_that("can send authenticated request", { - clear_auth_cache() - withr::defer(clear_auth_cache()) - - mock <- mockery::mock( - mock_response(to_json(list(token = jsonlite::unbox("mytoken"))), - wrap = FALSE), - mock_response(json_string("[1,2,3]"))) - httr2::local_mocked_responses(function(req) mock(req)) - - auth <- list( - url = "https://example.com/api/login", - data = list(token = "98e02a382db6a3a18e9d2e02c698478b")) - - cl <- outpack_http_client$new("http://example.com", auth) - res <- evaluate_promise(cl$request("data")) - - expect_length(res$messages, 2) - expect_match(res$messages[[1]], "Logging in to http://example.com") - expect_match(res$messages[[2]], "Logged in successfully") - expect_mapequal( - res$result, - list(status = "success", errors = NULL, data = list(1, 2, 3))) - - mockery::expect_called(mock, 2) - post_args <- mockery::mock_args(mock)[[1]] - expect_equal(post_args[[1]]$url, auth$url) - expect_equal(post_args[[1]]$body$data, list(token = auth$data$token)) - expect_equal(post_args[[1]]$body$type, "json") - - get_args <- mockery::mock_args(mock)[[2]] - expect_equal(get_args[[1]]$url, "http://example.com/data") - expect_equal(get_args[[1]]$headers, - list(Authorization = paste("Bearer mytoken")), - ignore_attr = TRUE) -}) From 86437d6c1cd46148dd14825edaf86517dceb0a75 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Mon, 2 Sep 2024 12:30:09 +0100 Subject: [PATCH 02/11] Fix bad rebase --- R/location_packit.R | 2 +- R/outpack_http_client.R | 29 ----------------------------- 2 files changed, 1 insertion(+), 30 deletions(-) diff --git a/R/location_packit.R b/R/location_packit.R index f2e54b36..38ea90f2 100644 --- a/R/location_packit.R +++ b/R/location_packit.R @@ -44,7 +44,7 @@ packit_authorisation <- function(base_url, token) { login_url <- paste0(base_url, "packit/api/auth/login/api") res <- http_client_request( login_url, - function(r) r %>% httr2::req_body_json(list(token = scalar(token)))) + function(r) r %>% http_body_json(list(token = scalar(token)))) cli::cli_alert_success("Logged in successfully") diff --git a/R/outpack_http_client.R b/R/outpack_http_client.R index 5631e0fe..880a8ba0 100644 --- a/R/outpack_http_client.R +++ b/R/outpack_http_client.R @@ -85,32 +85,3 @@ http_client_error <- function(msg, code, errors) { class(err) <- c("outpack_http_client_error", "error", "condition") err } -<<<<<<< HEAD - - -## Logging in with packit is quite slow and we'll want to cache this; -## but we won't be holding a persistant handle to the root. So for -## now at least we'll keep a pool of generated bearer token headers, -## stored against the hash of the auth details (so the url and the -## token used to log in with). We only store this on successful -## login. -## -## This does mean there's no way to flush the cache and force a login, -## but that should hopefully not be that big a problem. We'll -## probably want to refresh the tokens from the request anyway. -auth_cache <- new.env(parent = emptyenv()) -http_client_login <- function(name, auth) { - key <- rlang::hash(auth) - if (is.null(auth_cache[[key]])) { - cli::cli_alert_info("Logging in to {name}") - - res <- http_client_request(auth$url, - function(r) http_body_json(r, auth$data)) - - cli::cli_alert_success("Logged in successfully") - auth_cache[[key]] <- list("Authorization" = paste("Bearer", res$token)) - } - auth_cache[[key]] -} -======= ->>>>>>> 509a1a1 (Implement OAuth device flow for GitHub logins.) From cf06fb71e84f200e5cae4f4f507bc863fc133029 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Mon, 2 Sep 2024 12:30:52 +0100 Subject: [PATCH 03/11] Remove pipe --- R/location_packit.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/location_packit.R b/R/location_packit.R index 38ea90f2..2a1ff671 100644 --- a/R/location_packit.R +++ b/R/location_packit.R @@ -44,7 +44,7 @@ packit_authorisation <- function(base_url, token) { login_url <- paste0(base_url, "packit/api/auth/login/api") res <- http_client_request( login_url, - function(r) r %>% http_body_json(list(token = scalar(token)))) + function(r) http_body_json(r, list(token = scalar(token)))) cli::cli_alert_success("Logged in successfully") From 7634e554783f1957b01c6e2aeca3693df3022026 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Mon, 2 Sep 2024 12:32:05 +0100 Subject: [PATCH 04/11] Codefactor --- tests/testthat/test-location-packit.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-location-packit.R b/tests/testthat/test-location-packit.R index 50aaf9d7..3fdc6325 100644 --- a/tests/testthat/test-location-packit.R +++ b/tests/testthat/test-location-packit.R @@ -2,7 +2,7 @@ test_that("can authenticate with existing token", { clear_auth_cache() withr::defer(clear_auth_cache()) - token = "my-github-token" + token <- "my-github-token" mock_post <- local_mock_response( to_json(list(token = jsonlite::unbox("my-packit-token"))), @@ -22,7 +22,7 @@ test_that("can authenticate with existing token", { expect_equal(args[[1]]$url, "http://example.com/packit/api/auth/login/api") expect_equal(args[[1]]$body$data, list(token = scalar("my-github-token"))) expect_equal(args[[1]]$body$type, "json") - + ## And a second time, does not call mock_post again: res2 <- expect_silent( packit_authorisation("http://example.com/", token)) @@ -42,7 +42,7 @@ 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)) expect_length(res$messages, 2) expect_match(res$messages[[1]], "Logging in to http://example.com") @@ -61,7 +61,7 @@ test_that("location_packit uses authentication", { clear_auth_cache() withr::defer(clear_auth_cache()) - token = "my-github-token" + token <- "my-github-token" id <- outpack_id() metadata <- "packet metadata" @@ -90,7 +90,7 @@ test_that("location_packit uses authentication", { args <- mockery::mock_args(mock)[[2]] expect_match(args[[1]]$url, "http://example.com/packit/api/outpack/metadata/.*/text") - expect_equal(args[[1]]$headers, + expect_equal(args[[1]]$headers, list(Authorization = "Bearer my-packit-token"), ignore_attr = TRUE) From 7934bd84053e687ca9c5bd2f921522856005afb4 Mon Sep 17 00:00:00 2001 From: Paul Lietar Date: Mon, 2 Sep 2024 13:35:57 +0100 Subject: [PATCH 05/11] fix test --- tests/testthat/test-location.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-location.R b/tests/testthat/test-location.R index ae14e1bb..c0b741ef 100644 --- a/tests/testthat/test-location.R +++ b/tests/testthat/test-location.R @@ -816,7 +816,7 @@ 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") + "'args$token' must be character", fixed = TRUE) expect_equal(orderly_location_list(root = root), "local") }) From feec5a954d30e356580b48a18deae729cf9d0f5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Tue, 10 Sep 2024 17:24:08 +0100 Subject: [PATCH 06/11] Update R/location.R Co-authored-by: Rich FitzJohn --- R/location.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/location.R b/R/location.R index 737e5e79..87cbe092 100644 --- a/R/location.R +++ b/R/location.R @@ -765,7 +765,7 @@ new_location_entry <- function(name, type, args, call = NULL) { } else if (type == "http") { required <- "url" } else if (type == "packit") { - required <- c("url") + required <- "url" } else if (type == "custom") { required <- "driver" } From 3417860210c8aa8bd7e96efe47ae635c9d9d3781 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Wed, 11 Sep 2024 17:19:13 +0100 Subject: [PATCH 07/11] Don't use interactive for oauth --- R/location_packit.R | 24 +++++++++++++++++------- 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/R/location_packit.R b/R/location_packit.R index 2a1ff671..b169ca03 100644 --- a/R/location_packit.R +++ b/R/location_packit.R @@ -10,13 +10,23 @@ github_oauth_client <- function() { } do_oauth_device_flow <- function(base_url) { - res <- httr2::oauth_token_cached( - client = github_oauth_client(), - flow = httr2::oauth_flow_device, - flow_params = list( - auth_url = "https://github.com/login/device/code", - scope = "read:org"), - cache_disk = TRUE) + # 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 + # be opened, eg. in an SSH session. + # + # Thankfully, if we pretend to not be interactive the behaviour is a lot more + # obvious. It will just print the link to the console and with instructions + # for the user to open it up. + res <- rlang::with_interactive(value = FALSE, { + httr2::oauth_token_cached( + client = github_oauth_client(), + flow = httr2::oauth_flow_device, + flow_params = list( + auth_url = "https://github.com/login/device/code", + scope = "read:org"), + cache_disk = TRUE) + }) res$access_token } From 504fa979d5a0c64295cce7df2d70d627768f7427 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Thu, 12 Sep 2024 15:28:17 +0100 Subject: [PATCH 08/11] Bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 61f46f4d..8853892e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: orderly2 Title: Orderly Next Generation -Version: 1.99.37 +Version: 1.99.38 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), From d38a56d595dab913bc2a28e55d30eb40a054726b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Thu, 12 Sep 2024 15:28:51 +0100 Subject: [PATCH 09/11] Regenerate docs. --- man/orderly_location_add.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/orderly_location_add.Rd b/man/orderly_location_add.Rd index 742ac018..120f7650 100644 --- a/man/orderly_location_add.Rd +++ b/man/orderly_location_add.Rd @@ -79,8 +79,8 @@ have more capabilities we think. \itemize{ \item \code{url}: The location of the server \item \code{token}: The value for your your login token (currently this is -a GitHub token with \code{read:org} scope). Later we'll expand this -as other authentication modes are supported. +a GitHub token with \code{read:org} scope). If missing or NULL, orderly2 will +perform an interactive authentication against GitHub to obtain one. } \strong{Custom locations}: From 8590d003a4e5162b812645a8ac941d4d0d20d838 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 10/11] 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..114a4c26 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)) }) From d4341c6049ee2cb3f6c5e7bb09279ffbe1a4ab22 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Paul=20Li=C3=A9tar?= Date: Thu, 12 Sep 2024 16:27:32 +0100 Subject: [PATCH 11/11] regenerate docs --- man/orderly_location_add.Rd | 3 +++ 1 file changed, 3 insertions(+) diff --git a/man/orderly_location_add.Rd b/man/orderly_location_add.Rd index 120f7650..42ceb069 100644 --- a/man/orderly_location_add.Rd +++ b/man/orderly_location_add.Rd @@ -81,6 +81,9 @@ have more capabilities we think. \item \code{token}: The value for your your login token (currently this is a GitHub token with \code{read:org} scope). If missing or NULL, orderly2 will perform an interactive authentication against GitHub to obtain one. +\item \code{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. } \strong{Custom locations}: