republishing and collaborating

R/account-find.R

@@ -1,3 +1,6 @@
+# Return a list containing the name and server associated with a matching account.
+#
+# Use `accountInfo()` and `findAccountInfo()` to load credentials associated with this account.
 findAccount <- function(accountName = NULL, server = NULL, error_call = caller_env()) {
   check_string(accountName, allow_null = TRUE, arg = "account", call = error_call)
   check_string(server, allow_null = TRUE, call = error_call)

R/accounts.R

@@ -283,7 +283,13 @@ findShinyAppsAccountId <- function(name,
 #' @family Account functions
 #' @export
 accountInfo <- function(name = NULL, server = NULL) {
-  fullAccount <- findAccount(name, server)
+  findAccountInfo(name, server)
+}
+
+# Discovers then loads details about an account from disk.
+# Internal equivalent to accountInfo that lets callers provide error context.
+findAccountInfo <- function(name = NULL, server = NULL, error_call = caller_env()) {
+  fullAccount <- findAccount(name, server, error_call = error_call)
   configFile <- accountConfigFile(fullAccount$name, fullAccount$server)
 
   accountDcf <- read.dcf(configFile, all = TRUE)
@@ -352,5 +358,7 @@ registerAccount <- function(serverName,
 }
 
 accountLabel <- function(account, server) {
+  # Note: The incoming "account" may correspond to our local account name, which does not always
+  # match the remote username.
   paste0("server: ", server, " / username: ", account)
 }

R/applications.R

@@ -121,16 +121,21 @@ applications <- function(account = NULL, server = NULL) {
   return(res)
 }
 
-# Use the API to filter applications by name.
+# Use the API to filter applications by name and error when it does not exist.
 getAppByName <- function(client, accountInfo, name) {
   # NOTE: returns a list with 0 or 1 elements
   app <- client$listApplications(accountInfo$accountId, filters = list(name = name))
   if (length(app)) {
     return(app[[1]])
   }
-
-  stop("No application found. Specify the application's directory, name, ",
-       "and/or associated account.", call. = FALSE)
+  cli::cli_abort(
+    c(
+      "No application found",
+      i = "Specify the application directory, name, and/or associated account."
+    ),
+    call = NULL,
+    class = "rsconnect_app_not_found"
+  )
 }
 
 # Use the API to list all applications then filter the results client-side.

R/deployApp.R

@@ -325,60 +325,48 @@ deployApp <- function(appDir = getwd(),
     cli::cli_rule("Preparing for deployment")
   }
 
-  # determine the deployment target and target account info
+  forceUpdate <- forceUpdate %||% getOption("rsconnect.force.update.apps") %||% fromIDE()
+
+  # determine the target deployment record and deploying account
   recordPath <- findRecordPath(appDir, recordDir, appPrimaryDoc)
-  if (!is.null(appId) && is.null(appName)) {
-    # User has supplied only appId, so retrieve app data from server
-    # IDE supplies both appId and appName so should never hit this branch
-    target <- deploymentTargetForApp(
-      appId = appId,
-      appTitle = appTitle,
-      account = account,
-      server = server
-    )
-  } else {
-    forceUpdate <- forceUpdate %||% getOption("rsconnect.force.update.apps") %||%
-      fromIDE()
-
-    # Use name/account/server to look up existing deployment;
-    # create new deployment if no match found
-    target <- deploymentTarget(
-      recordPath = recordPath,
-      appId = appId,
-      appName = appName,
-      appTitle = appTitle,
-      envVars = envVars,
-      account = account,
-      server = server,
-      forceUpdate = forceUpdate
-    )
-  }
-  if (is.null(target$appId)) {
-    dest <- accountLabel(target$username, target$server)
-    taskComplete(quiet, "Deploying {.val {target$appName}} to {.val {dest}}")
+  target <- findDeploymentTarget(
+    recordPath = recordPath,
+    appId = appId,
+    appName = appName,
+    appTitle = appTitle,
+    envVars = envVars,
+    account = account,
+    server = server,
+    forceUpdate = forceUpdate
+  )
+  accountDetails <- target$accountDetails
+  deployment <- target$deployment
+
+  if (is.null(deployment$appId)) {
+    dest <- accountLabel(accountDetails$name, accountDetails$server)
+    taskComplete(quiet, "Deploying {.val {deployment$name}} using {.val {dest}}")
   } else {
-    dest <- accountLabel(target$username, target$server)
-    taskComplete(quiet, "Re-deploying {.val {target$appName}} to {.val {dest}}")
+    dest <- accountLabel(accountDetails$name, accountDetails$server)
+    taskComplete(quiet, "Re-deploying {.val {deployment$name}} using {.val {dest}}")
   }
 
   # Run checks prior to first saveDeployment() to avoid errors that will always
   # prevent a successful upload from generating a partial deployment
-  if (!isCloudServer(target$server) && identical(upload, FALSE)) {
+  if (!isCloudServer(accountDetails$server) && 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.")
   }
-  if (!isConnectServer(target$server) && length(envVars) > 1) {
+  if (!isConnectServer(accountDetails$server) && length(envVars) > 1) {
     cli::cli_abort("{.arg envVars} only supported for Posit Connect servers")
   }
 
-  accountDetails <- accountInfo(target$account, target$server)
   client <- clientForAccount(accountDetails)
   if (verbose) {
     showCookies(serverInfo(accountDetails$server)$url)
   }
 
-  isShinyappsServer <- isShinyappsServer(target$server)
+  isShinyappsServer <- isShinyappsServer(accountDetails$server)
 
   logger("Inferring App mode and parameters")
   appMetadata <- appMetadata(
@@ -392,11 +380,11 @@ deployApp <- function(appDir = getwd(),
     metadata = metadata
   )
 
-  if (is.null(target$appId)) {
+  if (is.null(deployment$appId)) {
     taskStart(quiet, "Creating application on server...")
     application <- client$createApplication(
-      target$appName,
-      target$appTitle,
+      deployment$name,
+      deployment$title,
       "shiny",
       accountDetails$accountId,
       appMetadata$appMode,
@@ -405,10 +393,10 @@ deployApp <- function(appDir = getwd(),
     )
     taskComplete(quiet, "Created application with id {.val {application$id}}")
   } else {
-    taskStart(quiet, "Looking up application with id {.val {target$appId}}...")
+    taskStart(quiet, "Looking up application with id {.val {deployment$appId}}...")
     application <- tryCatch(
       {
-        application <- client$getApplication(target$appId, target$version)
+        application <- client$getApplication(deployment$appId, deployment$version)
         taskComplete(quiet, "Found application {.url {application$url}}")
 
         if (identical(application$type, "static")) {
@@ -418,15 +406,15 @@ deployApp <- function(appDir = getwd(),
         application
       },
       rsconnect_http_404 = function(err) {
-        application <- applicationDeleted(client, target, recordPath, appMetadata)
+        application <- applicationDeleted(client, deployment, recordPath, appMetadata)
         taskComplete(quiet, "Created application with id {.val {application$id}}")
         application
       }
     )
   }
   saveDeployment(
     recordPath,
-    target = target,
+    target = deployment,
     application = application,
     metadata = metadata
   )
@@ -441,9 +429,9 @@ deployApp <- function(appDir = getwd(),
     )
     taskComplete(quiet, "Visibility updated")
   }
-  if (length(target$envVars) > 0) {
+  if (length(deployment$envVars) > 0) {
     taskStart(quiet, "Updating environment variables {envVars}...")
-    client$setEnvVars(application$guid, target$envVars)
+    client$setEnvVars(application$guid, deployment$envVars)
     taskComplete(quiet, "Environment variables updated")
   }
 
@@ -453,7 +441,7 @@ deployApp <- function(appDir = getwd(),
 
     taskStart(quiet, "Bundling {length(appFiles)} file{?s}: {.file {appFiles}}")
     bundlePath <- bundleApp(
-      appName = target$appName,
+      appName = deployment$name,
       appDir = appDir,
       appFiles = appFiles,
       appMetadata = appMetadata,
@@ -479,7 +467,7 @@ deployApp <- function(appDir = getwd(),
 
     saveDeployment(
       recordPath,
-      target = target,
+      target = deployment,
       application = application,
       bundleId = bundle$id,
       metadata = metadata
@@ -584,7 +572,7 @@ runDeploymentHook <- function(appDir, option, verbose = FALSE) {
   hook(appDir)
 }
 
-applicationDeleted <- function(client, target, recordPath, appMetadata) {
+applicationDeleted <- function(client, deployment, recordPath, appMetadata) {
   header <- "Failed to find existing application on server; it's probably been deleted."
   not_interactive <- c(
     i = "Use {.fn forgetDeployment} to remove outdated record and try again.",
@@ -601,16 +589,16 @@ applicationDeleted <- function(client, target, recordPath, appMetadata) {
 
   path <- deploymentConfigFile(
     recordPath,
-    target$appName,
-    target$account,
-    target$server
+    deployment$name,
+    deployment$account,
+    deployment$server
   )
   unlink(path)
 
-  accountDetails <- accountInfo(target$account, target$server)
+  accountDetails <- accountInfo(deployment$account, deployment$server)
   client$createApplication(
-    target$appName,
-    target$appTitle,
+    deployment$name,
+    deployment$title,
     "shiny",
     accountDetails$accountId,
     appMetadata$appMode