Enable oauth_flow_auth_code to parse URL for component code and state

NEWS.md

@@ -1,5 +1,8 @@
 # httr2 (development version)
 
+* `oauth_flow_auth_code()` allows the user to enter a URL that contains 
+  authorization `code` and `state` parameters (@fh-mthomson, #326).
+
 * `req_oauth_device()` now takes a `auth_url` parameter making it usable 
   (#331, @taerwin).
 
@@ -44,7 +47,7 @@
 * `oauth_flow_auth_code()` deprecates `host_name` and `port` arguments in favour
   of using `redirect_uri`. It also deprecates `host_ip` since it seems unlikely
   that changing this is ever useful.
-
+  
 * New `oauth_cache_path()` returns the path that httr2 uses for caching OAuth
   tokens. Additionally, you can now change the cache location by setting the
   `HTTR2_OAUTH_CACHE` env var.

R/oauth-flow-auth-code.R

@@ -437,29 +437,49 @@ is_hosted_session <- function() {
 }
 
 oauth_flow_auth_code_read <- function(state) {
-  code <- trimws(readline("Enter authorization code: "))
-  # We support two options here:
-  #
-  # 1) The original {gargle} style, where the user copy & pastes a
-  #    base64-encoded JSON object with both the code and state. This is used on
-  #    https://www.tidyverse.org/google-callback/; and
-  #
-  # 2) The full manual approach, where the code and state are entered
-  #    independently.
-  result <- tryCatch(
-   jsonlite::fromJSON(rawToChar(openssl::base64_decode(code))),
-   error = function(e) {
-    list(
-      code = code,
-      state = trimws(readline("Enter state parameter: "))
-    )
-  })
-  if (!identical(result$state, state)) {
+  code <- trimws(readline("Enter authorization code or URL: "))
+
+  if (is_string_url(code)) {
+    # minimal setup where user copy & pastes a URL
+    parsed <- url_parse(code)
+
+    code <- parsed$query$code
+    new_state <- parsed$query$state
+  } else if (is_base64_json(code)) {
+    # {gargle} style, where the user copy & pastes a base64-encoded JSON
+    # object with both the code and state. This is used on
+    # https://www.tidyverse.org/google-callback/
+    json <- jsonlite::fromJSON(rawToChar(openssl::base64_decode(code)))
+
+    code <- json$code
+    new_state <- json$state
+  } else {
+    # Full manual approach, where the code and state are entered
+    # independently.
+
+    new_state <- trimws(readline("Enter state parameter: "))
+  }
+
+  if (!identical(state, new_state)) {
     abort("Authentication failure: state does not match")
   }
-  result$code
+
+  code
 }
 
+is_string_url <- function(x) grepl("^https?://", x)
+
+is_base64_json <- function(x) {
+  tryCatch(
+    {
+      jsonlite::fromJSON(rawToChar(openssl::base64_decode(x)))
+      TRUE
+    },
+    error = function(err) FALSE
+  )
+}
+
+
 # Determine whether we can fetch the OAuth authorization code from an external
 # source without user interaction.
 can_fetch_oauth_code <- function(redirect_url) {

tests/testthat/test-oauth-flow-auth-code.R

@@ -20,14 +20,21 @@ test_that("so-called 'hosted' sessions are detected correctly", {
   })
 })
 
+test_that("URL embedding authorisation code and state can be input manually", {
+  local_mocked_bindings(
+    readline = function(prompt = "") "https://x.com?code=code&state=state"
+  )
+  expect_equal(oauth_flow_auth_code_read("state"), "code")
+  expect_error(oauth_flow_auth_code_read("invalid"), "state does not match")
+})
+
 test_that("JSON-encoded authorisation codes can be input manually", {
-  state <- base64_url_rand(32)
-  input <- list(state = state, code = "abc123")
+  input <- list(state = "state", code = "code")
   encoded <- openssl::base64_encode(jsonlite::toJSON(input))
   local_mocked_bindings(
     readline = function(prompt = "") encoded
   )
-  expect_equal(oauth_flow_auth_code_read(state), "abc123")
+  expect_equal(oauth_flow_auth_code_read("state"), "code")
   expect_error(oauth_flow_auth_code_read("invalid"), "state does not match")
 })