Save deployment refactoring (#702)

* Pass target & application objects to `saveDeployment()` * Clarify logic in `applicationForTarget()` * Improve user feedback
rstudio · Feb 24, 2023 · 053edbd · 053edbd
1 parent 2b71320
commit 053edbd
Show file tree

Hide file tree

Showing 4 changed files with 129 additions and 95 deletions.
diff --git a/R/deployApp.R b/R/deployApp.R
@@ -307,17 +307,13 @@ deployApp <- function(appDir = getwd(),
     # save the deployment info for subsequent updates--we do this before
     # attempting the deployment itself to make retry easy on failure.
     logger("Saving deployment record for ", target$appName, "-", target$username)
-    saveDeployment(recordPath,
-                   target$appName,
-                   target$appTitle,
-                   target$username,
-                   target$account,
-                   accountDetails$server,
-                   serverInfo(target$server)$hostUrl,
-                   application$id,
-                   bundle$id,
-                   application$url,
-                   metadata)
+    saveDeployment(
+      recordDir,
+      target = target,
+      application = application,
+      bundleId = bundle$id,
+      metadata = metadata
+    )
   } else {
     logger("Updating ", target$appName, ", owned by ", application$owner_username,
         ", from account", accountDetails$username)
@@ -483,15 +479,6 @@ getPythonForTarget <- function(path, accountDetails) {
   }
 }
 
-
-# get the record for the application of the given name in the given account, or
-# NULL if no application exists by that name
-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)) app[[1]] else NULL
-}
-
 # get the record for the application with the given ID in the given account;
 # this isn't used inside the package itself but is invoked from the RStudio IDE
 # to look up app details
