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.

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: orderly2
 Title: Orderly Next Generation
-Version: 1.99.28
+Version: 1.99.29
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

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"
   }

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

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

R/outpack_http_client.R

@@ -3,32 +3,25 @@ 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(path) |>
-          httr2::req_headers(!!!self$auth$header) |>
+          httr2::req_headers(!!!auth_headers) |>
           customize()
         }, ...)
     }
@@ -89,28 +82,3 @@ http_client_error <- function(msg, code, errors) {
   class(err) <- c("outpack_http_client_error", "error", "condition")
   err
 }
-
-
-## 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, . %>% httr2::req_body_json(auth$data))
-
-    cli::cli_alert_success("Logged in successfully")
-    auth_cache[[key]] <- list("Authorization" = paste("Bearer", res$token))
-  }
-  auth_cache[[key]]
-}

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"))
+})