From af990f7a9f3140f599f6d53864cc981e7b3179fd Mon Sep 17 00:00:00 2001 From: Aaron Jacobs Date: Wed, 11 Dec 2024 13:10:55 -0500 Subject: [PATCH] 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 --- DESCRIPTION | 3 + NAMESPACE | 1 + NEWS.md | 3 + R/AuthState-class.R | 49 +++++-- R/cred_funs.R | 1 + R/credentials_connect.R | 135 +++++++++++++++++++ man/AuthState-class.Rd | 37 ++++- man/credentials_app_default.Rd | 1 + man/credentials_byo_oauth2.Rd | 1 + man/credentials_connect.Rd | 45 +++++++ man/credentials_external_account.Rd | 1 + man/credentials_gce.Rd | 1 + man/credentials_service_account.Rd | 1 + man/credentials_user_oauth2.Rd | 1 + man/token_fetch.Rd | 1 + tests/testthat/_snaps/credentials_connect.md | 27 ++++ tests/testthat/test-AuthState-class.R | 39 ++++++ tests/testthat/test-credentials_connect.R | 20 +++ 18 files changed, 354 insertions(+), 13 deletions(-) create mode 100644 R/credentials_connect.R create mode 100644 man/credentials_connect.Rd create mode 100644 tests/testthat/_snaps/credentials_connect.md create mode 100644 tests/testthat/test-credentials_connect.R diff --git a/DESCRIPTION b/DESCRIPTION index f96bbab2..5ea1f5c8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -35,6 +35,7 @@ Imports: Suggests: aws.ec2metadata, aws.signature, + connectcreds, covr, httpuv, knitr, @@ -50,3 +51,5 @@ Encoding: UTF-8 Language: en-US Roxygen: list(markdown = TRUE) RoxygenNote: 7.2.3 +Remotes: + posit-dev/connectcreds diff --git a/NAMESPACE b/NAMESPACE index 02ac4e4f..4b07fcf2 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index 57a6aba6..6042805b 100644 --- a/NEWS.md +++ b/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 diff --git a/R/AuthState-class.R b/R/AuthState-class.R index 59305180..84e5a68b 100644 --- a/R/AuthState-class.R +++ b/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)) { diff --git a/R/cred_funs.R b/R/cred_funs.R index 32b59964..1f03f2d2 100644 --- a/R/cred_funs.R +++ b/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, diff --git a/R/credentials_connect.R b/R/credentials_connect.R new file mode 100644 index 00000000..cc854b47 --- /dev/null +++ b/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("") + ), + 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)) diff --git a/man/AuthState-class.Rd b/man/AuthState-class.Rd index b87df423..a6f2793a 100644 --- a/man/AuthState-class.Rd +++ b/man/AuthState-class.Rd @@ -49,7 +49,7 @@ An \code{AuthState} should be created through the constructor function \item{\code{auth_active}}{Logical, indicating whether auth is active.} -\item{\code{cred}}{Credentials.} +\item{\code{cred}}{Global credentials.} } \if{html}{\out{}} } @@ -200,13 +200,16 @@ user credentials.} \subsection{Method \code{set_cred()}}{ Set credentials \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{AuthState$set_cred(cred)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{AuthState$set_cred(cred, id = NULL)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{cred}}{User credentials.} + +\item{\code{id}}{An identifier for these credentials, or \code{NULL} to set the global +credentials.} } \if{html}{\out{
}} } @@ -217,9 +220,17 @@ Set credentials \subsection{Method \code{clear_cred()}}{ Clear credentials \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{AuthState$clear_cred()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{AuthState$clear_cred(id = current_session_id())}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{id}}{An identifier for the credentials, or \code{NULL} to clear the global +credentials.} +} +\if{html}{\out{
}} +} } \if{html}{\out{
}} \if{html}{\out{}} @@ -227,9 +238,17 @@ Clear credentials \subsection{Method \code{get_cred()}}{ Get credentials \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{AuthState$get_cred()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{AuthState$get_cred(id = current_session_id())}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{id}}{An identifier for the credentials, or \code{NULL} to get the global +credentials.} +} +\if{html}{\out{
}} +} } \if{html}{\out{
}} \if{html}{\out{}} @@ -237,9 +256,17 @@ Get credentials \subsection{Method \code{has_cred()}}{ Report if we have credentials \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{AuthState$has_cred()}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{AuthState$has_cred(id = current_session_id())}\if{html}{\out{
}} } +\subsection{Arguments}{ +\if{html}{\out{
}} +\describe{ +\item{\code{id}}{An identifier for the credentials, or \code{NULL} to check the global +credentials.} +} +\if{html}{\out{
}} +} } \if{html}{\out{
}} \if{html}{\out{}} diff --git a/man/credentials_app_default.Rd b/man/credentials_app_default.Rd index 3e180bfc..92664e26 100644 --- a/man/credentials_app_default.Rd +++ b/man/credentials_app_default.Rd @@ -69,6 +69,7 @@ credentials_app_default() Other credential functions: \code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_external_account}()}, \code{\link{credentials_gce}()}, \code{\link{credentials_service_account}()}, diff --git a/man/credentials_byo_oauth2.Rd b/man/credentials_byo_oauth2.Rd index 77d93e61..085a8e01 100644 --- a/man/credentials_byo_oauth2.Rd +++ b/man/credentials_byo_oauth2.Rd @@ -69,6 +69,7 @@ credentials_byo_oauth2(token = my_token) \seealso{ Other credential functions: \code{\link{credentials_app_default}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_external_account}()}, \code{\link{credentials_gce}()}, \code{\link{credentials_service_account}()}, diff --git a/man/credentials_connect.Rd b/man/credentials_connect.Rd new file mode 100644 index 00000000..281f2a8a --- /dev/null +++ b/man/credentials_connect.Rd @@ -0,0 +1,45 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/credentials_connect.R +\name{credentials_connect} +\alias{credentials_connect} +\title{Get a token on Posit Connect} +\usage{ +credentials_connect(scopes = NULL, ...) +} +\arguments{ +\item{scopes}{A character vector of scopes to request. Pick from those listed +at \url{https://developers.google.com/identity/protocols/oauth2/scopes}. + +For certain token flows, the +\code{"https://www.googleapis.com/auth/userinfo.email"} scope is unconditionally +included. This grants permission to retrieve the email address associated +with a token; gargle uses this to index cached OAuth tokens. This grants no +permission to view or send email and is generally considered a low-value +scope.} + +\item{...}{Additional arguments passed to all credential functions.} +} +\value{ +A \code{\link[httr:Token-class]{httr::Token2.0()}} or \code{NULL}. +} +\description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} + +Shiny apps running on Posit Connect \href{https://docs.posit.co/connect/user/oauth-integrations/}{can retrieve Google credentials for each individual viewer}. + +Requires the \pkg{connectcreds} package. +} +\examples{ +credentials_connect() +} +\seealso{ +Other credential functions: +\code{\link{credentials_app_default}()}, +\code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_external_account}()}, +\code{\link{credentials_gce}()}, +\code{\link{credentials_service_account}()}, +\code{\link{credentials_user_oauth2}()}, +\code{\link{token_fetch}()} +} +\concept{credential functions} diff --git a/man/credentials_external_account.Rd b/man/credentials_external_account.Rd index 0c454e6c..bc8897bd 100644 --- a/man/credentials_external_account.Rd +++ b/man/credentials_external_account.Rd @@ -81,6 +81,7 @@ a high-level overview and step-by-step instructions. Other credential functions: \code{\link{credentials_app_default}()}, \code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_gce}()}, \code{\link{credentials_service_account}()}, \code{\link{credentials_user_oauth2}()}, diff --git a/man/credentials_gce.Rd b/man/credentials_gce.Rd index db8db8d3..fea55b03 100644 --- a/man/credentials_gce.Rd +++ b/man/credentials_gce.Rd @@ -96,6 +96,7 @@ How to attach a service account to a resource: Other credential functions: \code{\link{credentials_app_default}()}, \code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_external_account}()}, \code{\link{credentials_service_account}()}, \code{\link{credentials_user_oauth2}()}, diff --git a/man/credentials_service_account.Rd b/man/credentials_service_account.Rd index ce766b2a..8c607906 100644 --- a/man/credentials_service_account.Rd +++ b/man/credentials_service_account.Rd @@ -60,6 +60,7 @@ Additional reading on delegation of domain-wide authority: Other credential functions: \code{\link{credentials_app_default}()}, \code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_external_account}()}, \code{\link{credentials_gce}()}, \code{\link{credentials_user_oauth2}()}, diff --git a/man/credentials_user_oauth2.Rd b/man/credentials_user_oauth2.Rd index 8dd068fe..c0996927 100644 --- a/man/credentials_user_oauth2.Rd +++ b/man/credentials_user_oauth2.Rd @@ -115,6 +115,7 @@ credentials_user_oauth2(scopes, client) Other credential functions: \code{\link{credentials_app_default}()}, \code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_external_account}()}, \code{\link{credentials_gce}()}, \code{\link{credentials_service_account}()}, diff --git a/man/token_fetch.Rd b/man/token_fetch.Rd index eb5cc073..6ac1c5d1 100644 --- a/man/token_fetch.Rd +++ b/man/token_fetch.Rd @@ -42,6 +42,7 @@ credential-fetching functions, in order. Other credential functions: \code{\link{credentials_app_default}()}, \code{\link{credentials_byo_oauth2}()}, +\code{\link{credentials_connect}()}, \code{\link{credentials_external_account}()}, \code{\link{credentials_gce}()}, \code{\link{credentials_service_account}()}, diff --git a/tests/testthat/_snaps/credentials_connect.md b/tests/testthat/_snaps/credentials_connect.md new file mode 100644 index 00000000..aa01c084 --- /dev/null +++ b/tests/testthat/_snaps/credentials_connect.md @@ -0,0 +1,27 @@ +# connect_credentials() explains why it doesn't work + + Code + . <- credentials_connect() + Message + trying `credentials_connect()` + x We don't seem to be on Posit Connect. + +--- + + Code + . <- credentials_connect() + Message + trying `credentials_connect()` + x Viewer-based credentials only work in Shiny. + +# ConnectToken makes exchange requests to the Connect server as expected + + Code + token + Output + + -- ------------------------------------------------- + id: user-token + scopes: https://www.googleapis.com/auth/bigquery , https://www.googleapis.com/auth/cloud-platform + credentials: token_type, access_token, issued_token_type + diff --git a/tests/testthat/test-AuthState-class.R b/tests/testthat/test-AuthState-class.R index a5fe046b..4e3eb3f0 100644 --- a/tests/testthat/test-AuthState-class.R +++ b/tests/testthat/test-AuthState-class.R @@ -73,6 +73,45 @@ test_that("AuthState supports basic handling of cred", { expect_equal(a$get_cred(), "bye") }) +test_that("AuthState supports session credentials", { + client <- gargle_oauth_client(id = "CLIENT_ID", secret = "SECRET", name = "AAA") + a <- init_AuthState(client = client, api_key = "AAA", auth_active = TRUE) + + # Verify that we can set and get session credentials. + local_mocked_bindings(current_session_id = function() "1") + cred_s1 <- list(id = "1", token = "y") + cred_s2 <- list(id = "2", token = "z") + a$set_cred(cred_s1) + a$set_cred(cred_s2) + expect_true(a$has_cred()) + expect_equal(a$get_cred(), cred_s1) + expect_equal(a$get_cred("2"), cred_s2) + expect_equal(a$get_cred(NULL), NULL) + + # Some packages access this directly; make sure it can't contain a session + # credential. + expect_equal(a$cred, NULL) + + # Both session and for global credentials can coexist. + cred_global <- list(token = "x") + expect_false(a$has_cred(NULL)) + a$set_cred(cred_global) + + # Verify backwards compatibility again. + expect_equal(a$cred, cred_global) + + # Clearing session credentials falls back to global credentials, unless they + # are themselves cleared. + a$clear_cred() + expect_true(a$has_cred()) + expect_equal(a$get_cred(), cred_global) + a$clear_cred() + expect_false(a$has_cred()) + + # Backwards compatibility, one more time. + expect_equal(a$cred, NULL) +}) + test_that("AuthState prints nicely", { client <- gargle_oauth_client(id = "CLIENT_ID", secret = "SECRET", name = "AAA") a <- init_AuthState( diff --git a/tests/testthat/test-credentials_connect.R b/tests/testthat/test-credentials_connect.R new file mode 100644 index 00000000..39ca0776 --- /dev/null +++ b/tests/testthat/test-credentials_connect.R @@ -0,0 +1,20 @@ +test_that("connect_credentials() explains why it doesn't work", { + withr::local_options(gargle_verbosity = "debug") + expect_snapshot(. <- credentials_connect()) + withr::local_envvar(RSTUDIO_PRODUCT = "CONNECT") + expect_snapshot(. <- credentials_connect()) +}) + +test_that("ConnectToken makes exchange requests to the Connect server as expected", { + skip_if_not_installed("connectcreds") + connectcreds::local_mocked_connect_responses(token = "token") + token <- ConnectToken$new( + session = connectcreds::example_connect_session(), + scopes = c( + "https://www.googleapis.com/auth/bigquery", + "https://www.googleapis.com/auth/cloud-platform" + ) + ) + expect_equal(token$credentials$access_token, "token") + expect_snapshot(token) +})