@@ -521,34 +508,49 @@ getAppById <- function(id, account = NULL, server = NULL, hostUrl = NULL) {
 }
 
 applicationForTarget <- function(client, accountInfo, target, forceUpdate) {
-
-  if (is.null(target$appId)) {
-    # list the existing applications for this account and see if we
-    # need to create a new application
-    app <- getAppByName(client, accountInfo, target$appName)
-  } else {
-    # we already know the app's id, so just retrieve the rest of the metadata
+  # Use appId from previous deployment, if it still exists
+  if (!is.null(target$appId)) {
     app <- client$getApplication(target$appId)
+    if (!is.null(app)) {
+      return(app)
+    }
   }
 
-  # if there is no record of deploying this application locally however there
-  # is an application of that name already deployed then confirm
-  if (!is.null(target$appId) && !is.null(app) && interactive() && !forceUpdate) {
-    prompt <- paste("Update application currently deployed at\n", app$url,
-                    "? [Y/n] ", sep = "")
-    input <- readline(prompt)
-    if (nzchar(input) && !identical(input, "y") && !identical(input, "Y"))
-      stop("Application deployment cancelled", call. = FALSE)
-  }
+  # Otherwise, see if there's an existing app with this name
+  sameName <- getAppByName(client, accountInfo, target$appName)
+  if (!is.null(sameName)) {
+    # check that it's ok to to use it
+    if (interactive() && !forceUpdate) {
+      cat("\n") # Escape from preparing to deploy line
+      cli::cli_inform(paste0(
+        "There is a currently deployed app with name {.str {target$appName}}",
+        " at {.url {sameName$url}}"
+      ))
+      input <- readline("Do you want to update it? [Y/n] ")
+      if (input %in% c("y", "Y", "")) {
+        return(sameName)
+      }
 
-  # create the application if we need to
-  if (is.null(app)) {
-    app <- client$createApplication(target$appName, target$appTitle, "shiny",
-                                    accountInfo$accountId)
+      cli::cli_abort(c(
+        "Each item of content must have a unique {.arg appName}.",
+        i = "Set {.arg appName} to a new value."
+      ))
+    }
   }
 
-  # return the application
-  app
+  # Otherwise, create a new app
+  client$createApplication(
+    target$appName,
+    target$appTitle,
+    "shiny",
+    accountInfo$accountId
+  )
+}
+
+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)) app[[1]] else NULL
 }
 
 validURL <- function(url) {

diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R
@@ -23,7 +23,7 @@ deploymentTarget <- function(recordPath = ".",
 
     createDeploymentTarget(
       appName,
-      appTitle %||% "",
+      appTitle,
       appId,
       fullAccount$name, # first deploy must be to own account
       fullAccount$name,
@@ -61,7 +61,7 @@ createDeploymentTarget <- function(appName,
                                    server) {
   list(
     appName = appName,
-    appTitle = appTitle,
+    appTitle = appTitle %||% "",
     appId = appId,
     username = username,
     account = account,

diff --git a/R/deployments.R b/R/deployments.R
@@ -1,39 +1,31 @@
-
-saveDeployment <- function(appPath,
-                           name,
-                           title = NULL,
-                           username = NULL,
-                           account = NULL,
-                           server = NULL,
-                           hostUrl = NULL,
-                           appId,
+saveDeployment <- function(recordDir,
+                           target,
+                           application,
                            bundleId,
-                           url,
+                           hostUrl = serverInfo(target$server)$hostUrl,
                            metadata = list()) {
 
-  fullServer <- findAccount(account, server)
-
   # create the record to write to disk
   deployment <- deploymentRecord(
-    name,
-    title %||% "",
-    username %||% fullServer$name,
-    fullServer$name,
-    fullServer$server,
-    hostUrl,
-    appId,
-    bundleId,
-    url,
+    name = target$appName,
+    title = target$appTitle %||% "",
+    username = target$username,
+    account = target$account,
+    server = target$server,
+    hostUrl = hostUrl,
+    appId = application$id,
+    bundleId = bundleId,
+    url = application$url,
     when = as.numeric(Sys.time()),
     lastSyncTime = as.numeric(Sys.time()),
-    metadata
+    metadata = metadata
   )
 
-  path <- deploymentConfigFile(appPath, name, fullServer$name, fullServer$server)
+  path <- deploymentConfigFile(recordDir, target$appName, target$account, target$server)
   writeDeploymentRecord(deployment, path)
 
   # also save to global history
-  addToDeploymentHistory(appPath, deployment)
+  addToDeploymentHistory(recordDir, deployment)
 
   invisible(NULL)
 }
@@ -174,9 +166,18 @@ deployments <- function(appPath, nameFilter = NULL, accountFilter = NULL,
   deploymentRecs
 }
 
-deploymentRecord <- function(name, title, username, account, server, hostUrl,
-                             appId, bundleId, url, when,
-                             lastSyncTime = as.numeric(Sys.time()), metadata = list()) {
+deploymentRecord <- function(name,
+                             title,
+                             username,
+                             account,
+                             server,
+                             hostUrl,
+                             appId,
+                             bundleId,
+                             url,
+                             when,
+                             lastSyncTime = as.numeric(Sys.time()),
+                             metadata = list()) {
 
   # find the username if not already supplied (may differ from account nickname)
   if (is.null(username) && length(account) > 0) {

diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R
@@ -59,19 +59,31 @@ test_that("errors if multiple deployments", {
   app_dir <- withr::local_tempdir()
   saveDeployment(
     app_dir,
-    name = "test",
-    server = "foo1",
-    appId = "1",
-    bundleId = "abc",
-    url = "http://example.com"
+    target = createDeploymentTarget(
+      appName = "test",
+      appTitle = "old title",
+      appId = "x",
+      server = "foo1",
+      username = "ron",
+      account = "ron"
+    ),
+    application = list(id = NA, url = NA),
+    bundleId = NA,
+    hostUrl = NA
   )
   saveDeployment(
     app_dir,
-    name = "test",
-    server = "foo2",
-    appId = "2",
-    bundleId = "abc",
-    url = "http://example.com"
+    target = createDeploymentTarget(
+      appName = "test",
+      appTitle = "old title",
+      appId = "x",
+      server = "foo2",
+      username = "ron",
+      account = "ron"
+    ),
+    application = list(id = NA, url = NA),
+    bundleId = NA,
+    hostUrl = NA
   )
 
   expect_snapshot(error = TRUE, {
@@ -87,10 +99,17 @@ test_that("succeeds if there's a single existing deployment", {
   file.create(file.path(app_dir, "app.R"))
   saveDeployment(
     app_dir,
-    name = "test",
-    appId = "1",
-    bundleId = "abc",
-    url = "http://example.com"
+    target = createDeploymentTarget(
+      appName = "test",
+      appTitle = "old title",
+      appId = "x",
+      server = "bar",
+      username = "ron",
+      account = "ron"
+    ),
+    application = list(id = "1", url = NA),
+    bundleId = 1,
+    hostUrl = NA
   )
 
   target <- deploymentTarget(app_dir)
@@ -109,11 +128,17 @@ test_that("new title overrides existing title", {
   file.create(file.path(app_dir, "app.R"))
   saveDeployment(
     app_dir,
-    name = "test",
-    title = "old title",
-    appId = "1",
-    bundleId = "abc",
-    url = "http://example.com"
+    target = createDeploymentTarget(
+      appName = "test",
+      appTitle = "old title",
+      appId = "x",
+      server = "bar",
+      username = NA,
+      account = "ron"
+    ),
+    application = list(id = "1", url = NA),
+    bundleId = 1,
+    hostUrl = NA
   )
 
   target <- deploymentTarget(app_dir)
@@ -157,11 +182,17 @@ test_that("on first deploy only, title affects app name", {
 
   saveDeployment(
     app_dir,
-    name = "my_title",
-    title = "my title",
-    appId = "1",
-    bundleId = "",
-    url = ""
+    target = createDeploymentTarget(
+      appName = "my_title",
+      appTitle = "my title",
+      appId = "x",
+      server = "bar",
+      username = "ron",
+      account = "ron"
+    ),
+    application = list(id = "1", url = NA),
+    bundleId = 1,
+    hostUrl = NA
   )
   target <- deploymentTarget(app_dir, appTitle = "my new title")
   expect_equal(target$appName, "my_title")