Add support for viewer-based credentials on Posit Connect.

This commit brings support for Posit Connect's "viewer-based
credentials" feature [0] to `gh`.

Checks for viewer-based credentials are designed to fall back gracefully
to existing authentication methods. This is intended to allow users to
-- for example -- develop and test a Shiny app that uses GitHub
credentials in desktop Positron/RStudio or Posit Workbench and deploy it
with no code changes to Connect.

Most of the actual work is outsourced to a new shared package,
`connectcreds` [1].

Unit tests are included.

[0]: https://docs.posit.co/connect/user/oauth-integrations/
[1]: https://github.com/posit-dev/connectcreds/

Signed-off-by: Aaron Jacobs <[email protected]>

Author: atheriel

DESCRIPTION

@@ -23,6 +23,7 @@ Imports:
     lifecycle,
     rlang (>= 1.0.0)
 Suggests:
+    connectcreds,
     covr,
     knitr,
     rmarkdown,
@@ -39,4 +40,5 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.2
 Remotes:  
+    posit-dev/connectcreds,
     r-lib/httr2

NEWS.md

@@ -4,6 +4,9 @@
 * `gh()` now uses a cache provided by httr2. This cache lives in `tools::R_user_dir("gh", "cache")`, maxes out at 100 MB, and can be disabled by setting `options(gh_cache = FALSE)` (#203).
 * Removes usage of mockery (@tanho63, #197)
 
+* `gh_token()` can now pick up on GitHub credentials from the current Shiny
+  session when running on Posit Connect (@atheriel, #217).
+
 # gh 1.4.1
 
 * `gh_next()`, `gh_prev()`, `gh_first()` and `gh_last()`

R/gh_token.R

@@ -46,8 +46,16 @@
 gh_token <- function(api_url = NULL) {
   api_url <- api_url %||% default_api_url()
   stopifnot(is.character(api_url), length(api_url) == 1)
+  host_url <- get_hosturl(api_url)
+  # Check for credentials supplied by Posit Connect.
+  if (is_installed("connectcreds")) {
+    if (connectcreds::has_viewer_token(host_url)) {
+      token <- connectcreds::connect_viewer_token(host_url)
+      return(gh_pat(token$access_token))
+    }
+  }
   token <- tryCatch(
-    gitcreds::gitcreds_get(get_hosturl(api_url)),
+    gitcreds::gitcreds_get(host_url),
     error = function(e) NULL
   )
   gh_pat(token$password %||% "")
@@ -56,15 +64,7 @@ gh_token <- function(api_url = NULL) {
 #' @export
 #' @rdname gh_token
 gh_token_exists <- function(api_url = NULL) {
-  api_url <- api_url %||% default_api_url()
-  tryCatch(
-    {
-      token <- gitcreds::gitcreds_get(get_hosturl(api_url))
-      gh_pat(token$password)
-      TRUE
-    } ,
-    error = function(e) FALSE
-  )
+  tryCatch(nzchar(gh_token(api_url)), error = function(e) FALSE)
 }
 
 gh_auth <- function(token) {

tests/testthat/test-gh_token.R

@@ -163,3 +163,11 @@ test_that("get_apiurl() works", {
   expect_equal(get_apiurl("https://github.acme.com/OWNER/REPO"), x)
   expect_equal(get_apiurl("https://github.acme.com/api/v3"), x)
 })
+
+test_that("tokens can be requested from a Connect server", {
+  skip_if_not_installed("connectcreds")
+
+  token <- strrep("a", 40)
+  connectcreds::local_mocked_connect_responses(token = token)
+  expect_equal(gh_token(), gh_pat(token))
+})