feat: Add identity federation support

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),

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

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)

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())

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(

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,

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