Merge branch 'main' into cloud-static-outputs

NAMESPACE

@@ -30,6 +30,7 @@ export(forgetDeployment)
 export(generateAppName)
 export(lint)
 export(linter)
+export(listAccountEnvVars)
 export(listBundleFiles)
 export(listDeploymentFiles)
 export(purgeApp)
@@ -54,6 +55,7 @@ export(taskLog)
 export(tasks)
 export(terminateApp)
 export(unsetProperty)
+export(updateAccountEnvVars)
 export(writeManifest)
 import(rlang)
 importFrom(lifecycle,deprecated)

NEWS.md

@@ -1,5 +1,24 @@
 # rsconnect (development version)
 
+* `deployApp()` gains a new `envVars` argument which takes a vector of the 
+  names of environment variables that should be securely copied to the server. 
+  The names (not values) of these environment variables are also saved in the
+  deployment record and will be updated each time you re-deploy the app (#667).
+
+* rsconnect gains two new functions for understanding and updating the 
+  environment variables that your apps currently use. `listServerEnvVars()`
+  will return a data frame of applications, with a `envVars` list-column
+  giving the names of the environment variables used by each application.
+  `updateServerEnvVars()` will update all applications that use a specific
+  environment variable with the current value of that environment variable
+  (#667).
+
+* `deployTFModel()` is defunct. Posit Connect no longer supports hosting of
+  TensorFlow Model APIs. A TensorFlow model can be deployed as a [Plumber
+  API](https://tensorflow.rstudio.com/guides/deploy/plumber.html), [Shiny
+  application](https://tensorflow.rstudio.com/guides/deploy/shiny), or other
+  supported content type.
+
 * The default server name created by `addServer()` now includes the port,
   if used.
 

R/accounts.R

@@ -97,55 +97,52 @@ connectUser <- function(account = NULL,
 }
 
 getAuthTokenAndUser <- function(server, launch.browser = TRUE) {
-  # Generate public/private key pair
-  token <- generateToken()
-
-  # Send public key to server, and generate URL where the token can be claimed
-  client <- clientForAccount(list(server = server))
-  response <- client$addToken(list(
-    token = token$token,
-    public_key = token$public_key,
-    user_id = 0L
-  ))
-
-  claim_url <- response$token_claim_url
+  token <- getAuthToken(server)
 
   if (isTRUE(launch.browser))
-    utils::browseURL(claim_url)
+    utils::browseURL(token$claim_url)
   else if (is.function(launch.browser))
-    launch.browser(claim_url)
+    launch.browser(token$claim_url)
 
   if (isFALSE(launch.browser)) {
-    cli::cli_alert_warning("Open {.url {claim_url}} to authenticate")
+    cli::cli_alert_warning("Open {.url {token$claim_url}} to authenticate")
   } else {
     cli::cli_alert_info("A browser window should open to complete authentication")
-    cli::cli_alert_warning("If it doesn't open, please go to {.url {claim_url}}")
+    cli::cli_alert_warning("If it doesn't open, please go to {.url {token$claim_url}}")
   }
 
-  # keep trying to authenticate until we're successful; server returns
-  # 500 "Token is unclaimed error" while waiting for interactive auth to complete
-  cli::cli_progress_bar(format = "{cli::pb_spin} Waiting for authentication...")
-  repeat {
-    for (i in 1:10) {
-      Sys.sleep(0.1)
-      cli::cli_progress_update()
-    }
-    user <- tryCatch(
-      getAuthedUser(server, token = token$token, private_key = token$private_key),
-      rsconnect_http_500 = function(err) NULL
-    )
-    if (!is.null(user)) {
-      cli::cli_progress_done()
-      break
-    }
-  }
+  user <- waitForAuthedUser(
+    server,
+    token = token$token,
+    private_key = token$private_key
+  )
 
   list(
     token = token,
     user = user
   )
 }
 
+# Used by the IDE
+getAuthToken <- function(server, userId = 0) {
+  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,
+    user_id = 0L
+  ))
+
+  list(
+    token = token$token,
+    private_key = secret(token$private_key),
+    claim_url = response$token_claim_url
+  )
+}
+
 # generateToken generates a token for signing requests sent to the Posit
 # Connect service. The token's ID and public key are sent to the server, and
 # the private key is saved locally.
@@ -162,7 +159,41 @@ generateToken <- function() {
   )
 }
 
