Add support for viewer-based credentials on Posit Connect.

This commit wires up a new credential provider for Connect's
viewer-based credentials feature [0]. Most of the actual work is
outsourced to a new shared package, `connectcreds` [1].

Viewer credentials are inherently tied to a given Shiny session, which
is at odds with `gargle`'s existing view that a single credential is
active for a given R process -- so we need to unwind this assumption.

In order to support storing and retrieving "session" credentials from
the existing `AuthState` object -- while preserving backward- and
forward-compatibility with existing packages -- I have modified its API
so that setters and getters are now aware of the existince of session
credentials. (There are comprehensive unit tests that explain the
details.)

Existing packages need to be updated to use this getter, if they aren't
already (most are not), but in the meantime they will continue to work
-- though they won't be able to use viewer-based credentials. This seems
like a reasonable tradeoff, and allows us to say e.g. "upgrade
`bigrquery` if you want to use it with Connect's viewer-based
credentials".

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 <aaron.jacobs@posit.co>

Author: atheriel

DESCRIPTION

@@ -35,8 +35,10 @@ Imports:
 Suggests: 
     aws.ec2metadata,
     aws.signature,
+    connectcreds,
     covr,
     httpuv,
+    httr2,
     knitr,
     rmarkdown,
     sodium,
@@ -50,3 +52,5 @@ Encoding: UTF-8
 Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
+Remotes:
+    posit-dev/connectcreds

NAMESPACE

@@ -20,6 +20,7 @@ export(cred_funs_set)
 export(cred_funs_set_default)
 export(credentials_app_default)
 export(credentials_byo_oauth2)
+export(credentials_connect)
 export(credentials_external_account)
 export(credentials_gce)
 export(credentials_service_account)

NEWS.md

@@ -1,5 +1,8 @@
 # gargle (development version)
 
