From 951eb4082050f834de98045dadb94b7cb887435b Mon Sep 17 00:00:00 2001 From: Aaron Jacobs Date: Tue, 13 Jan 2026 16:03:14 -0500 Subject: [PATCH] feat: Add identity federation support. This commit teaches rsconnect to automatically exchange a Posit Workbench user's identity token (if there is one) for an ephemeral Connect API key using the server's token exchange endpoint. This enables Workbench users to authenticate without the need to configure API keys or go through the token auth flow, provided that identity federation has been configured on the Connect server side. All of this is opportunistic, falling back to existing paths if there is no token or if the Connect server won't accept it. The majority of the complexity in the implementation is due to the fact that we want to be as backward compatible with RStudio as possible, and RStudio very much expects to run the user through the token auth flow. Finally, note that we're using the brand new `rstudioapi::getIdentityToken()` here, so this needs a version bump for the `rstudioapi` dependency. Unit tests are included. Part of https://github.com/posit-dev/connect/issues/28149. Signed-off-by: Aaron Jacobs --- DESCRIPTION | 2 +- NEWS.md | 4 + R/accounts.R | 49 ++++++- R/client-identityFederation.R | 74 ++++++++++ R/client.R | 15 ++ R/ide.R | 10 ++ tests/testthat/test-identityFederation.R | 170 +++++++++++++++++++++++ 7 files changed, 321 insertions(+), 3 deletions(-) create mode 100644 R/client-identityFederation.R create mode 100644 tests/testthat/test-identityFederation.R diff --git a/DESCRIPTION b/DESCRIPTION index a1717259..00778ca9 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,7 +31,7 @@ Imports: packrat (>= 0.6), renv (>= 1.0.0), rlang (>= 1.0.0), - rstudioapi (>= 0.5), + rstudioapi (>= 0.18.0), snowflakeauth, tools, yaml (>= 2.1.5), diff --git a/NEWS.md b/NEWS.md index aa45f1f1..5fb8b704 100644 --- a/NEWS.md +++ b/NEWS.md @@ -25,6 +25,10 @@ * Push-button publishing from desktop RStudio is now compatible with Connect servers hosted on Snowflake. +* Added support for using identity federation to authenticate against Connect + when running in Posit Workbench, when available. This allows deploying to + Connect servers without the need to store long-lived credentials. + # rsconnect 1.7.0 * Added support for deploying from `manifest.json` files created by diff --git a/R/accounts.R b/R/accounts.R index a01eb36f..136cb679 100644 --- a/R/accounts.R +++ b/R/accounts.R @@ -409,11 +409,38 @@ getAuthTokenAndUser <- function(server, launch.browser = TRUE) { # Used by the IDE getAuthToken <- function(server, userId = 0) { + account <- list(server = server) + client <- clientForAccount(account) + + # Check if we already have an API key for this server, in which case we can + # bypass the token auth flow. + serverUrl <- serverInfo(server)$url + cachedApiKey <- getCachedApiKey(serverUrl) + if (!is.null(cachedApiKey)) { + # Verify that the API key actually works. + user <- tryCatch(client$currentUser(), error = function(e) NULL) + if (!is.null(user)) { + # Return the API key as the "token" with a zero-length private key. + # waitForAuthedUser will use this to detect federated authentication later + # on. + # + # This in fairly awkward in-band signalling, but reflects the fact that we + # can't change what RStudio expects to happen here. + return(list( + token = cachedApiKey, + private_key = secret(""), + # Open a special "you're already authenticated" page as the "claim URL". + claim_url = sub("/__api__$", "/connect/#/auth-success", serverUrl), + # Signal to future RStudio versions that auth is already complete and + # there is no need to open a browser window. + authenticated = TRUE + )) + } + } + token <- generateToken() # Send public key to server, and generate URL where the token can be claimed - account <- list(server = server) - client <- clientForAccount(account) response <- client$addToken(list( token = token$token, public_key = token$public_key, @@ -449,6 +476,12 @@ waitForAuthedUser <- function( private_key = NULL, apiKey = NULL ) { + # Detect when the "token" is actually an API key by looking for an empty + # secret. + if (!is.null(token) && !nzchar(private_key)) { + return(getAuthedUser(server, apiKey = token)) + } + # keep trying to authenticate until we're successful; server returns # 500 "Token is unclaimed error" (Connect before 2024.05.0) # 401 "Unauthorized" occurs before the token has been claimed. @@ -608,6 +641,18 @@ findAccountInfo <- function( info$private_key <- gsub("[[:space:]]", "", info$private_key) } + # For standard Connect servers where there are no persisted credentials, try + # identity federation (added in v2026.01.0). + if (isConnectServer(fullAccount$server) && hasNoCredentials(info)) { + tryCatch( + { + serverUrl <- serverInfo(fullAccount$server)$url + info$apiKey <- attemptIdentityFederation(serverUrl) + }, + error = function(e) NULL + ) + } + # Hide credentials info$private_key <- secret(info$private_key) info$secret <- secret(info$secret) diff --git a/R/client-identityFederation.R b/R/client-identityFederation.R new file mode 100644 index 00000000..5594036a --- /dev/null +++ b/R/client-identityFederation.R @@ -0,0 +1,74 @@ +# Attempt exchange an identity token sourced from Posit Workbench for an +# ephemeral Connect API key. Returns NULL if this exchange fails or an API key +# otherwise. +attemptIdentityFederation <- function(serverUrl) { + cached <- getCachedApiKey(serverUrl) + if (!is.null(cached)) { + return(cached) + } + + # Only attempt this in Workbench. + if ( + Sys.getenv("POSIT_PRODUCT") != "WORKBENCH" && + !nzchar(Sys.getenv("RS_SERVER_ADDRESS")) + ) { + return(NULL) + } + + token <- tryCatch(rstudioapi::getIdentityToken(), error = function(e) NULL) + if (is.null(token)) { + return(NULL) + } + + # Call Connect's exchange endpoint. + service <- parseHttpUrl(serverUrl) + body <- paste0( + "grant_type=", + urlEncode("urn:ietf:params:oauth:grant-type:token-exchange"), + "&subject_token_type=", + urlEncode("urn:ietf:params:oauth:token-type:id_token"), + "&subject_token=", + urlEncode(token$token), + "&requested_token_type=", + urlEncode("urn:posit:connect:api-key") + ) + tryCatch( + { + response <- POST( + service, + authInfo = list(), + path = "/v1/oauth/integrations/credentials", + contentType = "application/x-www-form-urlencoded", + content = body + ) + apiKey <- response$access_token + if (!is.null(apiKey)) { + cacheApiKey(serverUrl, apiKey, token$expiry) + } + apiKey + }, + error = function(e) NULL + ) +} + +cacheApiKey <- function(serverUrl, apiKey, expiry = NULL) { + env_poke(apiKeyCache, serverUrl, list(apiKey = apiKey, expiry = expiry)) +} + +getCachedApiKey <- function(serverUrl) { + cached <- env_get(apiKeyCache, serverUrl, default = NULL) + if (is.null(cached)) { + return(NULL) + } + + # Evict expired API keys. + if (!is.null(cached$expiry) && Sys.time() >= (cached$expiry - 60L)) { + env_unbind(apiKeyCache, serverUrl) + return(NULL) + } + + cached$apiKey +} + +# Session-level cache for ephemeral API keys. +apiKeyCache <- new.env(parent = emptyenv()) diff --git a/R/client.R b/R/client.R index 2504ad7a..1cf9083a 100644 --- a/R/client.R +++ b/R/client.R @@ -14,10 +14,25 @@ clientForAccount <- function(account) { ) connectClient(serverUrl, account) } else { + # Standard Connect server - try identity federation if no credentials + if (hasNoCredentials(account)) { + ephemeralApiKey <- attemptIdentityFederation(serverInfo$url) + if (!is.null(ephemeralApiKey)) { + account$apiKey <- ephemeralApiKey + } + } connectClient(serverUrl, account) } } +hasNoCredentials <- function(account) { + is.null(account$apiKey) && + is.null(account$token) && + is.null(account$secret) && + is.null(account$private_key) && + is.null(account$accessToken) +} + # Appropriate when the list API includes "count" and "total" fields in the response JSON and the API # supports pagination with the query arguments count=PAGE_SIZE&offset=STARTING_POINT. listRequest <- function( diff --git a/R/ide.R b/R/ide.R index 4dc6f497..de6b6369 100644 --- a/R/ide.R +++ b/R/ide.R @@ -62,6 +62,16 @@ registerUserToken <- function( accessToken = NULL, refreshToken = NULL ) { + # If privateKey is empty, we're using identity federation and don't want to + # persist credentials. + if (!nzchar(privateKey)) { + return(registerAccount( + serverName = serverName, + accountName = accountName, + accountId = userId + )) + } + registerAccount( serverName = serverName, accountName = accountName, diff --git a/tests/testthat/test-identityFederation.R b/tests/testthat/test-identityFederation.R new file mode 100644 index 00000000..2d7f9e85 --- /dev/null +++ b/tests/testthat/test-identityFederation.R @@ -0,0 +1,170 @@ +# Helper to create a clean API key cache for tests +local_api_key_cache <- function(env = caller_env()) { + nms <- env_names(apiKeyCache) + zaps <- rep_named(nms, list(zap())) + + old <- env_bind(apiKeyCache, !!!zaps) + withr::defer(env_bind(apiKeyCache, !!!old), envir = env) +} + +test_that("cache stores and retrieves API keys with expiry", { + local_api_key_cache() + + expect_null(getCachedApiKey("https://example.com")) + + # Cache with future expiry + future_expiry <- Sys.time() + 3600 + cacheApiKey("https://example.com", "test-api-key", future_expiry) + expect_equal(getCachedApiKey("https://example.com"), "test-api-key") +}) + +test_that("cache returns NULL for expired keys", { + local_api_key_cache() + + # Cache with past expiry (already expired) + past_expiry <- Sys.time() - 100 + cacheApiKey("https://example.com", "expired-key", past_expiry) + + # Should return NULL because key is expired + expect_null(getCachedApiKey("https://example.com")) +}) + +test_that("cache respects expiry buffer", { + local_api_key_cache() + + # Cache with expiry just inside the buffer (should be treated as expired) + # Default buffer is 60 seconds + almost_expired <- Sys.time() + 30 + cacheApiKey("https://example.com", "almost-expired-key", almost_expired) + + # Should return NULL because within buffer + expect_null(getCachedApiKey("https://example.com")) +}) + +test_that("cache works without expiry (NULL expiry)", { + local_api_key_cache() + + # Cache without expiry + cacheApiKey("https://example.com", "no-expiry-key", NULL) + + # Should still return the key + expect_equal(getCachedApiKey("https://example.com"), "no-expiry-key") +}) + +test_that("attemptIdentityFederation returns cached key if available and not expired", { + local_api_key_cache() + + cacheApiKey("https://example.com", "cached-api-key", Sys.time() + 3600) + + # Even without Workbench env var, should return cached key + withr::local_envvar(POSIT_PRODUCT = "", RS_SERVER_ADDRESS = "") + + result <- attemptIdentityFederation("https://example.com") + expect_equal(result, "cached-api-key") +}) + +test_that("attemptIdentityFederation returns NULL when not in Workbench", { + local_api_key_cache() + + withr::local_envvar(POSIT_PRODUCT = "", RS_SERVER_ADDRESS = "") + + expect_null(attemptIdentityFederation("https://example.com")) +}) + +test_that("hasNoCredentials correctly detects missing credentials", { + # No credentials at all + expect_true(hasNoCredentials(list(server = "example.com"))) + + # Has apiKey + expect_false(hasNoCredentials(list(server = "example.com", apiKey = "key"))) + + # Has token + expect_false(hasNoCredentials(list(server = "example.com", token = "tok"))) + + # Has secret + expect_false(hasNoCredentials(list(server = "example.com", secret = "sec"))) + + # Has private_key + expect_false( + hasNoCredentials(list(server = "example.com", private_key = "pk")) + ) + + # Has accessToken + expect_false( + hasNoCredentials(list(server = "example.com", accessToken = "at")) + ) +}) + +test_that("clientForAccount attempts identity federation for Connect without credentials", { + local_temp_config() + local_api_key_cache() + + addTestServer("example.com") + + # Mock successful identity federation + local_mocked_bindings( + attemptIdentityFederation = function(serverUrl) "ephemeral-api-key" + ) + + account <- list(server = "example.com") + client <- clientForAccount(account) + + expect_equal(client$service(), "connect") +}) + +test_that("clientForAccount skips identity federation when credentials exist", { + local_temp_config() + local_api_key_cache() + + addTestServer("example.com") + + # Mock - should not be called + attempted <- FALSE + local_mocked_bindings( + attemptIdentityFederation = function(serverUrl) { + attempted <<- TRUE + "ephemeral-api-key" + } + ) + + # Account with existing API key + account <- list(server = "example.com", apiKey = "existing-key") + client <- clientForAccount(account) + + expect_equal(client$service(), "connect") + expect_false(attempted) +}) + +test_that("clientForAccount skips identity federation for ShinyApps", { + # Mock - should not be called + attempted <- FALSE + local_mocked_bindings( + attemptIdentityFederation = function(serverUrl) { + attempted <<- TRUE + "ephemeral-api-key" + } + ) + + account <- list(server = "shinyapps.io") + client <- clientForAccount(account) + + expect_equal(client$service(), "shinyapps.io") + expect_false(attempted) +}) + +test_that("clientForAccount skips identity federation for Connect Cloud", { + # Mock - should not be called + attempted <- FALSE + local_mocked_bindings( + attemptIdentityFederation = function(serverUrl) { + attempted <<- TRUE + "ephemeral-api-key" + } + ) + + account <- list(server = "connect.posit.cloud") + client <- clientForAccount(account) + + expect_equal(client$service(), "connect.posit.cloud") + expect_false(attempted) +})