-getAuthedUser <- function(server, token = NULL, private_key = NULL, apiKey = NULL) {
+waitForAuthedUser <- function(server,
+                              token = NULL,
+                              private_key = NULL,
+                              apiKey = NULL) {
+  # keep trying to authenticate until we're successful; server returns
+  # 500 "Token is unclaimed error" while waiting for interactive auth to complete
+  cli::cli_progress_bar(format = "{cli::pb_spin} Waiting for authentication...")
+
+  repeat {
+    for (i in 1:10) {
+      Sys.sleep(0.1)
+      cli::cli_progress_update()
+    }
+    user <- tryCatch(
+      getAuthedUser(
+        server,
+        token = token,
+        private_key = private_key,
+        apiKey = apiKey
+      ),
+      rsconnect_http_500 = function(err) NULL
+    )
+    if (!is.null(user)) {
+      cli::cli_progress_done()
+      break
+    }
+  }
+
+  user
+}
+
+getAuthedUser <- function(server,
+                          token = NULL,
+                          private_key = NULL,
+                          apiKey = NULL) {
   if (!xor(is.null(token) && is.null(private_key), is.null(apiKey))) {
     cli::cli_abort("Must supply either {.arg token} + {private_key} or {.arg apiKey}")
   }
@@ -321,5 +352,5 @@ registerAccount <- function(serverName,
 }
 
 accountLabel <- function(account, server) {
-  paste0(account, "@", server)
+  paste0("server: ", server, " / username: ", account)
 }

R/appDependencies.R

@@ -110,7 +110,7 @@ appDependencies <- function(appDir = getwd(), appFiles = NULL) {
 }
 
 needsR <- function(appMetadata) {
-  if (appMetadata$appMode %in% c("static", "tensorflow-saved-model")) {
+  if (appMetadata$appMode == "static") {
     return(FALSE)
   }
 

R/appMetadata.R

@@ -82,11 +82,7 @@ checkAppLayout <- function(appDir, appPrimaryDoc = NULL) {
     Rmd = any(grepl(glob2rx("*.rmd"), appFilesBase)),
     Qmd = any(grepl(glob2rx("*.qmd"), appFilesBase)),
     static = any(grepl("(?:html?|pdf)$", appFilesBase)),
-    plumber = any(c("entrypoint.r", "plumber.r") %in% appFilesBase),
-    tensorflow = length(c(
-      Sys.glob(file.path(appDir, "*", "saved_model.pb*")),
-      Sys.glob(file.path(appDir, "saved_model.pb*"))
-    )) > 0
+    plumber = any(c("entrypoint.r", "plumber.r") %in% appFilesBase)
   )
 
   if (any(satisfiedLayouts)) {
@@ -99,8 +95,7 @@ checkAppLayout <- function(appDir, appPrimaryDoc = NULL) {
     " " = "1. A Shiny app with `app.R` or `server.R` + `ui.R`",
     " " = "2. R Markdown (`.Rmd`) or Quarto (`.qmd`) documents.",
     " " = "3. A website containing `.html` and/or `.pdf` files.",
-    " " = "4. A plumber API with `plumber.R` or `entrypoint.R`.",
-    " " = "5. A tensorflow saved model."
+    " " = "4. A plumber API with `plumber.R` or `entrypoint.R`."
   ))
 }
 
@@ -186,12 +181,6 @@ inferAppMode <- function(absoluteAppFiles,
     }
   }
 
-  # We don't have an RMarkdown, Shiny app, or Plumber API, but we have a saved model
-  modelFiles <- matchingNames(absoluteAppFiles, "^(saved_model.pb|saved_model.pbtxt)$")
-  if (length(modelFiles) > 0) {
-    return("tensorflow-saved-model")
-  }
-
   # no renderable content
   "static"
 }

R/applications.R

@@ -219,7 +219,7 @@ showLogs <- function(appPath = getwd(), appFile = NULL, appName = NULL,
                      account = NULL, server = NULL, entries = 50, streaming = FALSE) {
 
   # determine the log target and target account info
-  target <- deploymentTarget(appPath, appName, NULL, NULL, account, server)
+  target <- findDeployment(appPath, appName, account, server)
   accountDetails <- accountInfo(target$account, target$server)
   client <- clientForAccount(accountDetails)
   application <- getAppByName(client, accountDetails, target$appName)

R/client-cloud.R

@@ -1,3 +1,5 @@
+# Docs: https://build.posit.it/job/hostedapps/job/lucid-pipeline/job/main/API/
+
 cloudClient <- function(service, authInfo) {
   list(
 

R/client-connect.R

@@ -1,3 +1,5 @@
+# Docs: https://docs.posit.co/connect/api/
+
 connectClient <- function(service, authInfo) {
   list(
 
@@ -132,10 +134,31 @@ connectClient <- function(service, authInfo) {
         }
         Sys.sleep(1)
       }
-    }
+    },
 
-  )
+    # - Environment variables -----------------------------------------------
+    # https://docs.posit.co/connect/api/#get-/v1/content/{guid}/environment
 
+    getEnvVars = function(guid) {
+      path <- file.path("/v1/content", guid, "environment")
+      as.character(unlist(GET(service, authInfo, path, list())))
+    },
+
+    setEnvVars = function(guid, vars) {
+      path <- file.path("/v1/content", guid, "environment")
+      body <- unname(Map(
+        function(name, value) {
+          list(
+            name = name,
+            value = if (is.na(value)) NULL else value
+          )
+        },
+        vars,
+        Sys.getenv(vars, unset = NA)
+      ))
+      PATCH_JSON(service, authInfo, path, body)
+    }
+  )
 }
 
 # userRecord --------------------------------------------------------------

R/configureApp.R