+* gargle can now pick up on Google credentials from the current Shiny session
+  when running on Posit Connect (@atheriel, #289).
+
 # gargle 1.5.2
 
 * Fixed a bug in an internal helper that validates input specifying a service

R/AuthState-class.R

@@ -106,7 +106,7 @@ AuthState <- R6::R6Class("AuthState", list(
   api_key = NULL,
   #' @field auth_active Logical, indicating whether auth is active.
   auth_active = NULL,
-  #' @field cred Credentials.
+  #' @field cred Global credentials.
   cred = NULL,
   #' @description Create a new AuthState
   #' @details For more details on the parameters, see [init_AuthState()]
@@ -200,25 +200,58 @@ AuthState <- R6::R6Class("AuthState", list(
   },
   #' @description Set credentials
   #' @param cred User credentials.
-  set_cred = function(cred) {
-    self$cred <- cred
+  #' @param id An identifier for these credentials, or `NULL` to set the global
+  #'   credentials.
+  set_cred = function(cred, id = NULL) {
+    if (hasName(cred, "id")) {
+      id <- cred$id
+    }
+    if (!is.null(id)) {
+      env_poke(private$session_creds, hash(id), cred)
+    } else {
+      self$cred <- cred
+    }
     invisible(self)
   },
   #' @description Clear credentials
-  clear_cred = function() {
-    self$set_cred(NULL)
+  #' @param id An identifier for the credentials, or `NULL` to clear the global
+  #'   credentials.
+  clear_cred = function(id = current_session_id()) {
+    if (!is.null(id) && env_has(private$session_creds, hash(id))) {
+      env_unbind(private$session_creds, hash(id))
+    } else {
+      self$cred <- NULL
+    }
+    invisible(self)
   },
   #' @description Get credentials
-  get_cred = function() {
+  #' @param id An identifier for the credentials, or `NULL` to get the global
+  #'   credentials.
+  get_cred = function(id = current_session_id()) {
+    if (!is.null(id)) {
+      cred <- env_get(private$session_creds, hash(id), default = NULL)
+      if (!is.null(cred)) {
+        return(cred)
+      }
+    }
     self$cred
   },
   #' @description Report if we have credentials
-  has_cred = function() {
+  #' @param id An identifier for the credentials, or `NULL` to check the global
+  #'   credentials.
+  has_cred = function(id = current_session_id()) {
     ## FIXME(jennybc): how should this interact with auth_active? should it?
-    !is.null(self$cred)
+    !is.null(self$get_cred(id = id))
   }
+), private = list(
+  session_creds = new_environment()
 ))
 
+current_session_id <- function() {
+  # For now, only Connect's notion of a session is relevant.
+  connect_session_id()
+}
+
 make_package_hint <- function(pkg) {
   hint <- NULL
   if (is_string(pkg)) {

R/cred_funs.R

@@ -142,6 +142,7 @@ cred_funs_clear <- function() {
 cred_funs_list_default <- function() {
   list(
     credentials_byo_oauth2       = credentials_byo_oauth2,
+    credentials_connect          = credentials_connect,
     credentials_service_account  = credentials_service_account,
     credentials_external_account = credentials_external_account,
     credentials_app_default      = credentials_app_default,

R/credentials_connect.R

@@ -0,0 +1,135 @@
+#' Get a token on Posit Connect
+#'
+#' @description
+#'
+#' `r lifecycle::badge('experimental')`
+#'
+#' Shiny apps running on Posit Connect [can retrieve Google credentials for each
+#' individual viewer](https://docs.posit.co/connect/user/oauth-integrations/).
+#'
+#' Requires the \pkg{connectcreds} package.
+#'
+#' @inheritParams token_fetch
+#' @returns A [httr::Token2.0()] or `NULL`.
+#' @family credential functions
+#' @examples
+#' credentials_connect()
+#' @export
+credentials_connect <- function(scopes = NULL, ...) {
+  gargle_debug("trying {.fun credentials_connect}")
+  if (!identical(Sys.getenv("RSTUDIO_PRODUCT"), "CONNECT")) {
+    gargle_debug(c("x" = "We don't seem to be on Posit Connect."))
+    return(NULL)
+  }
+  session <- current_shiny_session()
+  if (is.null(session)) {
+    gargle_debug(c("x" = "Viewer-based credentials only work in Shiny."))
+    return(NULL)
+  }
+  if (!is_installed("connectcreds")) {
+    gargle_debug(c(
+      "x" = "Viewer-based credentials require the {.pkg connectcreds} package,\
+             but it is not installed.",
+      "i" = "Redeploy with {.pkg connectcreds} as a dependency if you wish to \
+             use viewer-based credentials. The most common way to do this is \
+             to add {.code library(connectcreds)} to your {.file app.R} file."
+    ))
+    return(NULL)
+  }
+  token <- ConnectToken$new(session, scopes = normalize_scopes(scopes))
+  gargle_debug("Connect token: {.val {token$id}}")
+  token
+}
+
+current_shiny_session <- function() {
+  if (!isNamespaceLoaded("shiny")) {
+    return(NULL)
+  }
+  # Avoid taking a Suggests dependency on Shiny, which is otherwise irrelevant
+  # to gargle.
+  f <- get("getDefaultReactiveDomain", envir = asNamespace("shiny"))
+  f()
+}
+
+connect_session_id <- function(session = current_shiny_session()) {
+  if (is.null(session)) {
+    return(NULL)
+  }
+  session$request$HTTP_POSIT_CONNECT_USER_SESSION_TOKEN
+}
+
+#' @noRd
+ConnectToken <- R6::R6Class("ConnectToken", inherit = httr::Token2.0, list(
+  #' @field id The session identifier associated with this token.
+  id = NULL,
+
+  #' @description Get a token on Posit Connect.
+  #' @param session A Shiny session.
+  #' @param scopes A list of scopes to request for the token.
+  #' @return A ConnectToken.
+  initialize = function(session, scopes = NULL) {
+    gargle_debug("ConnectToken initialize")
+    self$id <- connect_session_id(session)
+    self$params <- list(scopes = scopes)
+    private$session <- session
+    self$init_credentials()
+  },
+
+  #' @description Enact the actual token exchange with Posit Connect.
+  init_credentials = function() {
+    gargle_debug("ConnectToken init_credentials")
+    scope <- NULL
+    if (!is.null(self$params$scopes)) {
+      scope <- paste(self$params$scopes, collapse = " ")
+    }
+    self$credentials <- connectcreds::connect_viewer_token(
+      private$session,
+      scope = scope
+    )
+    self
+  },
+
+  #' @description Refreshes the token, which means re-doing the entire token
+  #'   flow in this case.
+  refresh = function() {
+    gargle_debug("ConnectToken refresh")
+    # This is a slight misuse of httr's notion of "refreshing" a token, but it
+    # works in most cases.
+    self$init_credentials()
+  },
+
+  #' @description Format a [ConnectToken()].
+  #' @param ... Not used.
+  format = function(...) {
+    x <- list(
+      id = self$id,
+      scopes = self$params$scopes,
+      credentials = commapse(names(self$credentials))
+    )
+    c(
+      cli::cli_format_method(
+        cli::cli_h1("<ConnectToken (via {.pkg gargle})>")
+      ),
+      glue("{fr(names(x))}: {fl(x)}")
+    )
+  },
+
+  #' @description Print a [ConnectToken()].
+  #' @param ... Not used.
+  print = function(...) cli::cat_line(self$format()),
+
+  #' @description Returns `TRUE` if the token can be refreshed.
+  can_refresh = function() TRUE,
+
+  #' @description Placeholder implementation of required method. Returns self.
+  cache = function() self,
+
+  #' @description Placeholder implementation of required method. Returns self.
+  load_from_cache = function() self,
+
+  #' @description Placeholder implementation of required method. Not used.
+  validate = function() {},
+
+  #' @description Placeholder implementation of required method. Not used.
+  revoke = function() {}
+), private = list(session = NULL))