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) +})