@@ -99,7 +99,7 @@ setProperty <- function(propertyName, propertyValue, appPath = getwd(),
                         appName = NULL, account = NULL, force = FALSE) {
 
   # resolve the application target and target account info
-  target <- deploymentTarget(appPath, appName, NULL, NULL, account)
+  target <- findDeployment(appPath, appName, account)
   accountDetails <- accountInfo(target$account)
   client <- clientForAccount(accountDetails)
   application <- getAppByName(client, accountDetails, target$appName)
@@ -140,7 +140,7 @@ unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL,
                           account = NULL, force = FALSE) {
 
   # resolve the application target and target account info
-  target <- deploymentTarget(appPath, appName, NULL, NULL, account)
+  target <- findDeployment(appPath, appName, account)
   accountDetails <- accountInfo(target$account)
   client <- clientForAccount(accountDetails)
   application <- getAppByName(client, accountInfo, target$appName)
@@ -170,7 +170,7 @@ unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL,
 showProperties <- function(appPath = getwd(), appName = NULL, account = NULL) {
 
   # determine the log target and target account info
-  target <- deploymentTarget(appPath, appName, NULL, NULL, account)
+  target <- findDeployment(appPath, appName, account)
   accountDetails <- accountInfo(target$account)
   client <- clientForAccount(accountDetails)
   application <- getAppByName(client, accountDetails, target$appName)

R/deployApp.R

@@ -48,6 +48,22 @@
 #' @param appTitle Free-form descriptive title of application. Optional; if
 #'   supplied, will often be displayed in favor of the name. If ommitted,
 #'   on second and subsequent deploys, the title will be unchanged.
+#' @param envVars A character vector giving the names of environment variables
+#'   whose values should be synchronised with the server (currently supported by
+#'   Connect only). The values of the environment variables are sent over an
+#'   encrypted connection and are not stored in the bundle, making this a safe
+#'   way to send private data to Connect.
+#'
+#'   The names (not values) are stored in the deployment record so that future
+#'   deployments will automatically update their values. Other environment
+#'   variables on the server will not be affected. This means that removing an
+#'   environment variable from `envVars` will leave it unchanged on the server.
+#'   To remove it, either delete it using the Connect UI, or temporarily unset
+#'   it (with `Sys.unsetenv()` or similar) then re-deploy.
+#'
+#'   Environment variables are set prior to deployment so that your code
+#'   can use them and the first deployment can still succeed. Note that means
+#'   that if the deployment fails, the values will still be updated.
 #' @param appId Use this to deploy to an exact known application, ignoring all
 #'   existing deployment records and `appName`.
 #'
@@ -151,6 +167,7 @@ deployApp <- function(appDir = getwd(),
                       appSourceDoc = NULL,
                       appName = NULL,
                       appTitle = NULL,
+                      envVars = NULL,
                       appId = NULL,
                       contentCategory = NULL,
                       account = NULL,
@@ -286,6 +303,7 @@ deployApp <- function(appDir = getwd(),
       appId = appId,
       appName = appName,
       appTitle = appTitle,
+      envVars = envVars,
       account = account,
       server = server,
       forceUpdate = forceUpdate
@@ -299,14 +317,17 @@ deployApp <- function(appDir = getwd(),
     taskComplete(quiet, "Re-deploying {.val {target$appName}} to {.val {dest}}")
   }
 
+  # Run checks prior to first saveDeployment() to avoid errors that will always
+  # prevent a successful upload from generating a partial deployment
   isCloudServer <- isCloudServer(target$server)
   if (!isCloudServer && identical(upload, FALSE)) {
     # it is not possible to deploy to Connect without uploading
     stop("Posit Connect does not support deploying without uploading. ",
          "Specify upload=TRUE to upload and re-deploy your application.")
   }
-  # Must be run before first saveDeployment() because errors for unexpected
-  # app structures, and we don't want to leave lingering deployment artifact
+  if (!isConnectServer(target$server) && length(envVars) > 1) {
+    cli::cli_abort("{.arg envVars} only supported for Posit Connect servers")
+  }
   logger("Inferring App mode and parameters")
   appMetadata <- appMetadata(
     appDir = appDir,
@@ -359,7 +380,7 @@ deployApp <- function(appDir = getwd(),
     metadata = metadata
   )
 
-  # Change _visibility_ before uploading data
+  # Change _visibility_ & set env vars before uploading contents
   if (needsVisibilityChange(accountDetails$server, application, appVisibility)) {
     taskStart(quiet, "Setting visibility to {appVisibility}...")
     client$setApplicationProperty(
@@ -369,6 +390,11 @@ deployApp <- function(appDir = getwd(),
     )
     taskComplete(quiet, "Visibility updated")
   }
+  if (length(target$envVars) > 0) {
+    taskStart(quiet, "Updating environment variables {envVars}...")
+    client$setEnvVars(application$guid, target$envVars)
+    taskComplete(quiet, "Environment variables updated")
+  }
 
   if (upload) {
     python <- getPythonForTarget(python, accountDetails)