From 266789b97093bbf70ddec48d965b17be17a716cb Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Fri, 20 Oct 2023 08:45:30 -0400 Subject: [PATCH 01/17] shift all deployment target lookups into deploymentTarget ahead of more work --- R/deployApp.R | 38 ++++++++++++-------------------------- R/deploymentTarget.R | 13 +++++++++++++ 2 files changed, 25 insertions(+), 26 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index 9f99a672..26add694 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -325,34 +325,20 @@ deployApp <- function(appDir = getwd(), cli::cli_rule("Preparing for deployment") } + forceUpdate <- forceUpdate %||% getOption("rsconnect.force.update.apps") %||% fromIDE() + # determine the deployment target and target account info 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 - ) - } + 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}}") diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 4e2b9690..e623a23d 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -10,6 +10,19 @@ deploymentTarget <- function(recordPath = ".", forceUpdate = FALSE, error_call = caller_env()) { + 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 + return(deploymentTargetForApp( + appId = appId, + appTitle = appTitle, + account = account, + server = server + )) + } + + # Use name/account/server to look up existing deployment; + # create new deployment if no match found appDeployments <- deployments( appPath = recordPath, nameFilter = appName, From e0fb6efed9b7d58112b4306ca00bd986a20973cc Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Mon, 23 Oct 2023 12:09:33 -0400 Subject: [PATCH 02/17] republishing/collaboration improvements prioritized set of deployment considerations: 1. appId used above all else, and may be owned by a non-local account. 2. appName can identify local or remote content, owned by a local account. 3. locally available deployments are preferred when other identifiers not provided. 4. fall-back on generated name (based on path) and user-chosen local account. --- R/accounts.R | 2 + R/applications.R | 8 +- R/configureApp.R | 12 + R/deployApp.R | 67 ++--- R/deploymentTarget.R | 285 ++++++++++++++++------ R/deployments-find.R | 4 + tests/testthat/_snaps/deploymentTarget.md | 27 +- tests/testthat/test-client-cloud.R | 21 +- tests/testthat/test-deploymentTarget.R | 172 +++++++++---- 9 files changed, 420 insertions(+), 178 deletions(-) diff --git a/R/accounts.R b/R/accounts.R index 6f0ebe31..8e4745dd 100644 --- a/R/accounts.R +++ b/R/accounts.R @@ -352,5 +352,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) } diff --git a/R/applications.R b/R/applications.R index 8efd86e9..9429cfaa 100644 --- a/R/applications.R +++ b/R/applications.R @@ -128,9 +128,7 @@ getAppByName <- function(client, accountInfo, name) { if (length(app)) { return(app[[1]]) } - - stop("No application found. Specify the application's directory, name, ", - "and/or associated account.", call. = FALSE) + return(NULL) } # Use the API to list all applications then filter the results client-side. @@ -240,6 +238,10 @@ showLogs <- function(appPath = getwd(), appFile = NULL, appName = NULL, accountDetails <- accountInfo(deployment$account, deployment$server) client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, deployment$name) + if (is.null(application)) { + stop("No application found. Specify the application's directory, name, ", + "and/or associated account.", call. = FALSE) + } if (streaming) { # streaming; poll for the entries directly diff --git a/R/configureApp.R b/R/configureApp.R index a634a188..9d13a2de 100644 --- a/R/configureApp.R +++ b/R/configureApp.R @@ -111,6 +111,10 @@ setProperty <- function(propertyName, propertyValue, appPath = getwd(), client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, deployment$name) + if (is.null(application)) { + stop("No application found. Specify the application's directory, name, ", + "and/or associated account.", call. = FALSE) + } invisible(client$setApplicationProperty(application$id, propertyName, @@ -150,6 +154,10 @@ unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL, client <- clientForAccount(accountDetails) application <- getAppByName(client, accountInfo, deployment$name) + if (is.null(application)) { + stop("No application found. Specify the application's directory, name, ", + "and/or associated account.", call. = FALSE) + } invisible(client$unsetApplicationProperty(application$id, propertyName, @@ -182,6 +190,10 @@ showProperties <- function(appPath = getwd(), appName = NULL, account = NULL, se client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, deployment$name) + if (is.null(application)) { + stop("No application found. Specify the application's directory, name, ", + "and/or associated account.", call. = FALSE) + } # convert to data frame res <- do.call(rbind, application$deployment$properties) diff --git a/R/deployApp.R b/R/deployApp.R index 26add694..60b4af09 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -271,6 +271,15 @@ deployApp <- function(appDir = getwd(), recordDir <- appSourceDoc } + cat(paste("deployApp entry:", + "appDir:", appDir, + "appId:", appId, + "appName:", appName, + "appTitle:", appTitle, + "account:", account, + "server:",server, + "\n")) + # set up logging helpers logLevel <- match.arg(logLevel) quiet <- identical(logLevel, "quiet") @@ -327,7 +336,7 @@ deployApp <- function(appDir = getwd(), forceUpdate <- forceUpdate %||% getOption("rsconnect.force.update.apps") %||% fromIDE() - # determine the deployment target and target account info + # determine the target deployment record and deploying account recordPath <- findRecordPath(appDir, recordDir, appPrimaryDoc) target <- deploymentTarget( recordPath = recordPath, @@ -339,32 +348,34 @@ deployApp <- function(appDir = getwd(), server = server, forceUpdate = forceUpdate ) - if (is.null(target$appId)) { - dest <- accountLabel(target$username, target$server) - taskComplete(quiet, "Deploying {.val {target$appName}} to {.val {dest}}") + accountDetails <- target$accountDetails + deployment <- target$deployment + + if (is.null(deployment$appId)) { + dest <- accountLabel(accountDetails$name, accountDetails$server) + taskComplete(quiet, "Deploying {.val {deployment$appName}} 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$appName}} 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( @@ -378,11 +389,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$appName, + deployment$appTitle, "shiny", accountDetails$accountId, appMetadata$appMode, @@ -391,10 +402,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")) { @@ -404,7 +415,7 @@ 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 } @@ -412,7 +423,7 @@ deployApp <- function(appDir = getwd(), } saveDeployment( recordPath, - target = target, + target = deployment, application = application, metadata = metadata ) @@ -427,9 +438,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") } @@ -439,7 +450,7 @@ deployApp <- function(appDir = getwd(), taskStart(quiet, "Bundling {length(appFiles)} file{?s}: {.file {appFiles}}") bundlePath <- bundleApp( - appName = target$appName, + appName = deployment$appName, appDir = appDir, appFiles = appFiles, appMetadata = appMetadata, @@ -465,7 +476,7 @@ deployApp <- function(appDir = getwd(), saveDeployment( recordPath, - target = target, + target = deployment, application = application, bundleId = bundle$id, metadata = metadata @@ -570,7 +581,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.", @@ -587,16 +598,16 @@ applicationDeleted <- function(client, target, recordPath, appMetadata) { path <- deploymentConfigFile( recordPath, - target$appName, - target$account, - target$server + deployment$appName, + 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$appName, + deployment$appTitle, "shiny", accountDetails$accountId, appMetadata$appMode diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index e623a23d..70d52b19 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -1,106 +1,241 @@ # calculate the deployment target based on the passed parameters and # any saved deployments that we have -deploymentTarget <- function(recordPath = ".", - appId = NULL, - appName = NULL, - appTitle = NULL, - envVars = NULL, - account = NULL, - server = NULL, - forceUpdate = FALSE, - error_call = caller_env()) { - - 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 - return(deploymentTargetForApp( +deploymentTarget <- function( + recordPath = ".", + appId = NULL, + appName = NULL, + appTitle = NULL, + envVars = NULL, + account = NULL, + server = NULL, + forceUpdate = FALSE, + error_call = caller_env() +) { + + if (!is.null(appId)) { + return(deploymentTargetFromAppId( + recordPath = recordPath, appId = appId, + appName = appName, appTitle = appTitle, + envVars = envVars, account = account, - server = server + server = server, + error_call = error_call )) } - # Use name/account/server to look up existing deployment; - # create new deployment if no match found - appDeployments <- deployments( + if (!is.null(appName)) { + return(deploymentTargetFromAppName( + recordPath = recordPath, + appName = appName, + appTitle = appTitle, + envVars = envVars, + account = account, + server = server, + forceUpdate = forceUpdate, + error_call = error_call + )) + } + + # No identifying appId or appName. + + # When there are existing deployments, ask the user to select one and use + # it. Only deployments associated with locally configured account+server + # combinations are considered. + allDeployments <- deployments( appPath = recordPath, - nameFilter = appName, accountFilter = account, serverFilter = server ) + if (nrow(allDeployments) > 0) { + deployment <- disambiguateDeployments(allDeployments, error_call = error_call) + deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + accountDetails <- accountInfo(deployment$account, deployment$server) + return(list( + accountDetails = accountDetails, + deployment = deployment + )) + } - if (nrow(appDeployments) == 0) { - fullAccount <- findAccount(account, server) - if (is.null(appName)) { - appName <- defaultAppName(recordPath, fullAccount$server) - } else { - check_string(appName, call = error_call) - } + # Otherwise, identify a target account (given just one available or prompted + # by the user), generate a name, and locate the deployment. + accountDetails <- accountInfo(account, server) + appName <- generateAppName(appTitle, recordPath, accountDetails$name, unique = FALSE) + return(deploymentTargetFromAppName( + recordPath = recordPath, + appName = appName, + appTitle = appTitle, + envVars = envVars, + account = accountDetails$name, + server = accountDetails$server, + forceUpdate = forceUpdate, + error_call = error_call + )) +} - appId <- NULL - if (!isPositCloudServer(fullAccount$server)) { - # Have we previously deployed elsewhere? We can't do this on cloud - # because it assigns random app names (see #808 for details). - existing <- applications(fullAccount$name, fullAccount$server) - if (appName %in% existing$name) { - thisApp <- existing[appName == existing$name, , drop = FALSE] - uniqueName <- findUnique(appName, existing$name) - - if (shouldUpdateApp(thisApp, uniqueName, forceUpdate)) { - appId <- thisApp$id - appName <- thisApp$name - } else { - appName <- uniqueName - } - } - } +# Discover the deployment target given appId. +# +# When appId is provided, all other information is secondary. An appId is an indication from the +# caller that the content has already been deployed elsewhere. If we cannot locate that content, +# deployment fails. +# +# The target content may have been created by some other user; the account for this session may +# differ from the account used when creating the content. +deploymentTargetFromAppId <- function( + recordPath = ".", + appId = NULL, + appName = NULL, + appTitle = NULL, + envVars = NULL, + account = NULL, + server = NULL, + error_call = caller_env() +) { - createDeploymentTarget( - appName = appName, - appTitle = appTitle, - appId = appId, - envVars = envVars, - username = fullAccount$name, # first deploy must be to own account - account = fullAccount$name, - server = fullAccount$server + # We must have a target account+server in order to use the appId. + # The selected account may not be the original creator of the content. + accountDetails <- accountInfo(account, server) + + # Filtering is only by server and includes all deployments in case we have a deployment record + # from a collaborator. + appDeployments <- deployments( + appPath = recordPath, + serverFilter = server, + excludeOrphaned = FALSE + ) + appDeployments <- appDeployments[appDeployments$appId == appId, ] + if (nrow(appDeployments) > 1) { + cli::cli_abort( + c( + "Supplied {.arg appId} ({appId}) identifies multiple deployments.", + i = "Manage obsolete deployments with rsconnect::forgetDeployment()." + ), + call = error_call ) - } else if (nrow(appDeployments) == 1) { - # If both appName and appId supplied, check that they're consistent. - if (!is.null(appId) && appDeployments$appId != appId) { - cli::cli_abort( - c( - "Supplied {.arg appId} ({appId}) does not match deployment record ({appDeployments$appId}).", - i = "Omit {.arg appId} to use existing for deployment for app {.str {appName}}, or", - i = "Omit {.arg appName} to create new deployment record." - ), - call = error_call - ) - } + } - updateDeploymentTarget(appDeployments, appTitle, envVars) - } else { - deployment <- disambiguateDeployments(appDeployments, error_call = error_call) - updateDeploymentTarget(deployment, appTitle, envVars) + # Existing local deployment record. + if (nrow(appDeployments) == 1) { + deployment <- appDeployments[1, ] + deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + return(list( + accountDetails = accountDetails, + deployment = deployment + )) } -} -deploymentTargetForApp <- function(appId, - appTitle = NULL, - account = NULL, - server = NULL) { - accountDetails <- findAccount(account, server) + # No local deployment record. Get it from the server. application <- getApplication(accountDetails$name, accountDetails$server, appId) - createDeploymentTarget( + # Note: The account+server of this deployment record may + # not correspond to the original content creator. + deployment <- createDeploymentTarget( appName = application$name, appTitle = application$title %||% appTitle, appId = application$id, - envVars = NULL, + envVars = envVars, username = application$owner_username %||% accountDetails$name, account = accountDetails$name, server = accountDetails$server ) + + return(list( + accountDetails = accountDetails, + deployment = deployment + )) +} + +# Discover the deployment target given appName. +# +# When appName is provided it identifies content previously created by a locally configured account. +# +# The account details from the deployment record identify the final credentials we will use, as +# account+server may not have been specified by the caller. +deploymentTargetFromAppName <- function( + recordPath = ".", + appName = NULL, + appTitle = NULL, + envVars = NULL, + account = NULL, + server = NULL, + forceUpdate = FALSE, + error_call = caller_env() +) { + + appDeployments <- deployments( + appPath = recordPath, + nameFilter = appName, + accountFilter = account, + serverFilter = server + ) + + # When the appName along with the (optional) account+server identifies exactly one previous + # deployment, use it. + if (nrow(appDeployments) == 1) { + deployment <- appDeployments[1, ] + deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + accountDetails <- accountInfo(deployment$account, deployment$server) + return(list( + accountDetails = accountDetails, + deployment = deployment + )) + } + + # When the appName identifies multiple targets, we may not have had an account+server constraint. + # Ask the user to choose. + if (nrow(appDeployments) > 1) { + deployment <- disambiguateDeployments(appDeployments, error_call = error_call) + deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + accountDetails <- accountInfo(deployment$account, deployment$server) + return(list( + accountDetails = accountDetails, + deployment = deployment + )) + } + + # When the appName does not identify a target, see if it exists on the server. That content is + # conditionally used. A resolved account is required. + accountDetails <- accountInfo(account, server) + if (!isPositCloudServer(accountDetails$server)) { + client <- clientForAccount(accountDetails) + application <- getAppByName(client, accountDetails, appName) + if (!is.null(application)) { + uniqueName <- findUnique(appName, application$name) + if (shouldUpdateApp(application, uniqueName, forceUpdate)) { + deployment <- createDeploymentTarget( + appName = application$name, + appTitle = application$title %||% appTitle, + appId = application$id, + envVars = envVars, + username = application$owner_username %||% accountDetails$name, + account = accountDetails$name, + server = accountDetails$server + ) + return(list( + accountDetails = accountDetails, + deployment = deployment + )) + } else { + appName <- uniqueName + } + } + } + + # No existing target, or the caller does not want to re-use that content. + deployment <- createDeploymentTarget( + appName = appName, + appTitle = appTitle, + appId = NULL, + envVars = envVars, + username = accountDetails$name, + account = accountDetails$name, + server = accountDetails$server + ) + return(list( + accountDetails = accountDetails, + deployment = deployment + )) } createDeploymentTarget <- function(appName, diff --git a/R/deployments-find.R b/R/deployments-find.R index e928ab60..5b575581 100644 --- a/R/deployments-find.R +++ b/R/deployments-find.R @@ -32,6 +32,10 @@ findDeployment <- function(appPath = getwd(), } disambiguateDeployments <- function(appDeployments, error_call = caller_env()) { + if (nrow(appDeployments) == 1) { + return(appDeployments[1, ]) + } + apps <- paste0( appDeployments$name, " ", "(", accountLabel(appDeployments$account, appDeployments$server), "): ", diff --git a/tests/testthat/_snaps/deploymentTarget.md b/tests/testthat/_snaps/deploymentTarget.md index 077d068c..d5ea244a 100644 --- a/tests/testthat/_snaps/deploymentTarget.md +++ b/tests/testthat/_snaps/deploymentTarget.md @@ -3,7 +3,7 @@ Code deploymentTarget() Condition - Error in `deploymentTarget()`: + Error in `accountInfo()`: ! No accounts registered. i Call `rsconnect::setAccountInfo()` to register an account. @@ -12,13 +12,13 @@ Code deploymentTarget(server = "unknown") Condition - Error in `deploymentTarget()`: + Error in `accountInfo()`: ! Can't find any accounts with `server` = "unknown". i Known servers are "bar". Code deploymentTarget(account = "john") Condition - Error in `deploymentTarget()`: + Error in `accountInfo()`: ! Can't find any accounts with `account` = "john". i Available account names: "foo". @@ -27,7 +27,7 @@ Code deploymentTarget(app_dir) Condition - Error in `deploymentTarget()`: + Error in `accountInfo()`: ! Found multiple accounts. Please disambiguate by setting `server` and/or `account`. i Available servers: "foo1" and "foo2". @@ -35,7 +35,7 @@ Code deploymentTarget(app_dir, appName = "test") Condition - Error in `deploymentTarget()`: + Error in `accountInfo()`: ! Found multiple accounts. Please disambiguate by setting `server` and/or `account`. i Available servers: "foo1" and "foo2". @@ -46,7 +46,7 @@ Code deploymentTarget(app_dir, server = "foo") Condition - Error in `deploymentTarget()`: + Error in `accountInfo()`: ! Found multiple accounts for `server` = "foo". Please disambiguate by setting `account`. i Known account names are "john" and "ron". @@ -75,7 +75,7 @@ --- Code - out <- deploymentTarget(app_dir) + target <- deploymentTarget(app_dir) Message This directory has been previously deployed in multiple places. Which deployment do you want to use? @@ -83,15 +83,16 @@ 2: test (server: server2.com / username: ron): Selection: 1 -# errors if single deployment and appId doesn't match +# succeeds if there are no deployments and a single account Code - deploymentTarget(app_dir, appName = "test", appId = "2") + deploymentTarget(app_dir) Condition - Error: - ! Supplied `appId` (2) does not match deployment record (1). - i Omit `appId` to use existing for deployment for app "test", or - i Omit `appName` to create new deployment record. + Error in `shouldUpdateApp()`: + ! Discovered a previously deployed app named "remotename" + (View it at ) + i Set `forceUpdate = TRUE` to update it. + i Supply a unique `appName` to deploy a new application. # shouldUpdateApp errors when non-interactive diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index f6e17198..e6f81395 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -587,7 +587,9 @@ test_that("Create application with linked source project", { expect_equal(app$url, "http://fake-url.test.me/") }) -test_that("deploymentTargetForApp() results in correct Cloud API calls", { +test_that("deploymentTarget() results in correct Cloud API calls when given appId", { + local_temp_config() + mockServer <- mockServerFactory(list( "^GET /v1/applications/([0-9]+)" = list( content = function(methodAndPath, match, ...) { @@ -621,16 +623,19 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", { testAccount <- configureTestAccount() withr::defer(removeAccount(testAccount)) - target <- deploymentTargetForApp( + target <- deploymentTarget( appId = 3, account = testAccount, server = "posit.cloud", ) - expect_equal(target$appName, "my output") - expect_equal(target$account, testAccount) - expect_equal(target$server, "posit.cloud") - expect_equal(target$appId, 3) + accountDetails <- target$accountDetails + deployment <- target$deployment + + expect_equal(deployment$appName, "my output") + expect_equal(deployment$account, testAccount) + expect_equal(deployment$server, "posit.cloud") + expect_equal(deployment$appId, 3) }) deployAppMockServerFactory <- function(expectedAppType, outputState) { @@ -796,6 +801,8 @@ deployAppMockServerFactory <- function(expectedAppType, outputState) { test_that("deployApp() for shiny results in correct Cloud API calls", { skip_on_cran() + local_temp_config() + withr::local_options(renv.verbose = TRUE) mock <- deployAppMockServerFactory(expectedAppType = "connect", outputState = "active") @@ -891,6 +898,8 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { }) test_that("deployDoc() results in correct Cloud API calls", { + local_temp_config() + mock <- deployAppMockServerFactory(expectedAppType = "static", outputState = "active") mockServer <- mock$server diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 89093c05..3980e537 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -36,7 +36,7 @@ test_that("handles accounts if only server specified", { addTestServer("foo") addTestAccount("ron", "foo") addTestAccount("john", "foo") - local_mocked_bindings(applications = function(...) data.frame()) + local_mocked_bindings(getAppByName = function(...) NULL) app_dir <- withr::local_tempdir() file.create(file.path(app_dir, "app.R")) @@ -48,7 +48,13 @@ test_that("handles accounts if only server specified", { server = "foo", account = "ron" ) - expect_equal(target$username, "ron") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "foo") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "foo") }) test_that("errors/prompts if multiple deployments", { @@ -68,13 +74,17 @@ test_that("errors/prompts if multiple deployments", { }) simulate_user_input(1) - expect_snapshot(out <- deploymentTarget(app_dir)) - expect_equal(out$appName, "test") + expect_snapshot(target <- deploymentTarget(app_dir)) + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "server1.com") + expect_equal(deployment$appName, "test") }) test_that("succeeds if there's a single existing deployment", { local_temp_config() - addTestServer() + addTestServer("example.com") addTestAccount("ron") app_dir <- withr::local_tempdir() @@ -83,46 +93,70 @@ test_that("succeeds if there's a single existing deployment", { appName = "test", appId = "1", username = "ron", + account = "ron", + server = "example.com", version = "999" ) + expect_equal(nrow(deployments(app_dir, accountFilter = "ron", serverFilter = "example.com")), 1) + expect_equal(nrow(deployments(app_dir)), 1) target <- deploymentTarget(app_dir) - expect_equal(target$appId, "1") - expect_equal(target$username, "ron") - expect_equal(target$version, "999") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appId, "1") + expect_equal(deployment$appName, "test") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "example.com") + expect_equal(deployment$version, "999") target <- deploymentTarget(app_dir, appName = "test") - expect_equal(target$appId, "1") - expect_equal(target$username, "ron") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appId, "1") + expect_equal(deployment$appName, "test") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "example.com") + expect_equal(deployment$version, "999") }) -test_that("errors if single deployment and appId doesn't match", { +test_that("appId is used even when name does not match", { local_temp_config() addTestServer() addTestAccount("ron") app_dir <- withr::local_tempdir() addTestDeployment(app_dir, appName = "test", appId = "1", username = "ron") - - expect_snapshot( - error = TRUE, - deploymentTarget(app_dir, appName = "test", appId = "2") - ) + addTestDeployment(app_dir, appName = "second", appId = "2", username = "ron") + + target <- deploymentTarget(app_dir, appName = "mismatched", appId = "1") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appId, "1") }) test_that("new title overrides existing title", { local_temp_config() addTestServer() addTestAccount("ron") - local_mocked_bindings(applications = function(...) data.frame()) + app_dir <- withr::local_tempdir() addTestDeployment(app_dir, appTitle = "old title") target <- deploymentTarget(app_dir) - expect_equal(target$appTitle, "old title") + deployment <- target$deployment + expect_equal(deployment$appTitle, "old title") target <- deploymentTarget(app_dir, appTitle = "new title") - expect_equal(target$appTitle, "new title") + deployment <- target$deployment + expect_equal(deployment$appTitle, "new title") }) test_that("new env vars overrides existing", { @@ -133,18 +167,22 @@ test_that("new env vars overrides existing", { addTestDeployment(app, envVars = "TEST1") target <- deploymentTarget(app) - expect_equal(target$envVars, "TEST1") + deployment <- target$deployment + expect_equal(deployment$envVars, "TEST1") target <- deploymentTarget(app, envVars = "TEST2") - expect_equal(target$envVars, "TEST2") + deployment <- target$deployment + expect_equal(deployment$envVars, "TEST2") # And check that it works with vectors addTestDeployment(app, envVars = c("TEST1", "TEST2")) target <- deploymentTarget(app) - expect_equal(target$envVars, c("TEST1", "TEST2")) + deployment <- target$deployment + expect_equal(deployment$envVars, c("TEST1", "TEST2")) target <- deploymentTarget(app, envVars = "TEST2") - expect_equal(target$envVars, "TEST2") + deployment <- target$deployment + expect_equal(deployment$envVars, "TEST2") }) test_that("empty character vector removes env vars", { @@ -155,43 +193,82 @@ test_that("empty character vector removes env vars", { addTestDeployment(app, envVars = "TEST1") target <- deploymentTarget(app, envVars = character()) - expect_equal(target$envVars, character()) + deployment <- target$deployment + expect_equal(deployment$envVars, character()) }) test_that("succeeds if there are no deployments and a single account", { local_temp_config() addTestServer() addTestAccount("ron") - local_mocked_bindings(applications = function(...) data.frame()) + local_mocked_bindings(getAppByName = function(...) data.frame(name="remotename", url="app-url")) app_dir <- dirCreate(file.path(withr::local_tempdir(), "my_app")) - target <- deploymentTarget(app_dir, envVars = c("TEST1", "TEST2")) - expect_equal(target$appName, "my_app") - expect_equal(target$username, "ron") - expect_equal(target$envVars, c("TEST1", "TEST2")) + expect_snapshot(error = TRUE, { + deploymentTarget(app_dir) + }) - target <- deploymentTarget(app_dir, appName = "foo") - expect_equal(target$username, "ron") + simulate_user_input(1) + target <- deploymentTarget(app_dir) + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appName, "remotename") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "example.com") + + target <- deploymentTarget(app_dir, forceUpdate = TRUE) + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appName, "remotename") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "example.com") + + target <- deploymentTarget(app_dir, envVars = c("TEST1", "TEST2"), forceUpdate = TRUE) + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appName, "remotename") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "example.com") + expect_equal(deployment$envVars, c("TEST1", "TEST2")) + + target <- deploymentTarget(app_dir, appName = "foo", forceUpdate = TRUE) + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "ron") + expect_equal(accountDetails$server, "example.com") + expect_equal(deployment$appName, "remotename") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "example.com") }) test_that("default title is the empty string", { local_temp_config() addTestServer() addTestAccount("ron") - local_mocked_bindings(applications = function(...) data.frame()) + local_mocked_bindings(getAppByName = function(...) data.frame(name="remotename", url="app-url")) app_dir <- withr::local_tempdir() - target <- deploymentTarget(app_dir) - expect_equal(target$appTitle, "") + target <- deploymentTarget(app_dir, forceUpdate = TRUE) + deployment <- target$deployment + expect_equal(deployment$appTitle, "") }) confirm_existing_app_used <- function(server) { local_temp_config() addTestServer() addTestAccount("ron", server = server) - local_mocked_bindings( - applications = function(...) data.frame( + local_mocked_bindings(getAppByName = function(...) data.frame( name = "my_app", id = 123, url = "http://example.com/test", @@ -202,7 +279,8 @@ confirm_existing_app_used <- function(server) { app_dir <- withr::local_tempdir() target <- deploymentTarget(app_dir, appName = "my_app", server = server) - expect_equal(target$appId, 123) + deployment <- target$deployment + expect_equal(deployment$appId, 123) } test_that("can find existing application on server & use it", { @@ -217,8 +295,7 @@ confirm_existing_app_not_used <- function(server) { local_temp_config() addTestServer() addTestAccount("ron", server = server) - local_mocked_bindings( - applications = function(...) data.frame( + local_mocked_bindings(getAppByName = function(...) data.frame( name = "my_app", id = 123, url = "http://example.com/test", @@ -229,8 +306,9 @@ confirm_existing_app_not_used <- function(server) { app_dir <- withr::local_tempdir() target <- deploymentTarget(app_dir, appName = "my_app", server = server) - expect_equal(target$appName, "my_app-1") - expect_equal(target$appId, NULL) + deployment <- target$deployment + expect_equal(deployment$appName, "my_app-1") + expect_equal(deployment$appId, NULL) } test_that("can find existing application on server & not use it", { @@ -258,18 +336,6 @@ test_that("defaultAppName reifies appNames for shinyApps", { expect_equal(defaultAppName(paste(long_name, "..."), "shinyapps.io"), long_name) }) -test_that("deploymentTargetForApp works with cloud", { - local_temp_config() - addTestServer() - addTestAccount("ron") - local_mocked_bindings( - getApplication = function(...) list(name = "name", id = "id") - ) - - target <- deploymentTargetForApp("123") - expect_equal(target$username, "ron") -}) - # helpers ----------------------------------------------------------------- test_that("shouldUpdateApp errors when non-interactive", { From f528b8411c6a9067b0c95b66da01d12300aed935 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Mon, 23 Oct 2023 15:20:41 -0400 Subject: [PATCH 03/17] appId collaborator testcases --- tests/testthat/test-deploymentTarget.R | 102 +++++++++++++++++++++++++ 1 file changed, 102 insertions(+) diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 3980e537..1b65a8fb 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -31,6 +31,108 @@ test_that("errors if no previous deployments and multiple accounts", { }) }) +test_that("uses appId given a local deployment record; created by a local account", { + # Demonstrates that the deployment record is sufficient without a call to + # the remote server. + local_temp_config() + addTestServer("local") + addTestAccount("leslie", "local") + + app_dir <- withr::local_tempdir() + addTestDeployment(app_dir, appName = "local-record", appId = "the-appid", account = "leslie", server = "local") + + target <- deploymentTarget(app_dir, appId = "the-appid") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "leslie") + expect_equal(accountDetails$server, "local") + expect_equal(deployment$appId, "the-appid") + expect_equal(deployment$appName, "local-record") + expect_equal(deployment$username, "leslie") + expect_equal(deployment$account, "leslie") + expect_equal(deployment$server, "local") +}) + +test_that("uses appId given a local deployment record; created by a collaborator", { + # Demonstrates that the target account does not need to be the account that + # created the deployment record. The deployment record is sufficient without + # a call to the remote server. + local_temp_config() + addTestServer("local") + addTestAccount("leslie", "local") + + app_dir <- withr::local_tempdir() + addTestDeployment(app_dir, appName = "local-record", appId = "the-appid", account = "ron", server = "local") + + target <- deploymentTarget(app_dir, appId = "the-appid") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "leslie") + expect_equal(accountDetails$server, "local") + expect_equal(deployment$appId, "the-appid") + expect_equal(deployment$appName, "local-record") + expect_equal(deployment$username, "ron") + expect_equal(deployment$account, "ron") + expect_equal(deployment$server, "local") +}) + +test_that("uses appId without local deployment record; created by local account", { + local_temp_config() + addTestServer("local") + addTestAccount("leslie", "local") + + local_mocked_bindings( + getApplication = function(...) data.frame( + id = "the-appid", + name = "remote-record", + owner_username = "leslie" + ) + ) + + app_dir <- withr::local_tempdir() + + target <- deploymentTarget(app_dir, appId = "the-appid") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "leslie") + expect_equal(accountDetails$server, "local") + expect_equal(deployment$appId, "the-appid") + expect_equal(deployment$appName, "remote-record") + expect_equal(deployment$username, "leslie") + expect_equal(deployment$account, "leslie") + expect_equal(deployment$server, "local") +}) + +test_that("uses appId without local deployment record; created by collaborator", { + local_temp_config() + addTestServer("local") + addTestAccount("leslie", "local") + + app_dir <- withr::local_tempdir() + + local_mocked_bindings( + getApplication = function(...) data.frame( + id = "the-appid", + name = "remote-record", + owner_username = "ron" + ) + ) + + target <- deploymentTarget(app_dir, appId = "the-appid") + accountDetails <- target$accountDetails + deployment <- target$deployment + expect_equal(accountDetails$name, "leslie") + expect_equal(accountDetails$server, "local") + expect_equal(deployment$appId, "the-appid") + expect_equal(deployment$appName, "remote-record") + expect_equal(deployment$username, "ron") + # note: account+server does not correspond to the "ron" account, but this is + # the best we can do, as we do not have the original deployment record. + expect_equal(deployment$account, "leslie") + expect_equal(deployment$server, "local") +}) + + test_that("handles accounts if only server specified", { local_temp_config() addTestServer("foo") From dc9714c56e6135132c5e3028487e28a7b451351a Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Mon, 23 Oct 2023 15:57:02 -0400 Subject: [PATCH 04/17] linty --- R/deployApp.R | 4 ++-- tests/testthat/test-deploymentTarget.R | 8 ++++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index 60b4af09..e5713baa 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -277,9 +277,9 @@ deployApp <- function(appDir = getwd(), "appName:", appName, "appTitle:", appTitle, "account:", account, - "server:",server, + "server:", server, "\n")) - + # set up logging helpers logLevel <- match.arg(logLevel) quiet <- identical(logLevel, "quiet") diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 1b65a8fb..351bc2bc 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -303,7 +303,9 @@ test_that("succeeds if there are no deployments and a single account", { local_temp_config() addTestServer() addTestAccount("ron") - local_mocked_bindings(getAppByName = function(...) data.frame(name="remotename", url="app-url")) + local_mocked_bindings( + getAppByName = function(...) data.frame(name = "remotename", url = "app-url") + ) app_dir <- dirCreate(file.path(withr::local_tempdir(), "my_app")) @@ -358,7 +360,9 @@ test_that("default title is the empty string", { local_temp_config() addTestServer() addTestAccount("ron") - local_mocked_bindings(getAppByName = function(...) data.frame(name="remotename", url="app-url")) + local_mocked_bindings( + getAppByName = function(...) data.frame(name = "remotename", url = "app-url") + ) app_dir <- withr::local_tempdir() target <- deploymentTarget(app_dir, forceUpdate = TRUE) From 6b03e9f581d3ec24ed4da1081fd266d65ff452fe Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 08:55:50 -0400 Subject: [PATCH 05/17] remove debug logging --- R/deployApp.R | 9 --------- 1 file changed, 9 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index e5713baa..69d01b9c 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -271,15 +271,6 @@ deployApp <- function(appDir = getwd(), recordDir <- appSourceDoc } - cat(paste("deployApp entry:", - "appDir:", appDir, - "appId:", appId, - "appName:", appName, - "appTitle:", appTitle, - "account:", account, - "server:", server, - "\n")) - # set up logging helpers logLevel <- match.arg(logLevel) quiet <- identical(logLevel, "quiet") From db8b5529f5643e465d0a9261de1882e44d2eb174 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 09:09:57 -0400 Subject: [PATCH 06/17] getAppByName produces an error, handled when discovering a deployment target --- R/applications.R | 15 +++++++++------ R/configureApp.R | 12 ------------ R/deploymentTarget.R | 5 ++++- 3 files changed, 13 insertions(+), 19 deletions(-) diff --git a/R/applications.R b/R/applications.R index 9429cfaa..30396063 100644 --- a/R/applications.R +++ b/R/applications.R @@ -121,14 +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]]) } - return(NULL) + 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. @@ -238,10 +245,6 @@ showLogs <- function(appPath = getwd(), appFile = NULL, appName = NULL, accountDetails <- accountInfo(deployment$account, deployment$server) client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, deployment$name) - if (is.null(application)) { - stop("No application found. Specify the application's directory, name, ", - "and/or associated account.", call. = FALSE) - } if (streaming) { # streaming; poll for the entries directly diff --git a/R/configureApp.R b/R/configureApp.R index 9d13a2de..a634a188 100644 --- a/R/configureApp.R +++ b/R/configureApp.R @@ -111,10 +111,6 @@ setProperty <- function(propertyName, propertyValue, appPath = getwd(), client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, deployment$name) - if (is.null(application)) { - stop("No application found. Specify the application's directory, name, ", - "and/or associated account.", call. = FALSE) - } invisible(client$setApplicationProperty(application$id, propertyName, @@ -154,10 +150,6 @@ unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL, client <- clientForAccount(accountDetails) application <- getAppByName(client, accountInfo, deployment$name) - if (is.null(application)) { - stop("No application found. Specify the application's directory, name, ", - "and/or associated account.", call. = FALSE) - } invisible(client$unsetApplicationProperty(application$id, propertyName, @@ -190,10 +182,6 @@ showProperties <- function(appPath = getwd(), appName = NULL, account = NULL, se client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, deployment$name) - if (is.null(application)) { - stop("No application found. Specify the application's directory, name, ", - "and/or associated account.", call. = FALSE) - } # convert to data frame res <- do.call(rbind, application$deployment$properties) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 70d52b19..7a37a297 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -199,7 +199,10 @@ deploymentTargetFromAppName <- function( accountDetails <- accountInfo(account, server) if (!isPositCloudServer(accountDetails$server)) { client <- clientForAccount(accountDetails) - application <- getAppByName(client, accountDetails, appName) + application <- tryCatch( + getAppByName(client, accountDetails, appName), + rsconnect_app_not_found = function(err) NULL + ) if (!is.null(application)) { uniqueName <- findUnique(appName, application$name) if (shouldUpdateApp(application, uniqueName, forceUpdate)) { From 14e5f85c923236292ed31312cfe144d128e808c9 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 09:33:50 -0400 Subject: [PATCH 07/17] deployment target function renaming deploymentTarget ==> findDeploymentTarget deploymentTargetFromAppId ==> findDeploymentTargetByAppId deploymentTargetFromAppName ==> findDeploymentTargetByAppName updateDeploymentTarget ==> updateDeployment createDeploymentTarget ==> createDeployment --- R/deployApp.R | 2 +- R/deploymentTarget.R | 67 ++++++++++++++--------- tests/testthat/_snaps/deploymentTarget.md | 20 +++---- tests/testthat/helper.R | 2 +- tests/testthat/test-client-cloud.R | 4 +- tests/testthat/test-deployApp.R | 2 +- tests/testthat/test-deploymentTarget.R | 64 +++++++++++----------- tests/testthat/test-deployments.R | 4 +- 8 files changed, 91 insertions(+), 74 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index 69d01b9c..d1a25f17 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -329,7 +329,7 @@ deployApp <- function(appDir = getwd(), # determine the target deployment record and deploying account recordPath <- findRecordPath(appDir, recordDir, appPrimaryDoc) - target <- deploymentTarget( + target <- findDeploymentTarget( recordPath = recordPath, appId = appId, appName = appName, diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 7a37a297..f0f3d82f 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -1,6 +1,23 @@ -# calculate the deployment target based on the passed parameters and -# any saved deployments that we have -deploymentTarget <- function( +# Discover the deployment target given the passed information. +# +# Returns a list containing a deployment record and the account details to use +# when performing the deployment. +# +# When appId is provided, it must identify an existing application. The +# application may have been created by some other user. That application may +# or may not have an existing deployment record on disk. It is an error when +# appId does not identify an application. +# +# When appName is provided, it may identify an existing application owned by +# the calling user (e.g. associated with a locally known account). +# +# Without appId or appName to identify an existing deployment, local +# deployment records are considered before falling back to a generated name. +# +# When the targeted name does not exist, a deployment record with NULL appId +# is returned, which signals to the caller that an application should be +# created. +findDeploymentTarget <- function( recordPath = ".", appId = NULL, appName = NULL, @@ -13,7 +30,7 @@ deploymentTarget <- function( ) { if (!is.null(appId)) { - return(deploymentTargetFromAppId( + return(findDeploymentTargetByAppId( recordPath = recordPath, appId = appId, appName = appName, @@ -26,7 +43,7 @@ deploymentTarget <- function( } if (!is.null(appName)) { - return(deploymentTargetFromAppName( + return(findDeploymentTargetByAppName( recordPath = recordPath, appName = appName, appTitle = appTitle, @@ -50,7 +67,7 @@ deploymentTarget <- function( ) if (nrow(allDeployments) > 0) { deployment <- disambiguateDeployments(allDeployments, error_call = error_call) - deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + deployment <- updateDeployment(deployment, appTitle, envVars) accountDetails <- accountInfo(deployment$account, deployment$server) return(list( accountDetails = accountDetails, @@ -62,7 +79,7 @@ deploymentTarget <- function( # by the user), generate a name, and locate the deployment. accountDetails <- accountInfo(account, server) appName <- generateAppName(appTitle, recordPath, accountDetails$name, unique = FALSE) - return(deploymentTargetFromAppName( + return(findDeploymentTargetByAppName( recordPath = recordPath, appName = appName, appTitle = appTitle, @@ -82,7 +99,7 @@ deploymentTarget <- function( # # The target content may have been created by some other user; the account for this session may # differ from the account used when creating the content. -deploymentTargetFromAppId <- function( +findDeploymentTargetByAppId <- function( recordPath = ".", appId = NULL, appName = NULL, @@ -118,7 +135,7 @@ deploymentTargetFromAppId <- function( # Existing local deployment record. if (nrow(appDeployments) == 1) { deployment <- appDeployments[1, ] - deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + deployment <- updateDeployment(deployment, appTitle, envVars) return(list( accountDetails = accountDetails, deployment = deployment @@ -130,7 +147,7 @@ deploymentTargetFromAppId <- function( # Note: The account+server of this deployment record may # not correspond to the original content creator. - deployment <- createDeploymentTarget( + deployment <- createDeployment( appName = application$name, appTitle = application$title %||% appTitle, appId = application$id, @@ -152,7 +169,7 @@ deploymentTargetFromAppId <- function( # # The account details from the deployment record identify the final credentials we will use, as # account+server may not have been specified by the caller. -deploymentTargetFromAppName <- function( +findDeploymentTargetByAppName <- function( recordPath = ".", appName = NULL, appTitle = NULL, @@ -174,7 +191,7 @@ deploymentTargetFromAppName <- function( # deployment, use it. if (nrow(appDeployments) == 1) { deployment <- appDeployments[1, ] - deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + deployment <- updateDeployment(deployment, appTitle, envVars) accountDetails <- accountInfo(deployment$account, deployment$server) return(list( accountDetails = accountDetails, @@ -186,7 +203,7 @@ deploymentTargetFromAppName <- function( # Ask the user to choose. if (nrow(appDeployments) > 1) { deployment <- disambiguateDeployments(appDeployments, error_call = error_call) - deployment <- updateDeploymentTarget(deployment, appTitle, envVars) + deployment <- updateDeployment(deployment, appTitle, envVars) accountDetails <- accountInfo(deployment$account, deployment$server) return(list( accountDetails = accountDetails, @@ -206,7 +223,7 @@ deploymentTargetFromAppName <- function( if (!is.null(application)) { uniqueName <- findUnique(appName, application$name) if (shouldUpdateApp(application, uniqueName, forceUpdate)) { - deployment <- createDeploymentTarget( + deployment <- createDeployment( appName = application$name, appTitle = application$title %||% appTitle, appId = application$id, @@ -226,7 +243,7 @@ deploymentTargetFromAppName <- function( } # No existing target, or the caller does not want to re-use that content. - deployment <- createDeploymentTarget( + deployment <- createDeployment( appName = appName, appTitle = appTitle, appId = NULL, @@ -241,14 +258,14 @@ deploymentTargetFromAppName <- function( )) } -createDeploymentTarget <- function(appName, - appTitle, - appId, - envVars, - username, - account, - server, - version = deploymentRecordVersion) { +createDeployment <- function(appName, + appTitle, + appId, + envVars, + username, + account, + server, + version = deploymentRecordVersion) { list( appName = appName, appTitle = appTitle %||% "", @@ -261,8 +278,8 @@ createDeploymentTarget <- function(appName, ) } -updateDeploymentTarget <- function(previous, appTitle = NULL, envVars = NULL) { - createDeploymentTarget( +updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) { + createDeployment( appName = previous$name, appTitle = appTitle %||% previous$title, appId = previous$appId, diff --git a/tests/testthat/_snaps/deploymentTarget.md b/tests/testthat/_snaps/deploymentTarget.md index d5ea244a..75dd71c4 100644 --- a/tests/testthat/_snaps/deploymentTarget.md +++ b/tests/testthat/_snaps/deploymentTarget.md @@ -1,7 +1,7 @@ # errors if no accounts Code - deploymentTarget() + findDeploymentTarget() Condition Error in `accountInfo()`: ! No accounts registered. @@ -10,13 +10,13 @@ # errors if unknown account or server Code - deploymentTarget(server = "unknown") + findDeploymentTarget(server = "unknown") Condition Error in `accountInfo()`: ! Can't find any accounts with `server` = "unknown". i Known servers are "bar". Code - deploymentTarget(account = "john") + findDeploymentTarget(account = "john") Condition Error in `accountInfo()`: ! Can't find any accounts with `account` = "john". @@ -25,7 +25,7 @@ # errors if no previous deployments and multiple accounts Code - deploymentTarget(app_dir) + findDeploymentTarget(app_dir) Condition Error in `accountInfo()`: ! Found multiple accounts. @@ -33,7 +33,7 @@ i Available servers: "foo1" and "foo2". i Available account names: "ron". Code - deploymentTarget(app_dir, appName = "test") + findDeploymentTarget(app_dir, appName = "test") Condition Error in `accountInfo()`: ! Found multiple accounts. @@ -44,7 +44,7 @@ # handles accounts if only server specified Code - deploymentTarget(app_dir, server = "foo") + findDeploymentTarget(app_dir, server = "foo") Condition Error in `accountInfo()`: ! Found multiple accounts for `server` = "foo". @@ -54,7 +54,7 @@ # errors/prompts if multiple deployments Code - deploymentTarget(app_dir, appName = "test") + findDeploymentTarget(app_dir, appName = "test") Condition Error: ! This directory has been previously deployed in multiple places. @@ -63,7 +63,7 @@ * test (server: server1.com / username: ron): * test (server: server2.com / username: ron): Code - deploymentTarget(app_dir) + findDeploymentTarget(app_dir) Condition Error: ! This directory has been previously deployed in multiple places. @@ -75,7 +75,7 @@ --- Code - target <- deploymentTarget(app_dir) + target <- findDeploymentTarget(app_dir) Message This directory has been previously deployed in multiple places. Which deployment do you want to use? @@ -86,7 +86,7 @@ # succeeds if there are no deployments and a single account Code - deploymentTarget(app_dir) + findDeploymentTarget(app_dir) Condition Error in `shouldUpdateApp()`: ! Discovered a previously deployed app named "remotename" diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 579386bd..b7b3daae 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -117,7 +117,7 @@ addTestDeployment <- function(path, metadata = list()) { saveDeployment( path, - createDeploymentTarget( + createDeployment( appName = appName, appTitle = appTitle, appId = appId, diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index e6f81395..4afd2caa 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -587,7 +587,7 @@ test_that("Create application with linked source project", { expect_equal(app$url, "http://fake-url.test.me/") }) -test_that("deploymentTarget() results in correct Cloud API calls when given appId", { +test_that("findDeploymentTarget() results in correct Cloud API calls when given appId", { local_temp_config() mockServer <- mockServerFactory(list( @@ -623,7 +623,7 @@ test_that("deploymentTarget() results in correct Cloud API calls when given appI testAccount <- configureTestAccount() withr::defer(removeAccount(testAccount)) - target <- deploymentTarget( + target <- findDeploymentTarget( appId = 3, account = testAccount, server = "posit.cloud", diff --git a/tests/testthat/test-deployApp.R b/tests/testthat/test-deployApp.R index 187046af..d862a455 100644 --- a/tests/testthat/test-deployApp.R +++ b/tests/testthat/test-deployApp.R @@ -90,7 +90,7 @@ test_that("applicationDeleted() errors or prompts as needed", { addTestAccount("a", "s") app <- local_temp_app() addTestDeployment(app, appName = "name", account = "a", server = "s") - target <- createDeploymentTarget("name", "title", "id", NULL, "a", "a", "s", 1) + target <- createDeployment("name", "title", "id", NULL, "a", "a", "s", 1) client <- list(createApplication = function(...) NULL) expect_snapshot(applicationDeleted(client, target, app), error = TRUE) diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 351bc2bc..4a3840c3 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -1,7 +1,7 @@ test_that("errors if no accounts", { local_temp_config() - expect_snapshot(deploymentTarget(), error = TRUE) + expect_snapshot(findDeploymentTarget(), error = TRUE) }) test_that("errors if unknown account or server", { @@ -10,8 +10,8 @@ test_that("errors if unknown account or server", { addTestAccount("foo", "bar") expect_snapshot(error = TRUE, { - deploymentTarget(server = "unknown") - deploymentTarget(account = "john") + findDeploymentTarget(server = "unknown") + findDeploymentTarget(account = "john") }) }) @@ -26,8 +26,8 @@ test_that("errors if no previous deployments and multiple accounts", { file.create(file.path(app_dir, "app.R")) expect_snapshot(error = TRUE, { - deploymentTarget(app_dir) - deploymentTarget(app_dir, appName = "test") + findDeploymentTarget(app_dir) + findDeploymentTarget(app_dir, appName = "test") }) }) @@ -41,7 +41,7 @@ test_that("uses appId given a local deployment record; created by a local accoun app_dir <- withr::local_tempdir() addTestDeployment(app_dir, appName = "local-record", appId = "the-appid", account = "leslie", server = "local") - target <- deploymentTarget(app_dir, appId = "the-appid") + target <- findDeploymentTarget(app_dir, appId = "the-appid") accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "leslie") @@ -64,7 +64,7 @@ test_that("uses appId given a local deployment record; created by a collaborator app_dir <- withr::local_tempdir() addTestDeployment(app_dir, appName = "local-record", appId = "the-appid", account = "ron", server = "local") - target <- deploymentTarget(app_dir, appId = "the-appid") + target <- findDeploymentTarget(app_dir, appId = "the-appid") accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "leslie") @@ -91,7 +91,7 @@ test_that("uses appId without local deployment record; created by local account" app_dir <- withr::local_tempdir() - target <- deploymentTarget(app_dir, appId = "the-appid") + target <- findDeploymentTarget(app_dir, appId = "the-appid") accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "leslie") @@ -118,7 +118,7 @@ test_that("uses appId without local deployment record; created by collaborator", ) ) - target <- deploymentTarget(app_dir, appId = "the-appid") + target <- findDeploymentTarget(app_dir, appId = "the-appid") accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "leslie") @@ -143,9 +143,9 @@ test_that("handles accounts if only server specified", { app_dir <- withr::local_tempdir() file.create(file.path(app_dir, "app.R")) - expect_snapshot(deploymentTarget(app_dir, server = "foo"), error = TRUE) + expect_snapshot(findDeploymentTarget(app_dir, server = "foo"), error = TRUE) - target <- deploymentTarget( + target <- findDeploymentTarget( app_dir, server = "foo", account = "ron" @@ -171,12 +171,12 @@ test_that("errors/prompts if multiple deployments", { addTestDeployment(app_dir, server = "server2.com") expect_snapshot(error = TRUE, { - deploymentTarget(app_dir, appName = "test") - deploymentTarget(app_dir) + findDeploymentTarget(app_dir, appName = "test") + findDeploymentTarget(app_dir) }) simulate_user_input(1) - expect_snapshot(target <- deploymentTarget(app_dir)) + expect_snapshot(target <- findDeploymentTarget(app_dir)) accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -202,7 +202,7 @@ test_that("succeeds if there's a single existing deployment", { expect_equal(nrow(deployments(app_dir, accountFilter = "ron", serverFilter = "example.com")), 1) expect_equal(nrow(deployments(app_dir)), 1) - target <- deploymentTarget(app_dir) + target <- findDeploymentTarget(app_dir) accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -214,7 +214,7 @@ test_that("succeeds if there's a single existing deployment", { expect_equal(deployment$server, "example.com") expect_equal(deployment$version, "999") - target <- deploymentTarget(app_dir, appName = "test") + target <- findDeploymentTarget(app_dir, appName = "test") accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -236,7 +236,7 @@ test_that("appId is used even when name does not match", { addTestDeployment(app_dir, appName = "test", appId = "1", username = "ron") addTestDeployment(app_dir, appName = "second", appId = "2", username = "ron") - target <- deploymentTarget(app_dir, appName = "mismatched", appId = "1") + target <- findDeploymentTarget(app_dir, appName = "mismatched", appId = "1") accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -252,11 +252,11 @@ test_that("new title overrides existing title", { app_dir <- withr::local_tempdir() addTestDeployment(app_dir, appTitle = "old title") - target <- deploymentTarget(app_dir) + target <- findDeploymentTarget(app_dir) deployment <- target$deployment expect_equal(deployment$appTitle, "old title") - target <- deploymentTarget(app_dir, appTitle = "new title") + target <- findDeploymentTarget(app_dir, appTitle = "new title") deployment <- target$deployment expect_equal(deployment$appTitle, "new title") }) @@ -268,21 +268,21 @@ test_that("new env vars overrides existing", { addTestAccount() addTestDeployment(app, envVars = "TEST1") - target <- deploymentTarget(app) + target <- findDeploymentTarget(app) deployment <- target$deployment expect_equal(deployment$envVars, "TEST1") - target <- deploymentTarget(app, envVars = "TEST2") + target <- findDeploymentTarget(app, envVars = "TEST2") deployment <- target$deployment expect_equal(deployment$envVars, "TEST2") # And check that it works with vectors addTestDeployment(app, envVars = c("TEST1", "TEST2")) - target <- deploymentTarget(app) + target <- findDeploymentTarget(app) deployment <- target$deployment expect_equal(deployment$envVars, c("TEST1", "TEST2")) - target <- deploymentTarget(app, envVars = "TEST2") + target <- findDeploymentTarget(app, envVars = "TEST2") deployment <- target$deployment expect_equal(deployment$envVars, "TEST2") }) @@ -294,7 +294,7 @@ test_that("empty character vector removes env vars", { addTestAccount() addTestDeployment(app, envVars = "TEST1") - target <- deploymentTarget(app, envVars = character()) + target <- findDeploymentTarget(app, envVars = character()) deployment <- target$deployment expect_equal(deployment$envVars, character()) }) @@ -310,11 +310,11 @@ test_that("succeeds if there are no deployments and a single account", { app_dir <- dirCreate(file.path(withr::local_tempdir(), "my_app")) expect_snapshot(error = TRUE, { - deploymentTarget(app_dir) + findDeploymentTarget(app_dir) }) simulate_user_input(1) - target <- deploymentTarget(app_dir) + target <- findDeploymentTarget(app_dir) accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -324,7 +324,7 @@ test_that("succeeds if there are no deployments and a single account", { expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") - target <- deploymentTarget(app_dir, forceUpdate = TRUE) + target <- findDeploymentTarget(app_dir, forceUpdate = TRUE) accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -334,7 +334,7 @@ test_that("succeeds if there are no deployments and a single account", { expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") - target <- deploymentTarget(app_dir, envVars = c("TEST1", "TEST2"), forceUpdate = TRUE) + target <- findDeploymentTarget(app_dir, envVars = c("TEST1", "TEST2"), forceUpdate = TRUE) accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -345,7 +345,7 @@ test_that("succeeds if there are no deployments and a single account", { expect_equal(deployment$server, "example.com") expect_equal(deployment$envVars, c("TEST1", "TEST2")) - target <- deploymentTarget(app_dir, appName = "foo", forceUpdate = TRUE) + target <- findDeploymentTarget(app_dir, appName = "foo", forceUpdate = TRUE) accountDetails <- target$accountDetails deployment <- target$deployment expect_equal(accountDetails$name, "ron") @@ -365,7 +365,7 @@ test_that("default title is the empty string", { ) app_dir <- withr::local_tempdir() - target <- deploymentTarget(app_dir, forceUpdate = TRUE) + target <- findDeploymentTarget(app_dir, forceUpdate = TRUE) deployment <- target$deployment expect_equal(deployment$appTitle, "") }) @@ -384,7 +384,7 @@ confirm_existing_app_used <- function(server) { ) app_dir <- withr::local_tempdir() - target <- deploymentTarget(app_dir, appName = "my_app", server = server) + target <- findDeploymentTarget(app_dir, appName = "my_app", server = server) deployment <- target$deployment expect_equal(deployment$appId, 123) } @@ -411,7 +411,7 @@ confirm_existing_app_not_used <- function(server) { ) app_dir <- withr::local_tempdir() - target <- deploymentTarget(app_dir, appName = "my_app", server = server) + target <- findDeploymentTarget(app_dir, appName = "my_app", server = server) deployment <- target$deployment expect_equal(deployment$appName, "my_app-1") expect_equal(deployment$appId, NULL) diff --git a/tests/testthat/test-deployments.R b/tests/testthat/test-deployments.R index fd35d779..41c39360 100644 --- a/tests/testthat/test-deployments.R +++ b/tests/testthat/test-deployments.R @@ -141,7 +141,7 @@ test_that("saveDeployment appends to global history", { saveDeployment( dir, - createDeploymentTarget( + createDeployment( appName = "my-app", appTitle = "", appId = 10, @@ -168,7 +168,7 @@ test_that("saveDeployment captures hostUrl", { dir <- local_temp_app() saveDeployment( dir, - createDeploymentTarget( + createDeployment( appName = "my-app", appTitle = "", appId = 10, From f4b18acf341a24fba8e13d8a6b4378cc1097b5eb Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 09:48:32 -0400 Subject: [PATCH 08/17] additional findDeploymentTarget explanation --- R/deploymentTarget.R | 29 ++++++++++++++++++++--------- 1 file changed, 20 insertions(+), 9 deletions(-) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index f0f3d82f..6c5094c4 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -5,14 +5,25 @@ # # When appId is provided, it must identify an existing application. The # application may have been created by some other user. That application may -# or may not have an existing deployment record on disk. It is an error when -# appId does not identify an application. +# or may not have an existing deployment record on disk. +# +# When using appId, a search across all deployment records occurs, even when +# there is no local account+server referenced by the deployment record. This +# lets us identify on-disk deployment records created by some collaborator. +# +# It is an error when appId does not identify an existing application. # # When appName is provided, it may identify an existing application owned by # the calling user (e.g. associated with a locally known account). # -# Without appId or appName to identify an existing deployment, local -# deployment records are considered before falling back to a generated name. +# When using appName, the search across deployment records is restricted to +# the incoming account+server. When there is no incoming account+server, the +# search is restricted to deployments which have a corresponding local +# account. +# +# Without appId or appName to identify an existing deployment, deployment +# records associated with local accounts (possibly restricted by incoming +# account+server) are considered before falling back to a generated name. # # When the targeted name does not exist, a deployment record with NULL appId # is returned, which signals to the caller that an application should be @@ -93,12 +104,12 @@ findDeploymentTarget <- function( # Discover the deployment target given appId. # -# When appId is provided, all other information is secondary. An appId is an indication from the -# caller that the content has already been deployed elsewhere. If we cannot locate that content, -# deployment fails. +# When appId is provided, all other information is secondary. An appId is an +# indication from the caller that the content has already been deployed +# elsewhere. If we cannot locate that content, deployment fails. # -# The target content may have been created by some other user; the account for this session may -# differ from the account used when creating the content. +# The target content may have been created by some other user; the account for +# this session may differ from the account used when creating the content. findDeploymentTargetByAppId <- function( recordPath = ".", appId = NULL, From f3e6f2bf4171473608ea7948925aec5faf56ad38 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 11:22:16 -0400 Subject: [PATCH 09/17] create deployment-from-application helper This rewrite showed that from-disk deployment records had different field names than the records created on-the-fly. In particular, "appName" and "appTitle" were used by the "deployment target", while "name" and "title" were used for on-disk deployment records. This made it challenging to use the same helpers. All deployment objects, either read from disk or created in-memory now use "name" and "title". This is a step towards always using deployment records. --- R/deployApp.R | 16 ++-- R/deploymentTarget.R | 46 ++++++----- R/deployments.R | 6 +- tests/testthat/test-client-cloud.R | 2 +- tests/testthat/test-deploymentTarget.R | 106 +++++++++++++++++++++---- 5 files changed, 128 insertions(+), 48 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index d1a25f17..f8c1a5d4 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -344,10 +344,10 @@ deployApp <- function(appDir = getwd(), if (is.null(deployment$appId)) { dest <- accountLabel(accountDetails$name, accountDetails$server) - taskComplete(quiet, "Deploying {.val {deployment$appName}} using {.val {dest}}") + taskComplete(quiet, "Deploying {.val {deployment$name}} using {.val {dest}}") } else { dest <- accountLabel(accountDetails$name, accountDetails$server) - taskComplete(quiet, "Re-deploying {.val {deployment$appName}} using {.val {dest}}") + taskComplete(quiet, "Re-deploying {.val {deployment$name}} using {.val {dest}}") } # Run checks prior to first saveDeployment() to avoid errors that will always @@ -383,8 +383,8 @@ deployApp <- function(appDir = getwd(), if (is.null(deployment$appId)) { taskStart(quiet, "Creating application on server...") application <- client$createApplication( - deployment$appName, - deployment$appTitle, + deployment$name, + deployment$title, "shiny", accountDetails$accountId, appMetadata$appMode, @@ -441,7 +441,7 @@ deployApp <- function(appDir = getwd(), taskStart(quiet, "Bundling {length(appFiles)} file{?s}: {.file {appFiles}}") bundlePath <- bundleApp( - appName = deployment$appName, + appName = deployment$name, appDir = appDir, appFiles = appFiles, appMetadata = appMetadata, @@ -589,7 +589,7 @@ applicationDeleted <- function(client, deployment, recordPath, appMetadata) { path <- deploymentConfigFile( recordPath, - deployment$appName, + deployment$name, deployment$account, deployment$server ) @@ -597,8 +597,8 @@ applicationDeleted <- function(client, deployment, recordPath, appMetadata) { accountDetails <- accountInfo(deployment$account, deployment$server) client$createApplication( - deployment$appName, - deployment$appTitle, + deployment$name, + deployment$title, "shiny", accountDetails$accountId, appMetadata$appMode diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 6c5094c4..d588e8e5 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -158,16 +158,8 @@ findDeploymentTargetByAppId <- function( # Note: The account+server of this deployment record may # not correspond to the original content creator. - deployment <- createDeployment( - appName = application$name, - appTitle = application$title %||% appTitle, - appId = application$id, - envVars = envVars, - username = application$owner_username %||% accountDetails$name, - account = accountDetails$name, - server = accountDetails$server - ) - + deployment <- createDeploymentFromApplication(application, accountDetails) + deployment <- updateDeployment(deployment, appTitle, envVars) return(list( accountDetails = accountDetails, deployment = deployment @@ -234,15 +226,8 @@ findDeploymentTargetByAppName <- function( if (!is.null(application)) { uniqueName <- findUnique(appName, application$name) if (shouldUpdateApp(application, uniqueName, forceUpdate)) { - deployment <- createDeployment( - appName = application$name, - appTitle = application$title %||% appTitle, - appId = application$id, - envVars = envVars, - username = application$owner_username %||% accountDetails$name, - account = accountDetails$name, - server = accountDetails$server - ) + deployment <- createDeploymentFromApplication(application, accountDetails) + deployment <- updateDeployment(deployment, appTitle, envVars) return(list( accountDetails = accountDetails, deployment = deployment @@ -277,9 +262,16 @@ createDeployment <- function(appName, account, server, version = deploymentRecordVersion) { + # Consider merging this object with the object returned by + # deploymentRecord(). + # + # Field names are shared with deploymentRecord() objects to avoid lots of + # record rewriting. Objects returned by findDeploymentTargetByAppName may + # have fields from the on-disk records, which were created by + # deploymentRecord(). list( - appName = appName, - appTitle = appTitle %||% "", + name = appName, + title = appTitle %||% "", envVars = envVars, appId = appId, username = username, @@ -289,6 +281,18 @@ createDeployment <- function(appName, ) } +createDeploymentFromApplication <- function(application, accountDetails) { + createDeployment( + appName = application$name, + appTitle = application$title, + appId = application$id, + envVars = NULL, + username = application$owner_username %||% accountDetails$name, + account = accountDetails$name, + server = accountDetails$server + ) +} + updateDeployment <- function(previous, appTitle = NULL, envVars = NULL) { createDeployment( appName = previous$name, diff --git a/R/deployments.R b/R/deployments.R index f36d240c..3a1c54ce 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -93,8 +93,8 @@ saveDeployment <- function(recordDir, metadata = list(), addToHistory = TRUE) { deployment <- deploymentRecord( - name = target$appName, - title = target$appTitle, + name = target$name, + title = target$title, username = target$username, account = target$account, server = target$server, @@ -106,7 +106,7 @@ saveDeployment <- function(recordDir, url = application$url, metadata = metadata ) - path <- deploymentConfigFile(recordDir, target$appName, target$account, target$server) + path <- deploymentConfigFile(recordDir, target$name, target$account, target$server) writeDeploymentRecord(deployment, path) # also save to global history diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index 4afd2caa..13e615db 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -632,7 +632,7 @@ test_that("findDeploymentTarget() results in correct Cloud API calls when given accountDetails <- target$accountDetails deployment <- target$deployment - expect_equal(deployment$appName, "my output") + expect_equal(deployment$name, "my output") expect_equal(deployment$account, testAccount) expect_equal(deployment$server, "posit.cloud") expect_equal(deployment$appId, 3) diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 4a3840c3..0306443c 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -47,7 +47,7 @@ test_that("uses appId given a local deployment record; created by a local accoun expect_equal(accountDetails$name, "leslie") expect_equal(accountDetails$server, "local") expect_equal(deployment$appId, "the-appid") - expect_equal(deployment$appName, "local-record") + expect_equal(deployment$name, "local-record") expect_equal(deployment$username, "leslie") expect_equal(deployment$account, "leslie") expect_equal(deployment$server, "local") @@ -70,7 +70,7 @@ test_that("uses appId given a local deployment record; created by a collaborator expect_equal(accountDetails$name, "leslie") expect_equal(accountDetails$server, "local") expect_equal(deployment$appId, "the-appid") - expect_equal(deployment$appName, "local-record") + expect_equal(deployment$name, "local-record") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "local") @@ -97,7 +97,7 @@ test_that("uses appId without local deployment record; created by local account" expect_equal(accountDetails$name, "leslie") expect_equal(accountDetails$server, "local") expect_equal(deployment$appId, "the-appid") - expect_equal(deployment$appName, "remote-record") + expect_equal(deployment$name, "remote-record") expect_equal(deployment$username, "leslie") expect_equal(deployment$account, "leslie") expect_equal(deployment$server, "local") @@ -124,7 +124,7 @@ test_that("uses appId without local deployment record; created by collaborator", expect_equal(accountDetails$name, "leslie") expect_equal(accountDetails$server, "local") expect_equal(deployment$appId, "the-appid") - expect_equal(deployment$appName, "remote-record") + expect_equal(deployment$name, "remote-record") expect_equal(deployment$username, "ron") # note: account+server does not correspond to the "ron" account, but this is # the best we can do, as we do not have the original deployment record. @@ -181,7 +181,7 @@ test_that("errors/prompts if multiple deployments", { deployment <- target$deployment expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "server1.com") - expect_equal(deployment$appName, "test") + expect_equal(deployment$name, "test") }) test_that("succeeds if there's a single existing deployment", { @@ -208,7 +208,7 @@ test_that("succeeds if there's a single existing deployment", { expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "example.com") expect_equal(deployment$appId, "1") - expect_equal(deployment$appName, "test") + expect_equal(deployment$name, "test") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") @@ -220,7 +220,7 @@ test_that("succeeds if there's a single existing deployment", { expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "example.com") expect_equal(deployment$appId, "1") - expect_equal(deployment$appName, "test") + expect_equal(deployment$name, "test") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") @@ -254,11 +254,11 @@ test_that("new title overrides existing title", { target <- findDeploymentTarget(app_dir) deployment <- target$deployment - expect_equal(deployment$appTitle, "old title") + expect_equal(deployment$title, "old title") target <- findDeploymentTarget(app_dir, appTitle = "new title") deployment <- target$deployment - expect_equal(deployment$appTitle, "new title") + expect_equal(deployment$title, "new title") }) test_that("new env vars overrides existing", { @@ -319,7 +319,7 @@ test_that("succeeds if there are no deployments and a single account", { deployment <- target$deployment expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "example.com") - expect_equal(deployment$appName, "remotename") + expect_equal(deployment$name, "remotename") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") @@ -329,7 +329,7 @@ test_that("succeeds if there are no deployments and a single account", { deployment <- target$deployment expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "example.com") - expect_equal(deployment$appName, "remotename") + expect_equal(deployment$name, "remotename") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") @@ -339,7 +339,7 @@ test_that("succeeds if there are no deployments and a single account", { deployment <- target$deployment expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "example.com") - expect_equal(deployment$appName, "remotename") + expect_equal(deployment$name, "remotename") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") @@ -350,7 +350,7 @@ test_that("succeeds if there are no deployments and a single account", { deployment <- target$deployment expect_equal(accountDetails$name, "ron") expect_equal(accountDetails$server, "example.com") - expect_equal(deployment$appName, "remotename") + expect_equal(deployment$name, "remotename") expect_equal(deployment$username, "ron") expect_equal(deployment$account, "ron") expect_equal(deployment$server, "example.com") @@ -367,7 +367,7 @@ test_that("default title is the empty string", { app_dir <- withr::local_tempdir() target <- findDeploymentTarget(app_dir, forceUpdate = TRUE) deployment <- target$deployment - expect_equal(deployment$appTitle, "") + expect_equal(deployment$title, "") }) confirm_existing_app_used <- function(server) { @@ -413,7 +413,7 @@ confirm_existing_app_not_used <- function(server) { app_dir <- withr::local_tempdir() target <- findDeploymentTarget(app_dir, appName = "my_app", server = server) deployment <- target$deployment - expect_equal(deployment$appName, "my_app-1") + expect_equal(deployment$name, "my_app-1") expect_equal(deployment$appId, NULL) } @@ -472,3 +472,79 @@ test_that("findUnique always returns unique name", { expect_equal(findUnique("x", c("x", "x-1")), "x-2") expect_equal(findUnique("x", c("x", "x-1", "x-2")), "x-3") }) + +test_that("createDeploymentFromApplication promotes fields", { + expect_equal(createDeploymentFromApplication( + application = list( + id = "1", + name = "app-name", + title = "app-title", + owner_username = "alice.username" + ), + accountDetails = list( + name = "alice", + server = "example.com" + ) + ), list( + name = "app-name", + title = "app-title", + envVars = NULL, + appId = "1", + username = "alice.username", + account = "alice", + server = "example.com", + version = deploymentRecordVersion + )) +}) + +test_that("updateDeployment updates fields", { + expect_equal(updateDeployment( + list( + name = "app-name", + title = "app-title", + envVars = NULL, + appId = "1", + username = "alice.username", + account = "alice", + server = "example.com", + version = deploymentRecordVersion + ), + appTitle = "updated-title", + envVars = c("VAR-NAME") + ), list( + name = "app-name", + title = "updated-title", + envVars = c("VAR-NAME"), + appId = "1", + username = "alice.username", + account = "alice", + server = "example.com", + version = deploymentRecordVersion + )) +}) + +test_that("updateDeployment ignores NULL updates", { + expect_equal(updateDeployment( + list( + name = "app-name", + title = "app-title", + envVars = c("VAR-NAME"), + appId = "1", + username = "alice.username", + account = "alice", + server = "example.com", + version = deploymentRecordVersion + ), + appTitle = NULL, + envVars = NULL + ), list( + name = "app-name", + title = "app-title", + envVars = c("VAR-NAME"), + appId = "1", + username = "alice.username", + account = "alice", + server = "example.com", + version = deploymentRecordVersion + )) +}) From e97ab2bc3aa7684627fb301d2039951a1418cb10 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 11:55:02 -0400 Subject: [PATCH 10/17] create findAccountInfo which is an internal accountInfo and allows error context --- R/account-find.R | 3 +++ R/accounts.R | 8 +++++++- R/deploymentTarget.R | 12 ++++++------ tests/testthat/_snaps/deploymentTarget.md | 12 ++++++------ 4 files changed, 22 insertions(+), 13 deletions(-) diff --git a/R/account-find.R b/R/account-find.R index 1580bc6e..ffe72d15 100644 --- a/R/account-find.R +++ b/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) diff --git a/R/accounts.R b/R/accounts.R index 8e4745dd..e0c0d84a 100644 --- a/R/accounts.R +++ b/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) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index d588e8e5..a833cae1 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -79,7 +79,7 @@ findDeploymentTarget <- function( if (nrow(allDeployments) > 0) { deployment <- disambiguateDeployments(allDeployments, error_call = error_call) deployment <- updateDeployment(deployment, appTitle, envVars) - accountDetails <- accountInfo(deployment$account, deployment$server) + accountDetails <- findAccountInfo(deployment$account, deployment$server, error_call = error_call) return(list( accountDetails = accountDetails, deployment = deployment @@ -88,7 +88,7 @@ findDeploymentTarget <- function( # Otherwise, identify a target account (given just one available or prompted # by the user), generate a name, and locate the deployment. - accountDetails <- accountInfo(account, server) + accountDetails <- findAccountInfo(account, server, error_call = error_call) appName <- generateAppName(appTitle, recordPath, accountDetails$name, unique = FALSE) return(findDeploymentTargetByAppName( recordPath = recordPath, @@ -123,7 +123,7 @@ findDeploymentTargetByAppId <- function( # We must have a target account+server in order to use the appId. # The selected account may not be the original creator of the content. - accountDetails <- accountInfo(account, server) + accountDetails <- findAccountInfo(account, server, error_call = error_call) # Filtering is only by server and includes all deployments in case we have a deployment record # from a collaborator. @@ -195,7 +195,7 @@ findDeploymentTargetByAppName <- function( if (nrow(appDeployments) == 1) { deployment <- appDeployments[1, ] deployment <- updateDeployment(deployment, appTitle, envVars) - accountDetails <- accountInfo(deployment$account, deployment$server) + accountDetails <- findAccountInfo(deployment$account, deployment$server, error_call = error_call) return(list( accountDetails = accountDetails, deployment = deployment @@ -207,7 +207,7 @@ findDeploymentTargetByAppName <- function( if (nrow(appDeployments) > 1) { deployment <- disambiguateDeployments(appDeployments, error_call = error_call) deployment <- updateDeployment(deployment, appTitle, envVars) - accountDetails <- accountInfo(deployment$account, deployment$server) + accountDetails <- findAccountInfo(deployment$account, deployment$server, error_call = error_call) return(list( accountDetails = accountDetails, deployment = deployment @@ -216,7 +216,7 @@ findDeploymentTargetByAppName <- function( # When the appName does not identify a target, see if it exists on the server. That content is # conditionally used. A resolved account is required. - accountDetails <- accountInfo(account, server) + accountDetails <- findAccountInfo(account, server, error_call = error_call) if (!isPositCloudServer(accountDetails$server)) { client <- clientForAccount(accountDetails) application <- tryCatch( diff --git a/tests/testthat/_snaps/deploymentTarget.md b/tests/testthat/_snaps/deploymentTarget.md index 75dd71c4..0615e03c 100644 --- a/tests/testthat/_snaps/deploymentTarget.md +++ b/tests/testthat/_snaps/deploymentTarget.md @@ -3,7 +3,7 @@ Code findDeploymentTarget() Condition - Error in `accountInfo()`: + Error: ! No accounts registered. i Call `rsconnect::setAccountInfo()` to register an account. @@ -12,13 +12,13 @@ Code findDeploymentTarget(server = "unknown") Condition - Error in `accountInfo()`: + Error: ! Can't find any accounts with `server` = "unknown". i Known servers are "bar". Code findDeploymentTarget(account = "john") Condition - Error in `accountInfo()`: + Error: ! Can't find any accounts with `account` = "john". i Available account names: "foo". @@ -27,7 +27,7 @@ Code findDeploymentTarget(app_dir) Condition - Error in `accountInfo()`: + Error: ! Found multiple accounts. Please disambiguate by setting `server` and/or `account`. i Available servers: "foo1" and "foo2". @@ -35,7 +35,7 @@ Code findDeploymentTarget(app_dir, appName = "test") Condition - Error in `accountInfo()`: + Error: ! Found multiple accounts. Please disambiguate by setting `server` and/or `account`. i Available servers: "foo1" and "foo2". @@ -46,7 +46,7 @@ Code findDeploymentTarget(app_dir, server = "foo") Condition - Error in `accountInfo()`: + Error: ! Found multiple accounts for `server` = "foo". Please disambiguate by setting `account`. i Known account names are "john" and "ron". From 429217b9456009e4ef8fd3f5624237368a5716b6 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 12:08:09 -0400 Subject: [PATCH 11/17] rename saveDeployment argument from target --- R/deployApp.R | 4 ++-- R/deployments.R | 24 ++++++++++++++---------- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index f8c1a5d4..575cb8d7 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -414,7 +414,7 @@ deployApp <- function(appDir = getwd(), } saveDeployment( recordPath, - target = deployment, + previous = deployment, application = application, metadata = metadata ) @@ -467,7 +467,7 @@ deployApp <- function(appDir = getwd(), saveDeployment( recordPath, - target = deployment, + previous = deployment, application = application, bundleId = bundle$id, metadata = metadata diff --git a/R/deployments.R b/R/deployments.R index 3a1c54ce..e00917d6 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -85,28 +85,32 @@ deploymentFields <- c( deploymentRecordVersion <- 1L +# Save a deployment record to disk using an incoming record (which may or may +# not correspond to an existing on-disk deployment record). Created by +# deploymentRecord() or by findDeploymentTarget(), and possibly loaded from +# disk. saveDeployment <- function(recordDir, - target, + previous, application, bundleId = NULL, - hostUrl = serverInfo(target$server)$url, + hostUrl = serverInfo(previous$server)$url, metadata = list(), addToHistory = TRUE) { deployment <- deploymentRecord( - name = target$name, - title = target$title, - username = target$username, - account = target$account, - server = target$server, - envVars = target$envVars, - version = target$version, + name = previous$name, + title = previous$title, + username = previous$username, + account = previous$account, + server = previous$server, + envVars = previous$envVars, + version = previous$version, hostUrl = hostUrl, appId = application$id, bundleId = bundleId, url = application$url, metadata = metadata ) - path <- deploymentConfigFile(recordDir, target$name, target$account, target$server) + path <- deploymentConfigFile(recordDir, previous$name, previous$account, previous$server) writeDeploymentRecord(deployment, path) # also save to global history From c34d2b914f0b28e0bce237ff5281f87886123ade Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 12:15:08 -0400 Subject: [PATCH 12/17] provide error context to shouldUpdateApp --- R/deploymentTarget.R | 9 ++++++--- tests/testthat/_snaps/deploymentTarget.md | 4 ++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index a833cae1..e39e9e40 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -225,7 +225,7 @@ findDeploymentTargetByAppName <- function( ) if (!is.null(application)) { uniqueName <- findUnique(appName, application$name) - if (shouldUpdateApp(application, uniqueName, forceUpdate)) { + if (shouldUpdateApp(application, uniqueName, forceUpdate, error_call = error_call)) { deployment <- createDeploymentFromApplication(application, accountDetails) deployment <- updateDeployment(deployment, appTitle, envVars) return(list( @@ -333,7 +333,10 @@ defaultAppName <- function(recordPath, server = NULL) { name } -shouldUpdateApp <- function(application, uniqueName, forceUpdate = FALSE) { +shouldUpdateApp <- function(application, + uniqueName, + forceUpdate = FALSE, + error_call = caller_env()) { if (forceUpdate) { return(TRUE) } @@ -356,7 +359,7 @@ shouldUpdateApp <- function(application, uniqueName, forceUpdate = FALSE) { i = "Supply a unique `appName` to deploy a new application." ) - cli_menu(message, prompt, choices, not_interactive, quit = 3) == 1 + cli_menu(message, prompt, choices, not_interactive, quit = 3, error_call = error_call) == 1 } diff --git a/tests/testthat/_snaps/deploymentTarget.md b/tests/testthat/_snaps/deploymentTarget.md index 0615e03c..4356ea9f 100644 --- a/tests/testthat/_snaps/deploymentTarget.md +++ b/tests/testthat/_snaps/deploymentTarget.md @@ -88,7 +88,7 @@ Code findDeploymentTarget(app_dir) Condition - Error in `shouldUpdateApp()`: + Error: ! Discovered a previously deployed app named "remotename" (View it at ) i Set `forceUpdate = TRUE` to update it. @@ -99,7 +99,7 @@ Code shouldUpdateApp(app, "my_app-1") Condition - Error in `shouldUpdateApp()`: + Error: ! Discovered a previously deployed app named "my_app" (View it at ) i Set `forceUpdate = TRUE` to update it. From e19cdb2a1df93f94c82409b6f9fe4feddcabcb53 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 12:20:50 -0400 Subject: [PATCH 13/17] lintr: allow longer names --- .lintr | 1 + 1 file changed, 1 insertion(+) diff --git a/.lintr b/.lintr index 8e410463..5505b430 100644 --- a/.lintr +++ b/.lintr @@ -1,6 +1,7 @@ linters: linters_with_defaults( line_length_linter(160), indentation_linter = NULL, + object_length_linter(60), object_name_linter = NULL, object_usage_linter = NULL, brace_linter = NULL, From 78243f475d16ba8cdb0ceedba504c62a99b3f413 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Tue, 24 Oct 2023 12:24:01 -0400 Subject: [PATCH 14/17] burned by data.frame factors again --- tests/testthat/test-deploymentTarget.R | 18 ++++++++++++++---- 1 file changed, 14 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-deploymentTarget.R b/tests/testthat/test-deploymentTarget.R index 0306443c..5757d813 100644 --- a/tests/testthat/test-deploymentTarget.R +++ b/tests/testthat/test-deploymentTarget.R @@ -85,7 +85,8 @@ test_that("uses appId without local deployment record; created by local account" getApplication = function(...) data.frame( id = "the-appid", name = "remote-record", - owner_username = "leslie" + owner_username = "leslie", + stringsAsFactors = FALSE ) ) @@ -114,7 +115,8 @@ test_that("uses appId without local deployment record; created by collaborator", getApplication = function(...) data.frame( id = "the-appid", name = "remote-record", - owner_username = "ron" + owner_username = "ron", + stringsAsFactors = FALSE ) ) @@ -304,7 +306,11 @@ test_that("succeeds if there are no deployments and a single account", { addTestServer() addTestAccount("ron") local_mocked_bindings( - getAppByName = function(...) data.frame(name = "remotename", url = "app-url") + getAppByName = function(...) data.frame( + name = "remotename", + url = "app-url", + stringsAsFactors = FALSE + ) ) app_dir <- dirCreate(file.path(withr::local_tempdir(), "my_app")) @@ -361,7 +367,11 @@ test_that("default title is the empty string", { addTestServer() addTestAccount("ron") local_mocked_bindings( - getAppByName = function(...) data.frame(name = "remotename", url = "app-url") + getAppByName = function(...) data.frame( + name = "remotename", + url = "app-url", + stringsAsFactors = FALSE + ) ) app_dir <- withr::local_tempdir() From 8f8f85ed3c9e80f2ff4b55cee523dcfef8583600 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 25 Oct 2023 08:48:04 -0400 Subject: [PATCH 15/17] propagate error call to getAppByName --- R/applications.R | 4 ++-- R/deploymentTarget.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/applications.R b/R/applications.R index 30396063..066ca87e 100644 --- a/R/applications.R +++ b/R/applications.R @@ -122,7 +122,7 @@ applications <- function(account = NULL, server = NULL) { } # Use the API to filter applications by name and error when it does not exist. -getAppByName <- function(client, accountInfo, name) { +getAppByName <- function(client, accountInfo, name, error_call = caller_env()) { # NOTE: returns a list with 0 or 1 elements app <- client$listApplications(accountInfo$accountId, filters = list(name = name)) if (length(app)) { @@ -133,7 +133,7 @@ getAppByName <- function(client, accountInfo, name) { "No application found", i = "Specify the application directory, name, and/or associated account." ), - call = NULL, + call = error_call, class = "rsconnect_app_not_found" ) } diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index e39e9e40..ba458552 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -220,7 +220,7 @@ findDeploymentTargetByAppName <- function( if (!isPositCloudServer(accountDetails$server)) { client <- clientForAccount(accountDetails) application <- tryCatch( - getAppByName(client, accountDetails, appName), + getAppByName(client, accountDetails, appName, error_call = error_call), rsconnect_app_not_found = function(err) NULL ) if (!is.null(application)) { From 339958134a7aa09d1cc95b57cd539e1f7e2a5442 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 25 Oct 2023 08:51:00 -0400 Subject: [PATCH 16/17] deployment is named deployment --- R/deployApp.R | 4 ++-- R/deployments.R | 20 ++++++++++---------- 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index 575cb8d7..3057a156 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -414,7 +414,7 @@ deployApp <- function(appDir = getwd(), } saveDeployment( recordPath, - previous = deployment, + deployment = deployment, application = application, metadata = metadata ) @@ -467,7 +467,7 @@ deployApp <- function(appDir = getwd(), saveDeployment( recordPath, - previous = deployment, + deployment = deployment, application = application, bundleId = bundle$id, metadata = metadata diff --git a/R/deployments.R b/R/deployments.R index e00917d6..076455bb 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -90,27 +90,27 @@ deploymentRecordVersion <- 1L # deploymentRecord() or by findDeploymentTarget(), and possibly loaded from # disk. saveDeployment <- function(recordDir, - previous, + deployment, application, bundleId = NULL, - hostUrl = serverInfo(previous$server)$url, + hostUrl = serverInfo(deployment$server)$url, metadata = list(), addToHistory = TRUE) { deployment <- deploymentRecord( - name = previous$name, - title = previous$title, - username = previous$username, - account = previous$account, - server = previous$server, - envVars = previous$envVars, - version = previous$version, + name = deployment$name, + title = deployment$title, + username = deployment$username, + account = deployment$account, + server = deployment$server, + envVars = deployment$envVars, + version = deployment$version, hostUrl = hostUrl, appId = application$id, bundleId = bundleId, url = application$url, metadata = metadata ) - path <- deploymentConfigFile(recordDir, previous$name, previous$account, previous$server) + path <- deploymentConfigFile(recordDir, deployment$name, deployment$account, deployment$server) writeDeploymentRecord(deployment, path) # also save to global history From 86d0d27642ed852ee0d4cfb30204420cc41971c3 Mon Sep 17 00:00:00 2001 From: Aron Atkins Date: Wed, 25 Oct 2023 09:03:47 -0400 Subject: [PATCH 17/17] comment refinement --- R/deploymentTarget.R | 34 +++++++++++++++++++++------------- 1 file changed, 21 insertions(+), 13 deletions(-) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index ba458552..7e6dd55b 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -10,6 +10,8 @@ # When using appId, a search across all deployment records occurs, even when # there is no local account+server referenced by the deployment record. This # lets us identify on-disk deployment records created by some collaborator. +# When there is no on-disk deployment record, the configured account+server is +# queried for the appId. # # It is an error when appId does not identify an existing application. # @@ -25,9 +27,9 @@ # records associated with local accounts (possibly restricted by incoming # account+server) are considered before falling back to a generated name. # -# When the targeted name does not exist, a deployment record with NULL appId -# is returned, which signals to the caller that an application should be -# created. +# When the targeted name does not exist locally or on the targeted +# account+server, a deployment record with NULL appId is returned, which +# signals to the caller that an application should be created. findDeploymentTarget <- function( recordPath = ".", appId = NULL, @@ -108,6 +110,9 @@ findDeploymentTarget <- function( # indication from the caller that the content has already been deployed # elsewhere. If we cannot locate that content, deployment fails. # +# Local deployment records are considered first before looking for the appId +# on the target server. +# # The target content may have been created by some other user; the account for # this session may differ from the account used when creating the content. findDeploymentTargetByAppId <- function( @@ -168,10 +173,12 @@ findDeploymentTargetByAppId <- function( # Discover the deployment target given appName. # -# When appName is provided it identifies content previously created by a locally configured account. +# When appName is provided it identifies content previously created by a +# locally configured account. # -# The account details from the deployment record identify the final credentials we will use, as -# account+server may not have been specified by the caller. +# The account details from the deployment record identify the final +# credentials we will use, as account+server may not have been specified by +# the caller. findDeploymentTargetByAppName <- function( recordPath = ".", appName = NULL, @@ -190,8 +197,8 @@ findDeploymentTargetByAppName <- function( serverFilter = server ) - # When the appName along with the (optional) account+server identifies exactly one previous - # deployment, use it. + # When the appName along with the (optional) account+server identifies + # exactly one previous deployment, use it. if (nrow(appDeployments) == 1) { deployment <- appDeployments[1, ] deployment <- updateDeployment(deployment, appTitle, envVars) @@ -202,8 +209,8 @@ findDeploymentTargetByAppName <- function( )) } - # When the appName identifies multiple targets, we may not have had an account+server constraint. - # Ask the user to choose. + # When the appName identifies multiple records, we may not have had an + # account+server constraint. Ask the user to choose. if (nrow(appDeployments) > 1) { deployment <- disambiguateDeployments(appDeployments, error_call = error_call) deployment <- updateDeployment(deployment, appTitle, envVars) @@ -214,8 +221,9 @@ findDeploymentTargetByAppName <- function( )) } - # When the appName does not identify a target, see if it exists on the server. That content is - # conditionally used. A resolved account is required. + # When the appName does not identify a record, see if it exists on the + # server. That content is conditionally used. A resolved account is + # required. accountDetails <- findAccountInfo(account, server, error_call = error_call) if (!isPositCloudServer(accountDetails$server)) { client <- clientForAccount(accountDetails) @@ -238,7 +246,7 @@ findDeploymentTargetByAppName <- function( } } - # No existing target, or the caller does not want to re-use that content. + # No existing deployment, or the caller does not want to re-use that content. deployment <- createDeployment( appName = appName, appTitle = appTitle,