From e8a9364b286aeab25b7739c6f067d7bb25de7900 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Tue, 21 Mar 2023 16:28:08 -0500 Subject: [PATCH 01/28] initial implementation for static outputs in cloud --- R/applications.R | 6 +++--- R/client-cloud.R | 27 ++++++++++++++++++++------- R/client-connect.R | 4 ++-- R/client-shinyapps.R | 4 ++-- R/deployApp.R | 14 +++++++++----- R/deploymentTarget.R | 5 +++-- R/ide.R | 4 ++-- 7 files changed, 41 insertions(+), 23 deletions(-) diff --git a/R/applications.R b/R/applications.R index b52eb8b6..36b55b02 100644 --- a/R/applications.R +++ b/R/applications.R @@ -132,12 +132,12 @@ resolveApplication <- function(accountDetails, appName) { stopWithApplicationNotFound(appName) } -getApplication <- function(account, server, appId) { +getApplication <- function(account, server, appId, contentId) { accountDetails <- accountInfo(account, server) client <- clientForAccount(accountDetails) withCallingHandlers( - client$getApplication(appId), + client$getApplication(appId, contentId), rsconnect_http_404 = function(err) { cli::cli_abort("Can't find app with id {.str {appId}}", parent = err) } @@ -279,7 +279,7 @@ syncAppMetadata <- function(appPath = ".") { client <- clientForAccount(account) application <- tryCatch( - client$getApplication(curDeploy$appId), + client$getApplication(curDeploy$appId, curDeploy$contentId), rsconnect_http_404 = function(c) { # if the app has been deleted, delete the deployment record file.remove(curDeploy$deploymentFile) diff --git a/R/client-cloud.R b/R/client-cloud.R index 2fb45783..669b7b44 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -64,14 +64,26 @@ cloudClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId) { - path <- paste("/applications/", applicationId, sep = "") - application <- GET(service, authInfo, path) + getApplication = function(applicationId, contentId) { + # Static outputs may have multiple applications. Since the applications can be deleted, it's more reliable to look up the output by the content id. + if (!is.null(contentId)) { + path <- paste("/content/", contentId, sep = "") + applications_output <- GET(service, authInfo, path) + + application_id = applications_output$source_id + + path <- paste("/applications/", application_id, sep = "") + application <- GET(service, authInfo, path) + } else if (!is.null(applicationId)) { + path <- paste("/applications/", applicationId, sep = "") + application <- GET(service, authInfo, path) - output_id <- application$content_id - path <- paste("/content/", output_id, sep = "") + output_id <- application$content_id + + path <- paste("/content/", output_id, sep = "") + applications_output <- GET(service, authInfo, path) + } - applications_output <- GET(service, authInfo, path) application$url <- applications_output$url application }, @@ -95,9 +107,10 @@ cloudClient <- function(service, authInfo) { GET(service, authInfo, path, query) }, - createApplication = function(name, title, template, accountId) { + createApplication = function(name, title, template, accountId, appMode) { json <- list() json$name <- name + json$application_type <- ifelse(appMode == "static", "static", "connect") currentApplicationId <- Sys.getenv("LUCID_APPLICATION_ID") if (currentApplicationId != "") { diff --git a/R/client-connect.R b/R/client-connect.R index ffd3d829..bff4ed49 100644 --- a/R/client-connect.R +++ b/R/client-connect.R @@ -46,7 +46,7 @@ connectClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - createApplication = function(name, title, template, accountId) { + createApplication = function(name, title, template, accountId, appMode) { # add name; inject title if specified details <- list(name = name) if (!is.null(title) && nzchar(title)) @@ -85,7 +85,7 @@ connectClient <- function(service, authInfo) { "/applications/", applicationId, "/config", sep = "")) }, - getApplication = function(applicationId) { + getApplication = function(applicationId, contentId) { GET(service, authInfo, paste0("/applications/", applicationId)) }, diff --git a/R/client-shinyapps.R b/R/client-shinyapps.R index f33c67fc..dd83cc35 100644 --- a/R/client-shinyapps.R +++ b/R/client-shinyapps.R @@ -64,7 +64,7 @@ shinyAppsClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId) { + getApplication = function(applicationId, contentId) { path <- paste("/applications/", applicationId, sep = "") GET(service, authInfo, path) }, @@ -88,7 +88,7 @@ shinyAppsClient <- function(service, authInfo) { GET(service, authInfo, path, query) }, - createApplication = function(name, title, template, accountId) { + createApplication = function(name, title, template, accountId, appMode) { json <- list() json$name <- name # the title field is only used on connect diff --git a/R/deployApp.R b/R/deployApp.R index eb54eb91..83e88c26 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -152,6 +152,7 @@ deployApp <- function(appDir = getwd(), appName = NULL, appTitle = NULL, appId = NULL, + contentId = NULL, contentCategory = NULL, account = NULL, server = NULL, @@ -271,6 +272,7 @@ deployApp <- function(appDir = getwd(), # IDE supplies both appId and appName so should never hit this branch target <- deploymentTargetForApp( appId = appId, + contentId = contentId, appTitle = appTitle, account = account, server = server @@ -330,15 +332,16 @@ deployApp <- function(appDir = getwd(), target$appName, target$appTitle, "shiny", - accountDetails$accountId + accountDetails$accountId, + appMetadata$appMode ) taskComplete(quiet, "Created application with id {.val {application$id}}") } else { application <- taskStart(quiet, "Looking up application with id {.val {target$appId}}...") application <- tryCatch( - client$getApplication(target$appId), + client$getApplication(target$appId, target$contentId), rsconnect_http_404 = function(err) { - applicationDeleted(client, target, recordPath) + applicationDeleted(client, target, recordPath, appMetadata) } ) if (application$id == target$appId) { @@ -490,7 +493,7 @@ runDeploymentHook <- function(appDir, option, verbose = FALSE) { hook(appDir) } -applicationDeleted <- function(client, target, recordPath) { +applicationDeleted <- function(client, target, 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.", @@ -518,7 +521,8 @@ applicationDeleted <- function(client, target, recordPath) { target$appName, target$appTitle, "shiny", - accountDetails$accountId + accountDetails$accountId, + appMetadata$appMode ) } diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index e37f7649..7926cdda 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -84,12 +84,13 @@ deploymentTarget <- function(recordPath = ".", } -deploymentTargetForApp <- function(appId, +deploymentTargetForApp <- function(appId = NULL, + contentId = NULL, appTitle = NULL, account = NULL, server = NULL) { accountDetails <- findAccount(account, server) - application <- getApplication(accountDetails$account, accountDetails$server, appId) + application <- getApplication(accountDetails$account, accountDetails$server, appId, contentId) createDeploymentTarget( application$name, diff --git a/R/ide.R b/R/ide.R index 65761d5a..a464dc5c 100644 --- a/R/ide.R +++ b/R/ide.R @@ -114,7 +114,7 @@ showRstudioSourceMarkers <- function(basePath, lint) { # https://github.com/rstudio/rstudio/blob/ee56d49b0fca5f3d7c3f5214a4010355d1bb0212/src/gwt/src/org/rstudio/studio/client/rsconnect/ui/RSConnectDeploy.java#L699 -getAppById <- function(id, account, server, hostUrl) { +getAppById <- function(id, account, server, hostUrl, contentId = NULL) { check_string(account) check_string(server) check_string(hostUrl) @@ -135,7 +135,7 @@ getAppById <- function(id, account, server, hostUrl) { } } - getApplication(account, server, id) + getApplication(account, server, id, contentId) } From 0b3096dd865644114be6bd2a0b71543ec70dfc13 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Wed, 22 Mar 2023 14:18:03 -0500 Subject: [PATCH 02/28] save content id for cloud applications in dcf file's applicationId --- R/applications.R | 6 +++--- R/client-cloud.R | 41 +++++++++++++++++++++++++++++------------ R/client-connect.R | 2 +- R/client-shinyapps.R | 2 +- R/deployApp.R | 6 ++---- R/deploymentTarget.R | 3 +-- R/deployments.R | 2 +- R/ide.R | 4 ++-- 8 files changed, 40 insertions(+), 26 deletions(-) diff --git a/R/applications.R b/R/applications.R index 36b55b02..b52eb8b6 100644 --- a/R/applications.R +++ b/R/applications.R @@ -132,12 +132,12 @@ resolveApplication <- function(accountDetails, appName) { stopWithApplicationNotFound(appName) } -getApplication <- function(account, server, appId, contentId) { +getApplication <- function(account, server, appId) { accountDetails <- accountInfo(account, server) client <- clientForAccount(accountDetails) withCallingHandlers( - client$getApplication(appId, contentId), + client$getApplication(appId), rsconnect_http_404 = function(err) { cli::cli_abort("Can't find app with id {.str {appId}}", parent = err) } @@ -279,7 +279,7 @@ syncAppMetadata <- function(appPath = ".") { client <- clientForAccount(account) application <- tryCatch( - client$getApplication(curDeploy$appId, curDeploy$contentId), + client$getApplication(curDeploy$appId), rsconnect_http_404 = function(c) { # if the app has been deleted, delete the deployment record file.remove(curDeploy$deploymentFile) diff --git a/R/client-cloud.R b/R/client-cloud.R index 669b7b44..476bf6fc 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -64,27 +64,33 @@ cloudClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId, contentId) { - # Static outputs may have multiple applications. Since the applications can be deleted, it's more reliable to look up the output by the content id. - if (!is.null(contentId)) { - path <- paste("/content/", contentId, sep = "") - applications_output <- GET(service, authInfo, path) + getApplication = function(applicationId) { + if (startsWith(applicationId, "lucid:content:")) { + # applicationId refers in this case to the id of the output, not the + # application. + contentId <- strsplit(applicationId, ":")[[1]][3] - application_id = applications_output$source_id + path <- paste("/outputs/", contentId, sep = "") + output <- GET(service, authInfo, path) - path <- paste("/applications/", application_id, sep = "") + path <- paste("/applications/", output$source_id, sep = "") application <- GET(service, authInfo, path) - } else if (!is.null(applicationId)) { + } else { + # backwards compatibility for data saved with the application's id path <- paste("/applications/", applicationId, sep = "") application <- GET(service, authInfo, path) output_id <- application$content_id - path <- paste("/content/", output_id, sep = "") - applications_output <- GET(service, authInfo, path) + path <- paste("/outputs/", output_id, sep = "") + output <- GET(service, authInfo, path) } - application$url <- applications_output$url + # Each redeployment of a static output creates a new application. Since + # those applications can be deleted, it's more reliable to reference + # outputs by their own id instead of the applications'. + application$content_id <- output$id + application$url <- output$url application }, @@ -131,6 +137,7 @@ cloudClient <- function(service, authInfo) { output <- POST_JSON(service, authInfo, "/outputs", json) path <- paste("/applications/", output$source_id, sep = "") application <- GET(service, authInfo, path) + application$content_id <- output$id # this swaps the "application url" for the "content url". So we end up redirecting to the right spot after deployment. application$url <- output$url application @@ -170,7 +177,17 @@ cloudClient <- function(service, authInfo) { ) }, - deployApplication = function(applicationId, bundleId = NULL) { + deployApplication = function(application, bundleId = NULL) { + if (application$type == "static") { + path <- paste("/outputs/", application$content_id, "/revisions", sep = "") + # we only need an empty JSON object, but jsonlite needs at least one + # key to not generate a JSON array + revision <- POST_JSON(service, authInfo, path, list(foobar = NULL)) + applicationId <- revision$application_id + } else { + applicationId <- application$id + } + path <- paste("/applications/", applicationId, "/deploy", sep = "") json <- list() if (length(bundleId) > 0 && nzchar(bundleId)) diff --git a/R/client-connect.R b/R/client-connect.R index bff4ed49..f93cc3f9 100644 --- a/R/client-connect.R +++ b/R/client-connect.R @@ -85,7 +85,7 @@ connectClient <- function(service, authInfo) { "/applications/", applicationId, "/config", sep = "")) }, - getApplication = function(applicationId, contentId) { + getApplication = function(applicationId) { GET(service, authInfo, paste0("/applications/", applicationId)) }, diff --git a/R/client-shinyapps.R b/R/client-shinyapps.R index dd83cc35..c5170c80 100644 --- a/R/client-shinyapps.R +++ b/R/client-shinyapps.R @@ -64,7 +64,7 @@ shinyAppsClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId, contentId) { + getApplication = function(applicationId) { path <- paste("/applications/", applicationId, sep = "") GET(service, authInfo, path) }, diff --git a/R/deployApp.R b/R/deployApp.R index 83e88c26..13bc4013 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -152,7 +152,6 @@ deployApp <- function(appDir = getwd(), appName = NULL, appTitle = NULL, appId = NULL, - contentId = NULL, contentCategory = NULL, account = NULL, server = NULL, @@ -272,7 +271,6 @@ deployApp <- function(appDir = getwd(), # IDE supplies both appId and appName so should never hit this branch target <- deploymentTargetForApp( appId = appId, - contentId = contentId, appTitle = appTitle, account = account, server = server @@ -339,7 +337,7 @@ deployApp <- function(appDir = getwd(), } else { application <- taskStart(quiet, "Looking up application with id {.val {target$appId}}...") application <- tryCatch( - client$getApplication(target$appId, target$contentId), + client$getApplication(target$appId), rsconnect_http_404 = function(err) { applicationDeleted(client, target, recordPath, appMetadata) } @@ -411,7 +409,7 @@ deployApp <- function(appDir = getwd(), if (!quiet) { cli::cli_rule("Deploying to server") } - task <- client$deployApplication(application$id, bundle$id) + task <- client$deployApplication(application, bundle$id) taskId <- if (is.null(task$task_id)) task$id else task$task_id # wait for the deployment to complete (will raise an error if it can't) response <- client$waitForTask(taskId, quiet) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 7926cdda..2c495769 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -85,12 +85,11 @@ deploymentTarget <- function(recordPath = ".", deploymentTargetForApp <- function(appId = NULL, - contentId = NULL, appTitle = NULL, account = NULL, server = NULL) { accountDetails <- findAccount(account, server) - application <- getApplication(accountDetails$account, accountDetails$server, appId, contentId) + application <- getApplication(accountDetails$account, accountDetails$server, appId) createDeploymentTarget( application$name, diff --git a/R/deployments.R b/R/deployments.R index ef4a72f4..46efb545 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -92,7 +92,7 @@ saveDeployment <- function(recordDir, account = target$account, server = target$server, hostUrl = hostUrl, - appId = application$id, + appId = paste("lucid", "content", application$content_id, sep = ":"), bundleId = bundleId, url = application$url, metadata = metadata diff --git a/R/ide.R b/R/ide.R index a464dc5c..65761d5a 100644 --- a/R/ide.R +++ b/R/ide.R @@ -114,7 +114,7 @@ showRstudioSourceMarkers <- function(basePath, lint) { # https://github.com/rstudio/rstudio/blob/ee56d49b0fca5f3d7c3f5214a4010355d1bb0212/src/gwt/src/org/rstudio/studio/client/rsconnect/ui/RSConnectDeploy.java#L699 -getAppById <- function(id, account, server, hostUrl, contentId = NULL) { +getAppById <- function(id, account, server, hostUrl) { check_string(account) check_string(server) check_string(hostUrl) @@ -135,7 +135,7 @@ getAppById <- function(id, account, server, hostUrl, contentId = NULL) { } } - getApplication(account, server, id, contentId) + getApplication(account, server, id) } From 5a931d4aeacb4eb8ccf8b05915f8bffe01e14356 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Wed, 22 Mar 2023 14:29:54 -0500 Subject: [PATCH 03/28] better json-ing --- R/client-cloud.R | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 476bf6fc..515a8b2d 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -180,9 +180,7 @@ cloudClient <- function(service, authInfo) { deployApplication = function(application, bundleId = NULL) { if (application$type == "static") { path <- paste("/outputs/", application$content_id, "/revisions", sep = "") - # we only need an empty JSON object, but jsonlite needs at least one - # key to not generate a JSON array - revision <- POST_JSON(service, authInfo, path, list(foobar = NULL)) + revision <- POST_JSON(service, authInfo, path, data.frame()) applicationId <- revision$application_id } else { applicationId <- application$id From 871519e971eec5bc35b09a0734919d3f43f701c1 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 27 Mar 2023 10:09:14 -0500 Subject: [PATCH 04/28] make deploys and redeploys work for static applications --- R/client-cloud.R | 12 +++++------- R/deployApp.R | 25 ++++++++++++++++--------- 2 files changed, 21 insertions(+), 16 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 515a8b2d..8a7dd69e 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -177,16 +177,14 @@ cloudClient <- function(service, authInfo) { ) }, - deployApplication = function(application, bundleId = NULL) { - if (application$type == "static") { + createRevision = function(application) { path <- paste("/outputs/", application$content_id, "/revisions", sep = "") revision <- POST_JSON(service, authInfo, path, data.frame()) - applicationId <- revision$application_id - } else { - applicationId <- application$id - } + revision$application_id + }, - path <- paste("/applications/", applicationId, "/deploy", sep = "") + deployApplication = function(application, bundleId = NULL) { + path <- paste("/applications/", application$id, "/deploy", sep = "") json <- list() if (length(bundleId) > 0 && nzchar(bundleId)) json$bundle <- as.numeric(bundleId) diff --git a/R/deployApp.R b/R/deployApp.R index 13bc4013..4da2e85d 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -324,6 +324,7 @@ deployApp <- function(appDir = getwd(), showCookies(serverInfo(accountDetails$server)$url) } + isNewApplication <- FALSE if (is.null(target$appId)) { taskStart(quiet, "Creating application on server...") application <- client$createApplication( @@ -333,20 +334,23 @@ deployApp <- function(appDir = getwd(), accountDetails$accountId, appMetadata$appMode ) - taskComplete(quiet, "Created application with id {.val {application$id}}") + taskComplete(quiet, "Created application with id x{.val {application$id}}") + isNewApplication <- TRUE } else { application <- taskStart(quiet, "Looking up application with id {.val {target$appId}}...") application <- tryCatch( - client$getApplication(target$appId), + { + application <- client$getApplication(target$appId) + taskComplete(quiet, "Found application") + application + }, rsconnect_http_404 = function(err) { - applicationDeleted(client, target, recordPath, appMetadata) + application <- applicationDeleted(client, target, recordPath, appMetadata) + taskComplete(quiet, "Created application with id {.val {application$id}}") + isNewApplication <- TRUE + application } ) - if (application$id == target$appId) { - taskComplete(quiet, "Found application") - } else { - taskComplete(quiet, "Created application with id {.val {application$id}}") - } } saveDeployment( @@ -388,6 +392,9 @@ deployApp <- function(appDir = getwd(), # create, and upload the bundle taskStart(quiet, "Uploading bundle...") if (isCloudServer(accountDetails$server)) { + if (application$type == "static" && !isNewApplication) { + application$id <- client$createRevision(application) + } bundle <- uploadCloudBundle(client, application$id, bundlePath) } else { bundle <- client$uploadApplication(application$id, bundlePath) @@ -409,7 +416,7 @@ deployApp <- function(appDir = getwd(), if (!quiet) { cli::cli_rule("Deploying to server") } - task <- client$deployApplication(application, bundle$id) + task <- client$deployApplication(application, bundle$id, isNewApplication) taskId <- if (is.null(task$task_id)) task$id else task$task_id # wait for the deployment to complete (will raise an error if it can't) response <- client$waitForTask(taskId, quiet) From 31ccaed54cd61180949ec744703e65c53d8c348a Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 27 Mar 2023 10:10:30 -0500 Subject: [PATCH 05/28] remove bad argument --- R/deployApp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/deployApp.R b/R/deployApp.R index 4da2e85d..edf9cd2b 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -416,7 +416,7 @@ deployApp <- function(appDir = getwd(), if (!quiet) { cli::cli_rule("Deploying to server") } - task <- client$deployApplication(application, bundle$id, isNewApplication) + task <- client$deployApplication(application, bundle$id) taskId <- if (is.null(task$task_id)) task$id else task$task_id # wait for the deployment to complete (will raise an error if it can't) response <- client$waitForTask(taskId, quiet) From 4b32d80d419e16405190cffebb4b49a69a038d80 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 27 Mar 2023 10:16:40 -0500 Subject: [PATCH 06/28] revert change to give deploymentTargetForApp appId a default argument --- R/deploymentTarget.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 2c495769..e37f7649 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -84,7 +84,7 @@ deploymentTarget <- function(recordPath = ".", } -deploymentTargetForApp <- function(appId = NULL, +deploymentTargetForApp <- function(appId, appTitle = NULL, account = NULL, server = NULL) { From 1675271c3c255d5991366ad0ffd49f6b73cce063 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 27 Mar 2023 15:45:31 -0500 Subject: [PATCH 07/28] remove extraneous character in logging --- R/deployApp.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/deployApp.R b/R/deployApp.R index 82b1dea3..7c91b443 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -334,7 +334,7 @@ deployApp <- function(appDir = getwd(), accountDetails$accountId, appMetadata$appMode ) - taskComplete(quiet, "Created application with id x{.val {application$id}}") + taskComplete(quiet, "Created application with id {.val {application$id}}") isNewApplication <- TRUE } else { application <- taskStart(quiet, "Looking up application with id {.val {target$appId}}...") From 42cd94ad387e9a82d518d6aaa3c29026ad3878d3 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Fri, 31 Mar 2023 09:35:26 -0500 Subject: [PATCH 08/28] save appId differently for cloud vs connect --- R/deployments.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/deployments.R b/R/deployments.R index 29c5d48d..15d30131 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -84,7 +84,11 @@ saveDeployment <- function(recordDir, bundleId = NULL, hostUrl = serverInfo(target$server)$url, metadata = list()) { - + if (target$server == "posit.cloud") { + appId <- paste("lucid", "content", application$content_id, sep = ":") + } else { + appId <- application$id + } deployment <- deploymentRecord( name = target$appName, title = target$appTitle, @@ -92,7 +96,7 @@ saveDeployment <- function(recordDir, account = target$account, server = target$server, hostUrl = hostUrl, - appId = paste("lucid", "content", application$content_id, sep = ":"), + appId = appId, bundleId = bundleId, url = application$url, metadata = metadata From c560e9ffe20b9b3b0a00f4044b0436152c2bdacb Mon Sep 17 00:00:00 2001 From: Mike Baynton Date: Thu, 20 Apr 2023 11:23:22 -0500 Subject: [PATCH 09/28] Add unit tests of cloud functionality (#3) * Basic way to test with mocked http * Tests for cloud deploys of connect and static apps * Provide a way for individual tests to add responses --- R/client-cloud.R | 3 +- R/deploymentTarget.R | 4 +- tests/testthat/test-client-cloud.R | 585 +++++++++++++++++++++++++++++ 3 files changed, 588 insertions(+), 4 deletions(-) create mode 100644 tests/testthat/test-client-cloud.R diff --git a/R/client-cloud.R b/R/client-cloud.R index 8a7dd69e..fb77697c 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -65,7 +65,7 @@ cloudClient <- function(service, authInfo) { }, getApplication = function(applicationId) { - if (startsWith(applicationId, "lucid:content:")) { + if (is.character(applicationId) && startsWith(applicationId, "lucid:content:")) { # applicationId refers in this case to the id of the output, not the # application. contentId <- strsplit(applicationId, ":")[[1]][3] @@ -120,7 +120,6 @@ cloudClient <- function(service, authInfo) { currentApplicationId <- Sys.getenv("LUCID_APPLICATION_ID") if (currentApplicationId != "") { - print("Found application...") path <- paste("/applications/", currentApplicationId, sep = "") current_application <- GET(service, authInfo, path) project_id <- current_application$content_id diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index a51a3694..083d1513 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -89,14 +89,14 @@ deploymentTargetForApp <- function(appId, account = NULL, server = NULL) { accountDetails <- findAccount(account, server) - application <- getApplication(accountDetails$account, accountDetails$server, appId) + application <- getApplication(accountDetails$name, accountDetails$server, appId) createDeploymentTarget( application$name, application$title %||% appTitle, application$id, application$owner_username, - accountDetails$username, + accountDetails$name, accountDetails$server ) } diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R new file mode 100644 index 00000000..2572ce0b --- /dev/null +++ b/tests/testthat/test-client-cloud.R @@ -0,0 +1,585 @@ +mockServerFactory <- function(initialResponses) { + # Stock responses for certain endpoints. Can still be overridden by tests. + if (is.null(initialResponses$"^GET /v1/users/current")) { + initialResponses$"GET /v1/users/current" = list( + content = list( + id=100 + ) + ) + } + + if (is.null(initialResponses$"^GET /v1/accounts/?")) { + initialResponses$"^GET /v1/accounts/?" = list( + content = list( + count=1, + total=1, + offset=0, + accounts=list( + list( + id=50, + name="testthat-account", + account="testthat-account" + ), + list( + id=51, + name="testthat-superfluous-account", + account="testthat-superfluous-account" + ) + ) + ) + ) + } + + mockServer <- list( + responses = initialResponses + ) + + mockServer$addResponse <- function(methodAndPath, response) { + mockServer$responses <- append(mockServer$responses, response) + } + + mockServer$impl <- function(protocol, + host, + port, + method, + path, + headers, + contentType = NULL, + contentFile = NULL, + certificate = NULL, + timeout = NULL) { + + methodAndPath = paste(method, path) + + request <- list( + protocol = protocol, + host = host, + port = port, + method = method, + path = path + ) + + response = list( + req = request, + status = 200, + location = "", + contentType = "application/json" + ) + + found <- FALSE + + for (pathRegex in names(mockServer$responses)) { + match <- regexec(pathRegex, methodAndPath)[[1]] + if (match[1] != -1) { + found <- TRUE + responseSupplement <- mockServer$responses[[pathRegex]] + + for (respProperty in names(responseSupplement)) { + if (is.function(responseSupplement[[respProperty]])) { + responseSupplement[[respProperty]] <- responseSupplement[[respProperty]]( + methodAndPath, + match, + headers=headers, + contentType=contentType, + contentFile=contentFile) + } + + response[[respProperty]] = responseSupplement[[respProperty]] + } + + if (is.list(response$content)) { + response$content <- jsonlite::toJSON(response$content, auto_unbox=TRUE) + } + + break + } + } + + if (!found) { + stop(paste("No mocked response defined for", methodAndPath)) + } + + response + } + + mockServer +} + +configureTestAccount <- function(server = 'posit.cloud', name = NULL) { + if (is.null(name)) { + name = 'testthat-account' + } + + existingAccount <- NULL + tryCatch( + existingAccount <- accountInfo(name, server), + error = function(e) { existingAccount = NULL } + ) + + if (is.null(existingAccount)) { + setAccountInfo( + name = name, + token = 'foo', + secret = 'bar', + server = server + ) + } + + name +} + +test_that("Get application", { + mockServer = mockServerFactory(list( + "^GET /outputs/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + output_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + "id"=output_id, + "source_id"=1, + "url"="http://fake-url.test.me/" + ) + } + ), + "^GET /applications/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + application_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + "id"=application_id, + "content_id"=5 + ) + } + ) + )) + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + fakeService <- list( + protocol="test", + host="unit-test", + port=42 + ) + client <- cloudClient(fakeService, NULL) + + app <- client$getApplication(10) + + expect_equal(app$id, 10) + expect_equal(app$content_id, 5) + expect_equal(app$url, "http://fake-url.test.me/") + + app <- client$getApplication("lucid:content:5") + + expect_equal(app$id, 1) + expect_equal(app$content_id, 5) + expect_equal(app$url, "http://fake-url.test.me/") +}) + +test_that("Create application", { + mockServer = mockServerFactory(list( + "^POST /outputs" = list( + content = list( + "id"=1, + "source_id"=2, + "url"="http://fake-url.test.me/" + ) + ), + "^GET /applications/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + application_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + "id"=application_id, + "content_id"=1 + ) + }) + )) + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + fakeService <- list( + protocol="test", + host="unit-test", + port=42 + ) + client <- cloudClient(fakeService, NULL) + + app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static") + + expect_equal(app$id, 2) + expect_equal(app$content_id, 1) + expect_equal(app$url, "http://fake-url.test.me/") +}) + +test_that("Create application with linked source project", { + mockServer = mockServerFactory(list( + "^POST /outputs" = list( + content = function(methodAndPAth, match, contentFile, ...) { + content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + + expect_equal(content$project, 41) + expect_equal(content$space, 99) + + list( + "id"=1, + "source_id"=2, + "url"="http://fake-url.test.me/" + ) + } + ), + "^GET /applications/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + application_id <- strtoi(substr(methodAndPath, match[2], end)) + list( + "id"=application_id, + "content_id"=application_id-1 + ) + } + ), + "^GET /content/41" = list( + content = list( + "id"=41, + "space_id"=99 + ) + ) + )) + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + Sys.setenv(LUCID_APPLICATION_ID="42") + withr::defer(Sys.unsetenv("LUCID_APPLICATION_ID")) + + fakeService <- list( + protocol="test", + host="unit-test", + port=42 + ) + client <- cloudClient(fakeService, NULL) + + app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static") + + expect_equal(app$id, 2) + expect_equal(app$content_id, 1) + expect_equal(app$url, "http://fake-url.test.me/") +}) + +test_that("deploymentTargetForApp() results in correct Cloud API calls", { + mockServer = mockServerFactory(list( + "^GET /v1/applications/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + application_id <- strtoi(substr(methodAndPath, match[2], end)) + list( + "id"=application_id, + "content_id"=application_id-1, + "name"=paste("testthat app", application_id) + ) + } + ), + "^GET /v1/outputs/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + output_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + "id"=output_id, + "source_id"=output_id + 1, + "url"="http://fake-url.test.me/" + ) + } + ) + )) + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + testAccount <- configureTestAccount() + withr::defer(removeAccount(testAccount)) + + target <- deploymentTargetForApp( + appId = 3, + account = testAccount, + server = 'posit.cloud', + ) + + expect_equal(target$appName, "testthat app 3") + expect_equal(target$account, testAccount) + expect_equal(target$server, 'posit.cloud') + expect_equal(target$appId, 3) +}) + +deployAppMockServerFactory <- function(expectedAppType) { + outputResponse <- list( + "id"=1, + "source_id"=2, + "url"="http://fake-url.test.me/" + ) + + actualCalls = list( + outputCreated = FALSE, + revisionCreated = FALSE, + bundleCreated = FALSE, + bundleUploaded = FALSE, + bundleReady = FALSE, + deployStarted = FALSE + ) + + server <- mockServerFactory(list( + # An attempt to search for preexisting applications with the same name. + # This call should change, see https://github.com/rstudio/rsconnect/issues/808 + "^GET /v1/applications/[?]filter=account_id:50&filter=type:connect"=list( + content=list( + count=0, + total=0, + applications=list() + ) + ), + "^POST /v1/outputs$"=list( + content=function(methodAndPath, match, contentFile, ...) { + e <- environment(); p <- parent.env(e); p$actualCalls$outputCreated <- TRUE + + content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + + expect_equal(content$application_type, expectedAppType) + expect_equal(content$name, "Desired name here") + + outputResponse + } + ), + "^GET /v1/applications/([0-9]+)$" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + application_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + id=application_id, + content_id=application_id-1, + name=paste("testthat app", application_id), + type=expectedAppType + ) + } + ), + "^POST /v1/bundles/123/status$" = list( + content = function(methodAndPath, match, contentFile, ...){ + e <- environment(); p <- parent.env(e); p$actualCalls$bundleReady = TRUE + + content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + expect_equal(content$status, "ready") + + list() + } + ), + "^POST /v1/bundles$" = list( + content = function(methodAndPath, match, contentFile, ...) { + e <- environment(); p <- parent.env(e); p$actualCalls$bundleCreated = TRUE + + content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + + list( + id=123, + presigned_url="https://write-only-memory.com/fake-presigned-url", + presigned_checksum=content$checksum + ) + } + ), + "^PUT /fake-presigned-url" = list( + content = function(...) { + e <- environment(); p <- parent.env(e); p$actualCalls$bundleUploaded = TRUE + } + ), + "^GET /v1/bundles/123$" = list( + content=list( + id=123, + status="ready" + ) + ), + "^POST /v1/applications/[23]/deploy$" = list( + content=function(...) { + e <- environment(); p <- parent.env(e); p$actualCalls$deployStarted = TRUE + list( + task_id="testthat-task-id" + ) + } + ), + "^GET /v1/tasks/testthat-task-id$" = list( + content = list( + status="success", + finished=TRUE + ) + ), + # Fetch existing output when re-deploying from .dcf data + "^GET /v1/outputs/1$" = list( + content=outputResponse + ), + "^POST /v1/outputs/1/revisions" = list( + content=function(...) { + e <- environment(); p <- parent.env(e); p$actualCalls$revisionCreated = TRUE + + list( + application_id=3 + ) + } + ) + )) + + expect_calls <- function(expectedCalls) { + expect_equal(expectedCalls, actualCalls) + } + + reset_calls <- function() { + e <- environment(); p <- parent.env(e); p$actualCalls = list( + outputCreated = FALSE, + revisionCreated = FALSE, + bundleCreated = FALSE, + bundleUploaded = FALSE, + bundleReady = FALSE, + deployStarted = FALSE + ) + } + + list( + server=server, + expect_calls=expect_calls, + reset_calls=reset_calls + ) +} + +test_that("deployApp() for shiny results in correct Cloud API calls", { + mock <- deployAppMockServerFactory(expectedAppType="connect") + mockServer <- mock$server + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + testAccount <- configureTestAccount() + withr::defer(removeAccount(testAccount)) + + sourcePath = test_path('shinyapp-simple') + # Remove local deployment info at end for reproducibility and tidiness. + withr::defer(forgetDeployment(appPath=sourcePath)) + + deployApp( + appName = "Desired name here", + appDir = sourcePath, + server = 'posit.cloud', + account = testAccount + ) + + mock$expect_calls(list( + outputCreated = TRUE, + revisionCreated = FALSE, + bundleCreated = TRUE, + bundleUploaded = TRUE, + bundleReady = TRUE, + deployStarted = TRUE + )) + + mock$reset_calls() + + # deploy again to test existing deployment path + deployApp( + appDir = sourcePath + ) + + mock$expect_calls(list( + outputCreated = FALSE, + revisionCreated = FALSE, + bundleCreated = TRUE, + bundleUploaded = TRUE, + bundleReady = TRUE, + deployStarted = TRUE + )) + + # Start over, add another posit.cloud account and test again with that environment + mock$reset_calls() + forgetDeployment(appPath=sourcePath) + + extraLocalAccount <- configureTestAccount(name="testthat-superfluous-account") + withr::defer(removeAccount(extraLocalAccount)) + + deployApp( + appName = "Desired name here", + appDir = sourcePath, + server = 'posit.cloud', + account = testAccount + ) + + mock$expect_calls(list( + outputCreated = TRUE, + revisionCreated = FALSE, + bundleCreated = TRUE, + bundleUploaded = TRUE, + bundleReady = TRUE, + deployStarted = TRUE + )) + + mock$reset_calls() + + # deploy again to test existing deployment path + deployApp( + appDir = sourcePath + ) + + mock$expect_calls(list( + outputCreated = FALSE, + revisionCreated = FALSE, + bundleCreated = TRUE, + bundleUploaded = TRUE, + bundleReady = TRUE, + deployStarted = TRUE + )) +}) + +test_that("deployDoc() results in correct Cloud API calls", { + mock <- deployAppMockServerFactory(expectedAppType="static") + mockServer <- mock$server + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + testAccount <- configureTestAccount() + withr::defer(removeAccount(testAccount)) + + sourcePath = test_path('static-with-quarto-yaml') + # Remove local deployment info at end for reproducibility and tidiness. + withr::defer(forgetDeployment(appPath=sourcePath)) + + deployDoc( + paste(sourcePath, "slideshow.html", sep="/"), + appName = "Desired name here", + server = 'posit.cloud', + account = testAccount + ) + + mock$expect_calls(list( + outputCreated = TRUE, + revisionCreated = FALSE, + bundleCreated = TRUE, + bundleUploaded = TRUE, + bundleReady = TRUE, + deployStarted = TRUE + )) + + mock$reset_calls() + + # deploy again to test existing deployment path + deployApp( + appDir = sourcePath + ) + + mock$expect_calls(list( + outputCreated = FALSE, + revisionCreated = TRUE, + bundleCreated = TRUE, + bundleUploaded = TRUE, + bundleReady = TRUE, + deployStarted = TRUE + )) +}) From e764dbc9ae8111ecd329abb21301ea8b66c24037 Mon Sep 17 00:00:00 2001 From: omar-rs Date: Wed, 26 Apr 2023 11:20:23 -0400 Subject: [PATCH 10/28] If output is in trashed or archived state, set it to active --- R/client-cloud.R | 7 ++ R/http.R | 37 +++++++++++ tests/testthat/test-client-cloud.R | 100 +++++++++++++++++++++++++---- 3 files changed, 132 insertions(+), 12 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index fb77697c..22bac50a 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -86,6 +86,13 @@ cloudClient <- function(service, authInfo) { output <- GET(service, authInfo, path) } + # if the output is trashed or archived, restore it to the active state + if (output$state == 'trashed' || output$state == 'archived') { + json <- list() + json$state <- 'active' + PATCH_JSON(service, authInfo, paste("/outputs/", output$id, sep = ""), json) + } + # Each redeployment of a static output creates a new application. Since # those applications can be deleted, it's more reliable to reference # outputs by their own id instead of the applications'. diff --git a/R/http.R b/R/http.R index b2d0506d..470eb4c1 100644 --- a/R/http.R +++ b/R/http.R @@ -288,6 +288,43 @@ PUT_JSON <- function(service, ) } +PATCH <- function(service, + authInfo, + path, + query = NULL, + contentType = NULL, + file = NULL, + content = NULL, + headers = list()) { + httpRequestWithBody( + service, + authInfo, + "PATCH", + path, + query, + contentType, + file, + content, + headers + ) +} + +PATCH_JSON <- function(service, + authInfo, + path, + json, + query = NULL, + headers = list()) { + PATCH( + service, + authInfo, + path, + query, + "application/json", + content = toJSON(json), + headers = headers + ) +} # User options ------------------------------------------------------------ diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index 2572ce0b..45df23c1 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -138,7 +138,8 @@ test_that("Get application", { list( "id"=output_id, "source_id"=1, - "url"="http://fake-url.test.me/" + "url"="http://fake-url.test.me/", + "state"="active" ) } ), @@ -178,13 +179,72 @@ test_that("Get application", { expect_equal(app$url, "http://fake-url.test.me/") }) +test_that("Get application output trashed", { + mockServer = mockServerFactory(list( + "^GET /outputs/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + output_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + "id"=output_id, + "source_id"=1, + "url"="http://fake-url.test.me/", + "state"="trashed" + ) + } + ), + "^GET /applications/([0-9]+)" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + application_id <- strtoi(substr(methodAndPath, match[2], end)) + + list( + "id"=application_id, + "content_id"=5 + ) + } + ), + "^PATCH /outputs/5" = list( + content = function(methodAndPath, match, ...) { + end <- attr(match, 'match.length')[2] + match[2] + output_id <- strtoi(substr(methodAndPath, match[2], end)) + list() + } + ) + )) + + restoreOpt <- options(rsconnect.http = mockServer$impl) + withr::defer(options(restoreOpt)) + + fakeService <- list( + protocol="test", + host="unit-test", + port=42 + ) + client <- cloudClient(fakeService, NULL) + + app <- client$getApplication(10) + + expect_equal(app$id, 10) + expect_equal(app$content_id, 5) + expect_equal(app$url, "http://fake-url.test.me/") + + app <- client$getApplication("lucid:content:5") + + expect_equal(app$id, 1) + expect_equal(app$content_id, 5) + expect_equal(app$url, "http://fake-url.test.me/") +}) + test_that("Create application", { mockServer = mockServerFactory(list( "^POST /outputs" = list( content = list( "id"=1, "source_id"=2, - "url"="http://fake-url.test.me/" + "url"="http://fake-url.test.me/", + "state"="active" ) ), "^GET /applications/([0-9]+)" = list( @@ -228,7 +288,8 @@ test_that("Create application with linked source project", { list( "id"=1, "source_id"=2, - "url"="http://fake-url.test.me/" + "url"="http://fake-url.test.me/", + "state"="active" ) } ), @@ -291,7 +352,8 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", { list( "id"=output_id, "source_id"=output_id + 1, - "url"="http://fake-url.test.me/" + "url"="http://fake-url.test.me/", + "state"="active" ) } ) @@ -315,15 +377,17 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", { expect_equal(target$appId, 3) }) -deployAppMockServerFactory <- function(expectedAppType) { +deployAppMockServerFactory <- function(expectedAppType, outputState) { outputResponse <- list( "id"=1, "source_id"=2, - "url"="http://fake-url.test.me/" + "url"="http://fake-url.test.me/", + "state"=outputState ) actualCalls = list( outputCreated = FALSE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = FALSE, bundleUploaded = FALSE, @@ -426,16 +490,22 @@ deployAppMockServerFactory <- function(expectedAppType) { application_id=3 ) } + ), + "^PATCH /v1/outputs" = list( + content = function(...) { + e <- environment(); p <- parent.env(e); p$actualCalls$outputStateUpdated = TRUE + } ) )) expect_calls <- function(expectedCalls) { - expect_equal(expectedCalls, actualCalls) + expect_equal(actualCalls, expectedCalls) } reset_calls <- function() { e <- environment(); p <- parent.env(e); p$actualCalls = list( outputCreated = FALSE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = FALSE, bundleUploaded = FALSE, @@ -452,7 +522,7 @@ deployAppMockServerFactory <- function(expectedAppType) { } test_that("deployApp() for shiny results in correct Cloud API calls", { - mock <- deployAppMockServerFactory(expectedAppType="connect") + mock <- deployAppMockServerFactory(expectedAppType="connect", outputState="active") mockServer <- mock$server restoreOpt <- options(rsconnect.http = mockServer$impl) @@ -463,7 +533,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { sourcePath = test_path('shinyapp-simple') # Remove local deployment info at end for reproducibility and tidiness. - withr::defer(forgetDeployment(appPath=sourcePath)) + withr::defer(forgetDeployment(appPath=sourcePath, force=TRUE)) deployApp( appName = "Desired name here", @@ -474,6 +544,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { mock$expect_calls(list( outputCreated = TRUE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = TRUE, bundleUploaded = TRUE, @@ -490,6 +561,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { mock$expect_calls(list( outputCreated = FALSE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = TRUE, bundleUploaded = TRUE, @@ -499,7 +571,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { # Start over, add another posit.cloud account and test again with that environment mock$reset_calls() - forgetDeployment(appPath=sourcePath) + forgetDeployment(appPath=sourcePath, force=TRUE) extraLocalAccount <- configureTestAccount(name="testthat-superfluous-account") withr::defer(removeAccount(extraLocalAccount)) @@ -513,6 +585,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { mock$expect_calls(list( outputCreated = TRUE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = TRUE, bundleUploaded = TRUE, @@ -529,6 +602,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { mock$expect_calls(list( outputCreated = FALSE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = TRUE, bundleUploaded = TRUE, @@ -538,7 +612,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { }) test_that("deployDoc() results in correct Cloud API calls", { - mock <- deployAppMockServerFactory(expectedAppType="static") + mock <- deployAppMockServerFactory(expectedAppType="static", outputState="active") mockServer <- mock$server restoreOpt <- options(rsconnect.http = mockServer$impl) @@ -549,7 +623,7 @@ test_that("deployDoc() results in correct Cloud API calls", { sourcePath = test_path('static-with-quarto-yaml') # Remove local deployment info at end for reproducibility and tidiness. - withr::defer(forgetDeployment(appPath=sourcePath)) + withr::defer(forgetDeployment(appPath=sourcePath, force=TRUE)) deployDoc( paste(sourcePath, "slideshow.html", sep="/"), @@ -560,6 +634,7 @@ test_that("deployDoc() results in correct Cloud API calls", { mock$expect_calls(list( outputCreated = TRUE, + outputStateUpdated = FALSE, revisionCreated = FALSE, bundleCreated = TRUE, bundleUploaded = TRUE, @@ -576,6 +651,7 @@ test_that("deployDoc() results in correct Cloud API calls", { mock$expect_calls(list( outputCreated = FALSE, + outputStateUpdated = FALSE, revisionCreated = TRUE, bundleCreated = TRUE, bundleUploaded = TRUE, From 629a6bd1de27b867b06cbfbed57f65ced4d280f1 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Fri, 28 Apr 2023 10:59:57 -0500 Subject: [PATCH 11/28] version dcf files to distinguish between cloud application and content ids --- R/applications.R | 2 +- R/client-cloud.R | 15 +++++++-------- R/client-connect.R | 2 +- R/client-shinyapps.R | 2 +- R/deployApp.R | 2 +- R/deploymentTarget.R | 19 +++++++++++++------ R/deployments.R | 11 +++++------ tests/testthat/_snaps/deployments.md | 3 +++ tests/testthat/helper.R | 4 +++- tests/testthat/test-client-cloud.R | 13 +++++++------ tests/testthat/test-deployApp.R | 2 +- tests/testthat/test-deployments.R | 10 ++++++---- 12 files changed, 49 insertions(+), 36 deletions(-) diff --git a/R/applications.R b/R/applications.R index b52eb8b6..03ab4fb9 100644 --- a/R/applications.R +++ b/R/applications.R @@ -137,7 +137,7 @@ getApplication <- function(account, server, appId) { client <- clientForAccount(accountDetails) withCallingHandlers( - client$getApplication(appId), + client$getApplication(appId, dcfVersion), rsconnect_http_404 = function(err) { cli::cli_abort("Can't find app with id {.str {appId}}", parent = err) } diff --git a/R/client-cloud.R b/R/client-cloud.R index 22bac50a..ddabb81d 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -64,23 +64,21 @@ cloudClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId) { - if (is.character(applicationId) && startsWith(applicationId, "lucid:content:")) { - # applicationId refers in this case to the id of the output, not the - # application. - contentId <- strsplit(applicationId, ":")[[1]][3] - - path <- paste("/outputs/", contentId, sep = "") + getApplication = function(applicationId, dcfVersion) { + if (!(is.na(dcfVersion) || is.null(dcfVersion))) { + # On version >=1, applicationId refers to the id of the output, not the application. + path <- paste("/outputs/", applicationId, sep = "") output <- GET(service, authInfo, path) path <- paste("/applications/", output$source_id, sep = "") application <- GET(service, authInfo, path) } else { # backwards compatibility for data saved with the application's id + # TODO: remove support for this case path <- paste("/applications/", applicationId, sep = "") application <- GET(service, authInfo, path) - output_id <- application$content_id + output_id <- ifelse(is.null(application$output_id), application$content_id, application$output_id) path <- paste("/outputs/", output_id, sep = "") output <- GET(service, authInfo, path) @@ -98,6 +96,7 @@ cloudClient <- function(service, authInfo) { # outputs by their own id instead of the applications'. application$content_id <- output$id application$url <- output$url + application$name <- output$name application }, diff --git a/R/client-connect.R b/R/client-connect.R index f93cc3f9..c2775169 100644 --- a/R/client-connect.R +++ b/R/client-connect.R @@ -85,7 +85,7 @@ connectClient <- function(service, authInfo) { "/applications/", applicationId, "/config", sep = "")) }, - getApplication = function(applicationId) { + getApplication = function(applicationId, dcfVersion) { GET(service, authInfo, paste0("/applications/", applicationId)) }, diff --git a/R/client-shinyapps.R b/R/client-shinyapps.R index c5170c80..b79e600e 100644 --- a/R/client-shinyapps.R +++ b/R/client-shinyapps.R @@ -64,7 +64,7 @@ shinyAppsClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId) { + getApplication = function(applicationId, dcfVersion) { path <- paste("/applications/", applicationId, sep = "") GET(service, authInfo, path) }, diff --git a/R/deployApp.R b/R/deployApp.R index 7c91b443..8c3cd461 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -340,7 +340,7 @@ deployApp <- function(appDir = getwd(), application <- taskStart(quiet, "Looking up application with id {.val {target$appId}}...") application <- tryCatch( { - application <- client$getApplication(target$appId) + application <- client$getApplication(target$appId, target$version) taskComplete(quiet, "Found application {.url {application$url}}") application }, diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 083d1513..8c2cdf60 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -45,7 +45,8 @@ deploymentTarget <- function(recordPath = ".", appId, fullAccount$name, # first deploy must be to own account fullAccount$name, - fullAccount$server + fullAccount$server, + dcfVersion ) } else if (nrow(appDeployments) == 1) { # If both appName and appId supplied, check that they're consistent. @@ -91,13 +92,16 @@ deploymentTargetForApp <- function(appId, accountDetails <- findAccount(account, server) application <- getApplication(accountDetails$name, accountDetails$server, appId) + resultAppId <- ifelse(is.null(application$content_id), application$id, application$content_id) + createDeploymentTarget( application$name, application$title %||% appTitle, - application$id, + resultAppId, application$owner_username, accountDetails$name, - accountDetails$server + accountDetails$server, + dcfVersion ) } @@ -106,14 +110,16 @@ createDeploymentTarget <- function(appName, appId, username, account, - server) { + server, + version) { list( appName = appName, appTitle = appTitle %||% "", appId = appId, username = username, account = account, - server = server + server = server, + version = version ) } @@ -125,7 +131,8 @@ updateDeploymentTarget <- function(previous, appTitle = NULL) { # if username not previously recorded, use current account previous$username %||% previous$account, previous$account, - previous$server + previous$server, + previous$version ) } diff --git a/R/deployments.R b/R/deployments.R index 15d30131..90cd0285 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -75,7 +75,7 @@ deployments <- function(appPath = ".", deploymentFields <- c( "name", "title", "username", "account", "server", "hostUrl", "appId", - "bundleId", "url" + "bundleId", "url", "version" ) saveDeployment <- function(recordDir, @@ -84,11 +84,7 @@ saveDeployment <- function(recordDir, bundleId = NULL, hostUrl = serverInfo(target$server)$url, metadata = list()) { - if (target$server == "posit.cloud") { - appId <- paste("lucid", "content", application$content_id, sep = ":") - } else { - appId <- application$id - } + appId <- ifelse(target$server == "posit.cloud", application$content_id, application$id) deployment <- deploymentRecord( name = target$appName, title = target$appTitle, @@ -135,7 +131,10 @@ deploymentRecord <- function(name, c(standard, metadata) } +dcfVersion <- "1" + writeDeploymentRecord <- function(record, filePath) { + record$version <- dcfVersion # use a long width so URLs don't line-wrap write.dcf(record, filePath, width = 4096) } diff --git a/tests/testthat/_snaps/deployments.md b/tests/testthat/_snaps/deployments.md index c9c75962..8cc7604d 100644 --- a/tests/testthat/_snaps/deployments.md +++ b/tests/testthat/_snaps/deployments.md @@ -6,13 +6,16 @@ Output x: 1 appPath: path + version: 1 Code addToDeploymentHistory("path", list(x = 2)) writeLines(readLines(deploymentHistoryPath())) Output x: 2 appPath: path + version: 1 x: 1 appPath: path + version: 1 diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 4b724ec6..9f182db3 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -78,6 +78,7 @@ addTestDeployment <- function(path, account = "ron", username = account, server = "example.com", + version = dcfVersion, url = paste0("https://", server, "/", username, "/", appId), hostUrl = NULL, metadata = list()) { @@ -89,7 +90,8 @@ addTestDeployment <- function(path, appId = appId, account = account, username = username, - server = server + server = server, + version = version ), application = list(id = appId, url = url), hostUrl = hostUrl, diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index 45df23c1..419ecf9f 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -166,13 +166,13 @@ test_that("Get application", { ) client <- cloudClient(fakeService, NULL) - app <- client$getApplication(10) + app <- client$getApplication("10", NULL) expect_equal(app$id, 10) expect_equal(app$content_id, 5) expect_equal(app$url, "http://fake-url.test.me/") - app <- client$getApplication("lucid:content:5") + app <- client$getApplication("5", dcfVersion) expect_equal(app$id, 1) expect_equal(app$content_id, 5) @@ -224,13 +224,13 @@ test_that("Get application output trashed", { ) client <- cloudClient(fakeService, NULL) - app <- client$getApplication(10) + app <- client$getApplication(10, NULL) expect_equal(app$id, 10) expect_equal(app$content_id, 5) expect_equal(app$url, "http://fake-url.test.me/") - app <- client$getApplication("lucid:content:5") + app <- client$getApplication(5, dcfVersion) expect_equal(app$id, 1) expect_equal(app$content_id, 5) @@ -353,7 +353,8 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", { "id"=output_id, "source_id"=output_id + 1, "url"="http://fake-url.test.me/", - "state"="active" + "state"="active", + "name"="my output" ) } ) @@ -371,7 +372,7 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", { server = 'posit.cloud', ) - expect_equal(target$appName, "testthat app 3") + expect_equal(target$appName, "my output") expect_equal(target$account, testAccount) expect_equal(target$server, 'posit.cloud') expect_equal(target$appId, 3) diff --git a/tests/testthat/test-deployApp.R b/tests/testthat/test-deployApp.R index b517dc34..b81e216e 100644 --- a/tests/testthat/test-deployApp.R +++ b/tests/testthat/test-deployApp.R @@ -89,7 +89,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", "a", "a", "s") + target <- createDeploymentTarget("name", "title", "id", "a", "a", "s", 1) client <- list(createApplication = function(...) NULL) expect_snapshot(applicationDeleted(client, target, app), error = TRUE) diff --git a/tests/testthat/test-deployments.R b/tests/testthat/test-deployments.R index da39396d..eee832b5 100644 --- a/tests/testthat/test-deployments.R +++ b/tests/testthat/test-deployments.R @@ -87,9 +87,10 @@ test_that("saveDeployment appends to global history", { appId = 10, account = "foo", username = "foo", - server = "bar" + server = "bar", + version = dcfVersion ), - application = list(), + application = list(id=1), hostUrl = NULL ) @@ -112,9 +113,10 @@ test_that("saveDeployment captures hostUrl", { appId = 10, account = "foo", username = "foo", - server = "example.com" + server = "example.com", + version = dcfVersion ), - application = list() + application = list(id=10) ) out <- deployments(dir) From 39591970214adb9a2970e1bae964b3465c36aebd Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Fri, 28 Apr 2023 12:08:50 -0500 Subject: [PATCH 12/28] appease linter --- R/client-cloud.R | 4 +- tests/testthat/test-client-cloud.R | 308 +++++++++++++++-------------- tests/testthat/test-deployments.R | 4 +- 3 files changed, 166 insertions(+), 150 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 7404e594..c9296276 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -87,9 +87,9 @@ cloudClient <- function(service, authInfo) { } # if the output is trashed or archived, restore it to the active state - if (output$state == 'trashed' || output$state == 'archived') { + if (output$state == "trashed" || output$state == "archived") { json <- list() - json$state <- 'active' + json$state <- "active" PATCH_JSON(service, authInfo, paste("/outputs/", output$id, sep = ""), json) } diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index 419ecf9f..2494ae29 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -1,29 +1,29 @@ mockServerFactory <- function(initialResponses) { # Stock responses for certain endpoints. Can still be overridden by tests. if (is.null(initialResponses$"^GET /v1/users/current")) { - initialResponses$"GET /v1/users/current" = list( + initialResponses$"GET /v1/users/current" <- list( content = list( - id=100 + id = 100 ) ) } if (is.null(initialResponses$"^GET /v1/accounts/?")) { - initialResponses$"^GET /v1/accounts/?" = list( + initialResponses$"^GET /v1/accounts/?" <- list( content = list( - count=1, - total=1, - offset=0, - accounts=list( + count = 1, + total = 1, + offset = 0, + accounts = list( list( - id=50, - name="testthat-account", - account="testthat-account" + id = 50, + name = "testthat-account", + account = "testthat-account" ), list( - id=51, - name="testthat-superfluous-account", - account="testthat-superfluous-account" + id = 51, + name = "testthat-superfluous-account", + account = "testthat-superfluous-account" ) ) ) @@ -49,7 +49,7 @@ mockServerFactory <- function(initialResponses) { certificate = NULL, timeout = NULL) { - methodAndPath = paste(method, path) + methodAndPath <- paste(method, path) request <- list( protocol = protocol, @@ -59,7 +59,7 @@ mockServerFactory <- function(initialResponses) { path = path ) - response = list( + response <- list( req = request, status = 200, location = "", @@ -79,16 +79,16 @@ mockServerFactory <- function(initialResponses) { responseSupplement[[respProperty]] <- responseSupplement[[respProperty]]( methodAndPath, match, - headers=headers, - contentType=contentType, - contentFile=contentFile) + headers = headers, + contentType = contentType, + contentFile = contentFile) } - response[[respProperty]] = responseSupplement[[respProperty]] + response[[respProperty]] <- responseSupplement[[respProperty]] } if (is.list(response$content)) { - response$content <- jsonlite::toJSON(response$content, auto_unbox=TRUE) + response$content <- jsonlite::toJSON(response$content, auto_unbox = TRUE) } break @@ -105,22 +105,22 @@ mockServerFactory <- function(initialResponses) { mockServer } -configureTestAccount <- function(server = 'posit.cloud', name = NULL) { +configureTestAccount <- function(server = "posit.cloud", name = NULL) { if (is.null(name)) { - name = 'testthat-account' + name <- "testthat-account" } existingAccount <- NULL tryCatch( existingAccount <- accountInfo(name, server), - error = function(e) { existingAccount = NULL } + error = function(e) { existingAccount <- NULL } ) if (is.null(existingAccount)) { setAccountInfo( name = name, - token = 'foo', - secret = 'bar', + token = "foo", + secret = "bar", server = server ) } @@ -129,28 +129,28 @@ configureTestAccount <- function(server = 'posit.cloud', name = NULL) { } test_that("Get application", { - mockServer = mockServerFactory(list( + mockServer <- mockServerFactory(list( "^GET /outputs/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] output_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=output_id, - "source_id"=1, - "url"="http://fake-url.test.me/", - "state"="active" + "id" = output_id, + "source_id" = 1, + "url" = "http://fake-url.test.me/", + "state" = "active" ) } ), "^GET /applications/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] application_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=application_id, - "content_id"=5 + "id" = application_id, + "content_id" = 5 ) } ) @@ -160,9 +160,9 @@ test_that("Get application", { withr::defer(options(restoreOpt)) fakeService <- list( - protocol="test", - host="unit-test", - port=42 + protocol = "test", + host = "unit-test", + port = 42 ) client <- cloudClient(fakeService, NULL) @@ -180,34 +180,34 @@ test_that("Get application", { }) test_that("Get application output trashed", { - mockServer = mockServerFactory(list( + mockServer <- mockServerFactory(list( "^GET /outputs/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] output_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=output_id, - "source_id"=1, - "url"="http://fake-url.test.me/", - "state"="trashed" + "id" = output_id, + "source_id" = 1, + "url" = "http://fake-url.test.me/", + "state" = "trashed" ) } ), "^GET /applications/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] application_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=application_id, - "content_id"=5 + "id" = application_id, + "content_id" = 5 ) } ), "^PATCH /outputs/5" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] output_id <- strtoi(substr(methodAndPath, match[2], end)) list() } @@ -218,9 +218,9 @@ test_that("Get application output trashed", { withr::defer(options(restoreOpt)) fakeService <- list( - protocol="test", - host="unit-test", - port=42 + protocol = "test", + host = "unit-test", + port = 42 ) client <- cloudClient(fakeService, NULL) @@ -238,23 +238,23 @@ test_that("Get application output trashed", { }) test_that("Create application", { - mockServer = mockServerFactory(list( + mockServer <- mockServerFactory(list( "^POST /outputs" = list( content = list( - "id"=1, - "source_id"=2, - "url"="http://fake-url.test.me/", - "state"="active" + "id" = 1, + "source_id" = 2, + "url" = "http://fake-url.test.me/", + "state" = "active" ) ), "^GET /applications/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] application_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=application_id, - "content_id"=1 + "id" = application_id, + "content_id" = 1 ) }) )) @@ -263,9 +263,9 @@ test_that("Create application", { withr::defer(options(restoreOpt)) fakeService <- list( - protocol="test", - host="unit-test", - port=42 + protocol = "test", + host = "unit-test", + port = 42 ) client <- cloudClient(fakeService, NULL) @@ -277,36 +277,36 @@ test_that("Create application", { }) test_that("Create application with linked source project", { - mockServer = mockServerFactory(list( + mockServer <- mockServerFactory(list( "^POST /outputs" = list( content = function(methodAndPAth, match, contentFile, ...) { - content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) expect_equal(content$project, 41) expect_equal(content$space, 99) list( - "id"=1, - "source_id"=2, - "url"="http://fake-url.test.me/", - "state"="active" + "id" = 1, + "source_id" = 2, + "url" = "http://fake-url.test.me/", + "state" = "active" ) } ), "^GET /applications/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] application_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=application_id, - "content_id"=application_id-1 + "id" = application_id, + "content_id" = application_id - 1 ) } ), "^GET /content/41" = list( content = list( - "id"=41, - "space_id"=99 + "id" = 41, + "space_id" = 99 ) ) )) @@ -314,13 +314,13 @@ test_that("Create application with linked source project", { restoreOpt <- options(rsconnect.http = mockServer$impl) withr::defer(options(restoreOpt)) - Sys.setenv(LUCID_APPLICATION_ID="42") + Sys.setenv(LUCID_APPLICATION_ID = "42") withr::defer(Sys.unsetenv("LUCID_APPLICATION_ID")) fakeService <- list( - protocol="test", - host="unit-test", - port=42 + protocol = "test", + host = "unit-test", + port = 42 ) client <- cloudClient(fakeService, NULL) @@ -332,29 +332,29 @@ test_that("Create application with linked source project", { }) test_that("deploymentTargetForApp() results in correct Cloud API calls", { - mockServer = mockServerFactory(list( + mockServer <- mockServerFactory(list( "^GET /v1/applications/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] application_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=application_id, - "content_id"=application_id-1, - "name"=paste("testthat app", application_id) + "id" = application_id, + "content_id" = application_id - 1, + "name" = paste("testthat app", application_id) ) } ), "^GET /v1/outputs/([0-9]+)" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] output_id <- strtoi(substr(methodAndPath, match[2], end)) list( - "id"=output_id, - "source_id"=output_id + 1, - "url"="http://fake-url.test.me/", - "state"="active", - "name"="my output" + "id" = output_id, + "source_id" = output_id + 1, + "url" = "http://fake-url.test.me/", + "state" = "active", + "name" = "my output" ) } ) @@ -369,24 +369,24 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", { target <- deploymentTargetForApp( appId = 3, account = testAccount, - server = 'posit.cloud', + server = "posit.cloud", ) expect_equal(target$appName, "my output") expect_equal(target$account, testAccount) - expect_equal(target$server, 'posit.cloud') + expect_equal(target$server, "posit.cloud") expect_equal(target$appId, 3) }) deployAppMockServerFactory <- function(expectedAppType, outputState) { outputResponse <- list( - "id"=1, - "source_id"=2, - "url"="http://fake-url.test.me/", - "state"=outputState + "id" = 1, + "source_id" = 2, + "url" = "http://fake-url.test.me/", + "state" = outputState ) - actualCalls = list( + actualCalls <- list( outputCreated = FALSE, outputStateUpdated = FALSE, revisionCreated = FALSE, @@ -399,18 +399,20 @@ deployAppMockServerFactory <- function(expectedAppType, outputState) { server <- mockServerFactory(list( # An attempt to search for preexisting applications with the same name. # This call should change, see https://github.com/rstudio/rsconnect/issues/808 - "^GET /v1/applications/[?]filter=account_id:50&filter=type:connect"=list( - content=list( - count=0, - total=0, - applications=list() + "^GET /v1/applications/[?]filter=account_id:50&filter=type:connect" = list( + content = list( + count = 0, + total = 0, + applications = list() ) ), - "^POST /v1/outputs$"=list( - content=function(methodAndPath, match, contentFile, ...) { - e <- environment(); p <- parent.env(e); p$actualCalls$outputCreated <- TRUE + "^POST /v1/outputs$" = list( + content = function(methodAndPath, match, contentFile, ...) { + e <- environment() + p <- parent.env(e) + p$actualCalls$outputCreated <- TRUE - content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) expect_equal(content$application_type, expectedAppType) expect_equal(content$name, "Desired name here") @@ -420,22 +422,24 @@ deployAppMockServerFactory <- function(expectedAppType, outputState) { ), "^GET /v1/applications/([0-9]+)$" = list( content = function(methodAndPath, match, ...) { - end <- attr(match, 'match.length')[2] + match[2] + end <- attr(match, "match.length")[2] + match[2] application_id <- strtoi(substr(methodAndPath, match[2], end)) list( - id=application_id, - content_id=application_id-1, - name=paste("testthat app", application_id), - type=expectedAppType + id = application_id, + content_id = application_id - 1, + name = paste("testthat app", application_id), + type = expectedAppType ) } ), "^POST /v1/bundles/123/status$" = list( - content = function(methodAndPath, match, contentFile, ...){ - e <- environment(); p <- parent.env(e); p$actualCalls$bundleReady = TRUE + content = function(methodAndPath, match, contentFile, ...) { + e <- environment() + p <- parent.env(e) + p$actualCalls$bundleReady <- TRUE - content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) expect_equal(content$status, "ready") list() @@ -443,58 +447,68 @@ deployAppMockServerFactory <- function(expectedAppType, outputState) { ), "^POST /v1/bundles$" = list( content = function(methodAndPath, match, contentFile, ...) { - e <- environment(); p <- parent.env(e); p$actualCalls$bundleCreated = TRUE + e <- environment() + p <- parent.env(e) + p$actualCalls$bundleCreated <- TRUE - content = jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) + content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size)) list( - id=123, - presigned_url="https://write-only-memory.com/fake-presigned-url", - presigned_checksum=content$checksum + id = 123, + presigned_url = "https://write-only-memory.com/fake-presigned-url", + presigned_checksum = content$checksum ) } ), "^PUT /fake-presigned-url" = list( content = function(...) { - e <- environment(); p <- parent.env(e); p$actualCalls$bundleUploaded = TRUE + e <- environment() + p <- parent.env(e) + p$actualCalls$bundleUploaded <- TRUE } ), "^GET /v1/bundles/123$" = list( - content=list( - id=123, - status="ready" + content = list( + id = 123, + status = "ready" ) ), "^POST /v1/applications/[23]/deploy$" = list( - content=function(...) { - e <- environment(); p <- parent.env(e); p$actualCalls$deployStarted = TRUE + content = function(...) { + e <- environment() + p <- parent.env(e) + p$actualCalls$deployStarted <- TRUE list( - task_id="testthat-task-id" + task_id = "testthat-task-id" ) } ), "^GET /v1/tasks/testthat-task-id$" = list( content = list( - status="success", - finished=TRUE + status = "success", + finished = TRUE ) ), # Fetch existing output when re-deploying from .dcf data "^GET /v1/outputs/1$" = list( - content=outputResponse + content = outputResponse ), "^POST /v1/outputs/1/revisions" = list( - content=function(...) { - e <- environment(); p <- parent.env(e); p$actualCalls$revisionCreated = TRUE + content = function(...) { + e <- environment() + p <- parent.env(e) + p$actualCalls$revisionCreated <- TRUE list( - application_id=3 + application_id = 3 ) } ), "^PATCH /v1/outputs" = list( content = function(...) { - e <- environment(); p <- parent.env(e); p$actualCalls$outputStateUpdated = TRUE + e <- environment() + p <- parent.env(e) + p$actualCalls$outputStateUpdated <- TRUE } ) )) @@ -504,7 +518,9 @@ deployAppMockServerFactory <- function(expectedAppType, outputState) { } reset_calls <- function() { - e <- environment(); p <- parent.env(e); p$actualCalls = list( + e <- environment() + p <- parent.env(e) + p$actualCalls <- list( outputCreated = FALSE, outputStateUpdated = FALSE, revisionCreated = FALSE, @@ -516,14 +532,14 @@ deployAppMockServerFactory <- function(expectedAppType, outputState) { } list( - server=server, - expect_calls=expect_calls, - reset_calls=reset_calls + server = server, + expect_calls = expect_calls, + reset_calls = reset_calls ) } test_that("deployApp() for shiny results in correct Cloud API calls", { - mock <- deployAppMockServerFactory(expectedAppType="connect", outputState="active") + mock <- deployAppMockServerFactory(expectedAppType = "connect", outputState = "active") mockServer <- mock$server restoreOpt <- options(rsconnect.http = mockServer$impl) @@ -532,14 +548,14 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { testAccount <- configureTestAccount() withr::defer(removeAccount(testAccount)) - sourcePath = test_path('shinyapp-simple') + sourcePath <- test_path("shinyapp-simple") # Remove local deployment info at end for reproducibility and tidiness. - withr::defer(forgetDeployment(appPath=sourcePath, force=TRUE)) + withr::defer(forgetDeployment(appPath = sourcePath, force = TRUE)) deployApp( appName = "Desired name here", appDir = sourcePath, - server = 'posit.cloud', + server = "posit.cloud", account = testAccount ) @@ -572,15 +588,15 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { # Start over, add another posit.cloud account and test again with that environment mock$reset_calls() - forgetDeployment(appPath=sourcePath, force=TRUE) + forgetDeployment(appPath = sourcePath, force = TRUE) - extraLocalAccount <- configureTestAccount(name="testthat-superfluous-account") + extraLocalAccount <- configureTestAccount(name = "testthat-superfluous-account") withr::defer(removeAccount(extraLocalAccount)) deployApp( appName = "Desired name here", appDir = sourcePath, - server = 'posit.cloud', + server = "posit.cloud", account = testAccount ) @@ -613,7 +629,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", { }) test_that("deployDoc() results in correct Cloud API calls", { - mock <- deployAppMockServerFactory(expectedAppType="static", outputState="active") + mock <- deployAppMockServerFactory(expectedAppType = "static", outputState = "active") mockServer <- mock$server restoreOpt <- options(rsconnect.http = mockServer$impl) @@ -622,14 +638,14 @@ test_that("deployDoc() results in correct Cloud API calls", { testAccount <- configureTestAccount() withr::defer(removeAccount(testAccount)) - sourcePath = test_path('static-with-quarto-yaml') + sourcePath <- test_path("static-with-quarto-yaml") # Remove local deployment info at end for reproducibility and tidiness. - withr::defer(forgetDeployment(appPath=sourcePath, force=TRUE)) + withr::defer(forgetDeployment(appPath = sourcePath, force = TRUE)) deployDoc( - paste(sourcePath, "slideshow.html", sep="/"), + paste(sourcePath, "slideshow.html", sep = "/"), appName = "Desired name here", - server = 'posit.cloud', + server = "posit.cloud", account = testAccount ) diff --git a/tests/testthat/test-deployments.R b/tests/testthat/test-deployments.R index bb2e1750..308752f4 100644 --- a/tests/testthat/test-deployments.R +++ b/tests/testthat/test-deployments.R @@ -114,7 +114,7 @@ test_that("saveDeployment appends to global history", { server = "bar", version = dcfVersion ), - application = list(id=1), + application = list(id = 1), hostUrl = NULL ) @@ -141,7 +141,7 @@ test_that("saveDeployment captures hostUrl", { server = "example.com", version = dcfVersion ), - application = list(id=10) + application = list(id = 10) ) out <- deployments(dir) From 3a31ee57ef25a6278a3dfa35a9d3c4faf170d883 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Fri, 28 Apr 2023 15:05:21 -0500 Subject: [PATCH 13/28] rename cloud client getApplication id parameter and clarify dcf version cases --- R/client-cloud.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index c9296276..4f3bbfa0 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -66,24 +66,24 @@ cloudClient <- function(service, authInfo) { listRequest(service, authInfo, path, query, "applications") }, - getApplication = function(applicationId, dcfVersion) { - if (!(is.na(dcfVersion) || is.null(dcfVersion))) { - # On version >=1, applicationId refers to the id of the output, not the application. - path <- paste("/outputs/", applicationId, sep = "") - output <- GET(service, authInfo, path) - - path <- paste("/applications/", output$source_id, sep = "") - application <- GET(service, authInfo, path) - } else { - # backwards compatibility for data saved with the application's id + getApplication = function(outputOrApplicationId, dcfVersion) { + if (is.na(dcfVersion) || is.null(dcfVersion)) { + # In pre-versioned dcf files, contentOrAppId is the id of the application. # TODO: remove support for this case - path <- paste("/applications/", applicationId, sep = "") + path <- paste("/applications/", outputOrApplicationId, sep = "") application <- GET(service, authInfo, path) output_id <- ifelse(is.null(application$output_id), application$content_id, application$output_id) path <- paste("/outputs/", output_id, sep = "") output <- GET(service, authInfo, path) + } else { + # from dcf version >= 1, outputOrApplicationId is the id of the output. + path <- paste("/outputs/", outputOrApplicationId, sep = "") + output <- GET(service, authInfo, path) + + path <- paste("/applications/", output$source_id, sep = "") + application <- GET(service, authInfo, path) } # if the output is trashed or archived, restore it to the active state From 2c6ec3fcddce3a6f5bb391b05b331a04fbbdda99 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 09:34:01 -0500 Subject: [PATCH 14/28] name arguments in http.R --- R/http.R | 84 ++++++++++++++++++++++++++++---------------------------- 1 file changed, 42 insertions(+), 42 deletions(-) diff --git a/R/http.R b/R/http.R index 470eb4c1..029017da 100644 --- a/R/http.R +++ b/R/http.R @@ -220,15 +220,15 @@ POST <- function(service, } else { # include the request's data in the body httpRequestWithBody( - service, - authInfo, - "POST", - path, - query, - contentType, - file, - content, - headers + service = service, + authInfo = authInfo, + method = "POST", + path = path, + query = query, + contentType = contentType, + file = file, + content = content, + headers = headers ) } } @@ -240,11 +240,11 @@ POST_JSON <- function(service, query = NULL, headers = list()) { POST( - service, - authInfo, - path, - query, - "application/json", + service = service, + authInfo = authInfo, + path = path, + query = query, + contentType = "application/json", content = toJSON(json), headers = headers ) @@ -259,15 +259,15 @@ PUT <- function(service, content = NULL, headers = list()) { httpRequestWithBody( - service, - authInfo, - "PUT", - path, - query, - contentType, - file, - content, - headers + service = service, + authInfo = authInfo, + method = "PUT", + path = path, + query = query, + contentType = contentType, + file = file, + content = content, + headers = headers ) } @@ -278,11 +278,11 @@ PUT_JSON <- function(service, query = NULL, headers = list()) { PUT( - service, - authInfo, - path, - query, - "application/json", + service = service, + authInfo = authInfo, + path = path, + query = query, + contentType = "application/json", content = toJSON(json), headers = headers ) @@ -297,15 +297,15 @@ PATCH <- function(service, content = NULL, headers = list()) { httpRequestWithBody( - service, - authInfo, - "PATCH", - path, - query, - contentType, - file, - content, - headers + service = service, + authInfo = authInfo, + method = "PATCH", + path = path, + query = query, + contentType = contentType, + file = file, + content = content, + headers = headers ) } @@ -316,11 +316,11 @@ PATCH_JSON <- function(service, query = NULL, headers = list()) { PATCH( - service, - authInfo, - path, - query, - "application/json", + service = service, + authInfo = authInfo, + path = path, + query = query, + contentType = "application/json", content = toJSON(json), headers = headers ) From 23f70186b3cf6ed9c9d7a708a31d1f60c87621f8 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 09:42:10 -0500 Subject: [PATCH 15/28] check solely for dcfVersion being NA --- R/client-cloud.R | 2 +- tests/testthat/test-client-cloud.R | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 4f3bbfa0..b8def8c3 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -67,7 +67,7 @@ cloudClient <- function(service, authInfo) { }, getApplication = function(outputOrApplicationId, dcfVersion) { - if (is.na(dcfVersion) || is.null(dcfVersion)) { + if (is.na(dcfVersion)) { # In pre-versioned dcf files, contentOrAppId is the id of the application. # TODO: remove support for this case path <- paste("/applications/", outputOrApplicationId, sep = "") diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index 2494ae29..1009a71e 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -166,7 +166,7 @@ test_that("Get application", { ) client <- cloudClient(fakeService, NULL) - app <- client$getApplication("10", NULL) + app <- client$getApplication("10", NA) expect_equal(app$id, 10) expect_equal(app$content_id, 5) @@ -224,7 +224,7 @@ test_that("Get application output trashed", { ) client <- cloudClient(fakeService, NULL) - app <- client$getApplication(10, NULL) + app <- client$getApplication(10, NA) expect_equal(app$id, 10) expect_equal(app$content_id, 5) From bb81aa38566cd2749962d6b85ef5205c4f5fc279 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 09:44:28 -0500 Subject: [PATCH 16/28] use %||% instead of ifelse to determine output_id Co-authored-by: Hadley Wickham --- R/client-cloud.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index b8def8c3..d47b9419 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -73,7 +73,7 @@ cloudClient <- function(service, authInfo) { path <- paste("/applications/", outputOrApplicationId, sep = "") application <- GET(service, authInfo, path) - output_id <- ifelse(is.null(application$output_id), application$content_id, application$output_id) + output_id <- application$output_id %||% application$content_id path <- paste("/outputs/", output_id, sep = "") output <- GET(service, authInfo, path) From 7e068b44b6fc3a4129ad4eba3c4948145ebed1e8 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 09:55:38 -0500 Subject: [PATCH 17/28] refactor revision creation to be closer to application creation --- R/deployApp.R | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/R/deployApp.R b/R/deployApp.R index 1e4ee872..515f6cc8 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -345,7 +345,6 @@ deployApp <- function(appDir = getwd(), showCookies(serverInfo(accountDetails$server)$url) } - isNewApplication <- FALSE if (is.null(target$appId)) { taskStart(quiet, "Creating application on server...") application <- client$createApplication( @@ -356,19 +355,22 @@ deployApp <- function(appDir = getwd(), appMetadata$appMode ) taskComplete(quiet, "Created application with id {.val {application$id}}") - isNewApplication <- TRUE } else { application <- taskStart(quiet, "Looking up application with id {.val {target$appId}}...") application <- tryCatch( { application <- client$getApplication(target$appId, target$version) taskComplete(quiet, "Found application {.url {application$url}}") + + if (application$type == "static") { + application$id <- client$createRevision(application) + } + application }, rsconnect_http_404 = function(err) { application <- applicationDeleted(client, target, recordPath, appMetadata) taskComplete(quiet, "Created application with id {.val {application$id}}") - isNewApplication <- TRUE application } ) @@ -417,9 +419,6 @@ deployApp <- function(appDir = getwd(), # create, and upload the bundle taskStart(quiet, "Uploading bundle...") if (isCloudServer(accountDetails$server)) { - if (application$type == "static" && !isNewApplication) { - application$id <- client$createRevision(application) - } bundle <- uploadCloudBundle(client, application$id, bundlePath) } else { bundle <- client$uploadApplication(application$id, bundlePath) From c995cad31e40f3b70460d8fdd181239cfdc18568 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 10:02:23 -0500 Subject: [PATCH 18/28] use regular if/else to determine application_type --- R/client-cloud.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index d47b9419..3fd68bd5 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -124,7 +124,7 @@ cloudClient <- function(service, authInfo) { createApplication = function(name, title, template, accountId, appMode) { json <- list() json$name <- name - json$application_type <- ifelse(appMode == "static", "static", "connect") + json$application_type <- if (appMode == "static") "static" else "connect" currentApplicationId <- Sys.getenv("LUCID_APPLICATION_ID") if (currentApplicationId != "") { From ac360e69ee12554849b47bc7da08562800c418e9 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 10:44:15 -0500 Subject: [PATCH 19/28] in cloud client createApplication/getApplication, return content id as id and application id as application_id --- R/client-cloud.R | 11 +++++++---- R/client-connect.R | 4 ++-- R/client-shinyapps.R | 4 ++-- R/deployApp.R | 4 ++-- R/deploymentTarget.R | 4 +--- R/restartApp.R | 2 +- tests/testthat/test-client-cloud.R | 24 ++++++++++++------------ tests/testthat/test-client-connect.R | 2 +- 8 files changed, 28 insertions(+), 27 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 3fd68bd5..82732dde 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -84,6 +84,7 @@ cloudClient <- function(service, authInfo) { path <- paste("/applications/", output$source_id, sep = "") application <- GET(service, authInfo, path) + application } # if the output is trashed or archived, restore it to the active state @@ -96,7 +97,8 @@ cloudClient <- function(service, authInfo) { # Each redeployment of a static output creates a new application. Since # those applications can be deleted, it's more reliable to reference # outputs by their own id instead of the applications'. - application$content_id <- output$id + application$application_id <- application$id + application$id <- output$id application$url <- output$url application$name <- output$name application @@ -144,7 +146,8 @@ cloudClient <- function(service, authInfo) { output <- POST_JSON(service, authInfo, "/outputs", json) path <- paste("/applications/", output$source_id, sep = "") application <- GET(service, authInfo, path) - application$content_id <- output$id + application$application_id <- application$id + application$id <- output$id # this swaps the "application url" for the "content url". So we end up redirecting to the right spot after deployment. application$url <- output$url application @@ -185,13 +188,13 @@ cloudClient <- function(service, authInfo) { }, createRevision = function(application) { - path <- paste("/outputs/", application$content_id, "/revisions", sep = "") + path <- paste("/outputs/", application$id, "/revisions", sep = "") revision <- POST_JSON(service, authInfo, path, data.frame()) revision$application_id }, deployApplication = function(application, bundleId = NULL) { - path <- paste("/applications/", application$id, "/deploy", sep = "") + path <- paste("/applications/", application$application_id, "/deploy", sep = "") json <- list() if (length(bundleId) > 0 && nzchar(bundleId)) json$bundle <- as.numeric(bundleId) diff --git a/R/client-connect.R b/R/client-connect.R index 7ca4fb14..c54eb31e 100644 --- a/R/client-connect.R +++ b/R/client-connect.R @@ -75,8 +75,8 @@ connectClient <- function(service, authInfo) { ) }, - deployApplication = function(applicationId, bundleId = NULL) { - path <- paste("/applications/", applicationId, "/deploy", sep = "") + deployApplication = function(application, bundleId = NULL) { + path <- paste("/applications/", application$id, "/deploy", sep = "") json <- list() json$bundle <- as.numeric(bundleId) POST_JSON(service, authInfo, path, json) diff --git a/R/client-shinyapps.R b/R/client-shinyapps.R index b79e600e..98d46e55 100644 --- a/R/client-shinyapps.R +++ b/R/client-shinyapps.R @@ -131,8 +131,8 @@ shinyAppsClient <- function(service, authInfo) { ) }, - deployApplication = function(applicationId, bundleId = NULL) { - path <- paste("/applications/", applicationId, "/deploy", sep = "") + deployApplication = function(application, bundleId = NULL) { + path <- paste("/applications/", application$id, "/deploy", sep = "") json <- list() if (length(bundleId) > 0 && nzchar(bundleId)) json$bundle <- as.numeric(bundleId) diff --git a/R/deployApp.R b/R/deployApp.R index 515f6cc8..b4c776b7 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -363,7 +363,7 @@ deployApp <- function(appDir = getwd(), taskComplete(quiet, "Found application {.url {application$url}}") if (application$type == "static") { - application$id <- client$createRevision(application) + application$application_id <- client$createRevision(application) } application @@ -419,7 +419,7 @@ deployApp <- function(appDir = getwd(), # create, and upload the bundle taskStart(quiet, "Uploading bundle...") if (isCloudServer(accountDetails$server)) { - bundle <- uploadCloudBundle(client, application$id, bundlePath) + bundle <- uploadCloudBundle(client, application$application_id, bundlePath) } else { bundle <- client$uploadApplication(application$id, bundlePath) } diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index 94de8540..f3cd85cc 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -77,12 +77,10 @@ deploymentTargetForApp <- function(appId, accountDetails <- findAccount(account, server) application <- getApplication(accountDetails$name, accountDetails$server, appId) - resultAppId <- ifelse(is.null(application$content_id), application$id, application$content_id) - createDeploymentTarget( application$name, application$title %||% appTitle, - resultAppId, + application$id, NULL, application$owner_username, accountDetails$name, diff --git a/R/restartApp.R b/R/restartApp.R index 7477d266..7281c946 100644 --- a/R/restartApp.R +++ b/R/restartApp.R @@ -26,7 +26,7 @@ restartApp <- function(appName, account = NULL, server = NULL, quiet = FALSE) { taskDef$beginStatus <- "Restarting application" taskDef$endStatus <- "Application successfully restarted" taskDef$action <- function(client, application) { - client$deployApplication(application$id) + client$deployApplication(application) } # perform it diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R index 1009a71e..6239b6c2 100644 --- a/tests/testthat/test-client-cloud.R +++ b/tests/testthat/test-client-cloud.R @@ -168,14 +168,14 @@ test_that("Get application", { app <- client$getApplication("10", NA) - expect_equal(app$id, 10) - expect_equal(app$content_id, 5) + expect_equal(app$id, 5) + expect_equal(app$application_id, 10) expect_equal(app$url, "http://fake-url.test.me/") app <- client$getApplication("5", dcfVersion) - expect_equal(app$id, 1) - expect_equal(app$content_id, 5) + expect_equal(app$id, 5) + expect_equal(app$application_id, 1) expect_equal(app$url, "http://fake-url.test.me/") }) @@ -226,14 +226,14 @@ test_that("Get application output trashed", { app <- client$getApplication(10, NA) - expect_equal(app$id, 10) - expect_equal(app$content_id, 5) + expect_equal(app$id, 5) + expect_equal(app$application_id, 10) expect_equal(app$url, "http://fake-url.test.me/") app <- client$getApplication(5, dcfVersion) - expect_equal(app$id, 1) - expect_equal(app$content_id, 5) + expect_equal(app$id, 5) + expect_equal(app$application_id, 1) expect_equal(app$url, "http://fake-url.test.me/") }) @@ -271,8 +271,8 @@ test_that("Create application", { app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static") - expect_equal(app$id, 2) - expect_equal(app$content_id, 1) + expect_equal(app$id, 1) + expect_equal(app$application_id, 2) expect_equal(app$url, "http://fake-url.test.me/") }) @@ -326,8 +326,8 @@ test_that("Create application with linked source project", { app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static") - expect_equal(app$id, 2) - expect_equal(app$content_id, 1) + expect_equal(app$id, 1) + expect_equal(app$application_id, 2) expect_equal(app$url, "http://fake-url.test.me/") }) diff --git a/tests/testthat/test-client-connect.R b/tests/testthat/test-client-connect.R index 3a2999a7..086a7f15 100644 --- a/tests/testthat/test-client-connect.R +++ b/tests/testthat/test-client-connect.R @@ -118,7 +118,7 @@ test_that("Users API", { ## Deploy an application appId <- response$app_id - response <- connect$deployApplication(appId) + response <- connect$deployApplication(list(id = appId)) id <- response$id ## Query the app for success / failure From 61abe5b61c5711c90318b18b61d60e19eff4da31 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 10:46:09 -0500 Subject: [PATCH 20/28] always use application$id in saveDeployment --- R/deployments.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/deployments.R b/R/deployments.R index b44f897d..08214151 100644 --- a/R/deployments.R +++ b/R/deployments.R @@ -89,7 +89,6 @@ saveDeployment <- function(recordDir, hostUrl = serverInfo(target$server)$url, metadata = list(), addToHistory = TRUE) { - appId <- ifelse(target$server == "posit.cloud", application$content_id, application$id) deployment <- deploymentRecord( name = target$appName, title = target$appTitle, @@ -98,7 +97,7 @@ saveDeployment <- function(recordDir, server = target$server, envVars = target$envVars, hostUrl = hostUrl, - appId = appId, + appId = application$id, bundleId = bundleId, url = application$url, metadata = metadata From 30b5d5f3ab24511dea22b5cfe381c1b3db65a4a4 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 12:58:04 -0500 Subject: [PATCH 21/28] update client-cloud.R getApplication with note about when to consider removing backwards compatibility --- R/client-cloud.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 82732dde..e4b1365f 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -69,7 +69,7 @@ cloudClient <- function(service, authInfo) { getApplication = function(outputOrApplicationId, dcfVersion) { if (is.na(dcfVersion)) { # In pre-versioned dcf files, contentOrAppId is the id of the application. - # TODO: remove support for this case + # TODO: consider removing support for this case a year after the release of 0.8.29 path <- paste("/applications/", outputOrApplicationId, sep = "") application <- GET(service, authInfo, path) From de5ad91397e893e60e28c5a1ced5ea045f8aa336 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 1 May 2023 13:17:29 -0500 Subject: [PATCH 22/28] use paste0 instead of paste in cloud-client.R --- R/client-cloud.R | 74 +++++++++++++++++++++++------------------------- 1 file changed, 35 insertions(+), 39 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index e4b1365f..bf1288fd 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -23,7 +23,7 @@ cloudClient <- function(service, authInfo) { getAccountUsage = function(accountId, usageType = "hours", applicationId = NULL, from = NULL, until = NULL, interval = NULL) { - path <- paste("/accounts/", accountId, "/usage/", usageType, "/", sep = "") + path <- paste0("/accounts/", accountId, "/usage/", usageType, "/") query <- list() if (!is.null(applicationId)) query$application <- applicationId @@ -37,12 +37,12 @@ cloudClient <- function(service, authInfo) { }, getBundle = function(bundleId) { - path <- paste("/bundles/", bundleId, sep = "") + path <- paste0("/bundles/", bundleId) GET(service, authInfo, path) }, updateBundleStatus = function(bundleId, status) { - path <- paste("/bundles/", bundleId, "/status", sep = "") + path <- paste0("/bundles/", bundleId, "/status") json <- list() json$status <- status POST_JSON(service, authInfo, path, json) @@ -70,19 +70,19 @@ cloudClient <- function(service, authInfo) { if (is.na(dcfVersion)) { # In pre-versioned dcf files, contentOrAppId is the id of the application. # TODO: consider removing support for this case a year after the release of 0.8.29 - path <- paste("/applications/", outputOrApplicationId, sep = "") + path <- paste0("/applications/", outputOrApplicationId) application <- GET(service, authInfo, path) output_id <- application$output_id %||% application$content_id - path <- paste("/outputs/", output_id, sep = "") + path <- paste0("/outputs/", output_id) output <- GET(service, authInfo, path) } else { # from dcf version >= 1, outputOrApplicationId is the id of the output. - path <- paste("/outputs/", outputOrApplicationId, sep = "") + path <- paste0("/outputs/", outputOrApplicationId) output <- GET(service, authInfo, path) - path <- paste("/applications/", output$source_id, sep = "") + path <- paste0("/applications/", output$source_id) application <- GET(service, authInfo, path) application } @@ -91,7 +91,7 @@ cloudClient <- function(service, authInfo) { if (output$state == "trashed" || output$state == "archived") { json <- list() json$state <- "active" - PATCH_JSON(service, authInfo, paste("/outputs/", output$id, sep = ""), json) + PATCH_JSON(service, authInfo, paste0("/outputs/", output$id), json) } # Each redeployment of a static output creates a new application. Since @@ -105,7 +105,7 @@ cloudClient <- function(service, authInfo) { }, getApplicationMetrics = function(applicationId, series, metrics, from = NULL, until = NULL, interval = NULL) { - path <- paste("/applications/", applicationId, "/metrics/", series, "/", sep = "") + path <- paste0("/applications/", applicationId, "/metrics/", series, "/") query <- list() m <- paste(lapply(metrics, function(x) { paste("metric", urlEncode(x), sep = "=") }), collapse = "&") if (!is.null(from)) @@ -130,21 +130,21 @@ cloudClient <- function(service, authInfo) { currentApplicationId <- Sys.getenv("LUCID_APPLICATION_ID") if (currentApplicationId != "") { - path <- paste("/applications/", currentApplicationId, sep = "") + path <- paste0("/applications/", currentApplicationId) current_application <- GET(service, authInfo, path) project_id <- current_application$content_id # in case the source cloud project is a temporary copy, there is no # content id. The output will be published without a space id. if (!is.null(project_id)) { - path <- paste("/content/", project_id, sep = "") + path <- paste0("/content/", project_id) current_project <- GET(service, authInfo, path) json$project <- current_project$id json$space <- current_project$space_id } } output <- POST_JSON(service, authInfo, "/outputs", json) - path <- paste("/applications/", output$source_id, sep = "") + path <- paste0("/applications/", output$source_id) application <- GET(service, authInfo, path) application$application_id <- application$id application$id <- output$id @@ -154,30 +154,30 @@ cloudClient <- function(service, authInfo) { }, listApplicationProperties = function(applicationId) { - path <- paste("/applications/", applicationId, "/properties/", sep = "") + path <- paste0("/applications/", applicationId, "/properties/") GET(service, authInfo, path) }, setApplicationProperty = function(applicationId, propertyName, propertyValue, force = FALSE) { - path <- paste("/applications/", applicationId, "/properties/", - propertyName, sep = "") + path <- paste0("/applications/", applicationId, "/properties/", + propertyName) v <- list() v$value <- propertyValue - query <- paste("force=", if (force) "1" else "0", sep = "") + query <- paste0("force=", if (force) "1" else "0") PUT_JSON(service, authInfo, path, v, query) }, unsetApplicationProperty = function(applicationId, propertyName, force = FALSE) { - path <- paste("/applications/", applicationId, "/properties/", - propertyName, sep = "") - query <- paste("force=", if (force) "1" else "0", sep = "") + path <- paste0("/applications/", applicationId, "/properties/", + propertyName) + query <- paste0("force=", if (force) "1" else "0") DELETE(service, authInfo, path, query) }, uploadApplication = function(applicationId, bundlePath) { - path <- paste("/applications/", applicationId, "/upload", sep = "") + path <- paste0("/applications/", applicationId, "/upload") POST( service, authInfo, @@ -188,13 +188,13 @@ cloudClient <- function(service, authInfo) { }, createRevision = function(application) { - path <- paste("/outputs/", application$id, "/revisions", sep = "") + path <- paste0("/outputs/", application$id, "/revisions") revision <- POST_JSON(service, authInfo, path, data.frame()) revision$application_id }, deployApplication = function(application, bundleId = NULL) { - path <- paste("/applications/", application$application_id, "/deploy", sep = "") + path <- paste0("/applications/", application$application_id, "/deploy") json <- list() if (length(bundleId) > 0 && nzchar(bundleId)) json$bundle <- as.numeric(bundleId) @@ -204,19 +204,18 @@ cloudClient <- function(service, authInfo) { }, terminateApplication = function(applicationId) { - path <- paste("/applications/", applicationId, "/terminate", sep = "") + path <- paste0("/applications/", applicationId, "/terminate") POST(service, authInfo, path) }, purgeApplication = function(applicationId) { - path <- paste("/applications/", applicationId, "/purge", sep = "") + path <- paste0("/applications/", applicationId, "/purge") POST(service, authInfo, path) }, inviteApplicationUser = function(applicationId, email, invite_email = NULL, invite_email_message = NULL) { - path <- paste("/applications/", applicationId, "/authorization/users", - sep = "") + path <- paste0("/applications/", applicationId, "/authorization/users") json <- list() json$email <- email if (!is.null(invite_email)) @@ -227,32 +226,29 @@ cloudClient <- function(service, authInfo) { }, addApplicationUser = function(applicationId, userId) { - path <- paste("/applications/", applicationId, "/authorization/users/", - userId, sep = "") + path <- paste0("/applications/", applicationId, "/authorization/users/", + userId) PUT(service, authInfo, path, NULL) }, removeApplicationUser = function(applicationId, userId) { - path <- paste("/applications/", applicationId, "/authorization/users/", - userId, sep = "") + path <- paste0("/applications/", applicationId, "/authorization/users/", + userId) DELETE(service, authInfo, path) }, listApplicationAuthorization = function(applicationId) { - path <- paste("/applications/", applicationId, "/authorization", - sep = "") + path <- paste0("/applications/", applicationId, "/authorization") listRequest(service, authInfo, path, NULL, "authorization") }, listApplicationUsers = function(applicationId) { - path <- paste("/applications/", applicationId, "/authorization/users", - sep = "") + path <- paste0("/applications/", applicationId, "/authorization/users") listRequest(service, authInfo, path, NULL, "users") }, listApplicationGroups = function(applicationId) { - path <- paste("/applications/", applicationId, "/authorization/groups", - sep = "") + path <- paste0("/applications/", applicationId, "/authorization/groups") listRequest(service, authInfo, path, NULL, "groups") }, @@ -273,12 +269,12 @@ cloudClient <- function(service, authInfo) { }, getTaskInfo = function(taskId) { - path <- paste("/tasks/", taskId, sep = "") + path <- paste0("/tasks/", taskId) GET(service, authInfo, path) }, getTaskLogs = function(taskId) { - path <- paste("/tasks/", taskId, "/logs/", sep = "") + path <- paste0("/tasks/", taskId, "/logs/") GET(service, authInfo, path) }, @@ -288,7 +284,7 @@ cloudClient <- function(service, authInfo) { cat("Waiting for task: ", taskId, "\n", sep = "") } - path <- paste("/tasks/", taskId, sep = "") + path <- paste0("/tasks/", taskId) lastStatus <- NULL while (TRUE) { From 730a30ca2fcd3bf99b05b4695cb9fa9c23bf29d1 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Tue, 2 May 2023 09:26:54 -0500 Subject: [PATCH 23/28] set default value for dcfFile argument --- R/deploymentTarget.R | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/R/deploymentTarget.R b/R/deploymentTarget.R index f3cd85cc..7f65e2ec 100644 --- a/R/deploymentTarget.R +++ b/R/deploymentTarget.R @@ -47,8 +47,7 @@ deploymentTarget <- function(recordPath = ".", envVars, fullAccount$name, # first deploy must be to own account fullAccount$name, - fullAccount$server, - dcfVersion + fullAccount$server ) } else if (nrow(appDeployments) == 1) { # If both appName and appId supplied, check that they're consistent. @@ -84,8 +83,7 @@ deploymentTargetForApp <- function(appId, NULL, application$owner_username, accountDetails$name, - accountDetails$server, - dcfVersion + accountDetails$server ) } @@ -96,7 +94,7 @@ createDeploymentTarget <- function(appName, username, account, server, - version) { + version = dcfVersion) { list( appName = appName, appTitle = appTitle %||% "", From e01eb2a832806073b3b44ccbf39b4463970a94f1 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Tue, 2 May 2023 09:40:33 -0500 Subject: [PATCH 24/28] add news bullets about DCF version, Cloud appId, and Cloud static content support --- NEWS.md | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/NEWS.md b/NEWS.md index b53a3f46..5be08bea 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,15 @@ # rsconnect (development version) +* `deployDoc()` now includes support for deploying static content to Posit + Cloud. + +* For cloud deployments, appId now represents the content id (as seen in URLs + of the format `https://posit.cloud/content/{id}`) instead of the application + id. + +* A `version` field has been added to deployment DCF files to facilitate file + format changes. Its value for this release is `1`. + * `deployApp()` gains a new `envVars` argument which takes a vector of the names of environment variables that should be securely copied to the server. The names (not values) of these environment variables are also saved in the From ab98e61f847aaac3e27f3905b8453c0f28cca891 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Tue, 2 May 2023 10:41:17 -0500 Subject: [PATCH 25/28] state that deployApp also supports cloud static content in news bullet --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 8aaaef21..cffea4c1 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # rsconnect (development version) -* `deployDoc()` now includes support for deploying static content to Posit +* `deployDoc()` and `deployApp()` now support deploying static content to Posit Cloud. * For cloud deployments, appId now represents the content id (as seen in URLs From 4fc6ee9ff609480bc7c98732dffb91b4a1783c40 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Wed, 3 May 2023 09:59:37 -0500 Subject: [PATCH 26/28] correct variable name on comment explaining outputOrApplicationId --- R/client-cloud.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index c15ed4ee..4b4ad333 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -68,8 +68,8 @@ cloudClient <- function(service, authInfo) { getApplication = function(outputOrApplicationId, deploymentRecordVersion) { if (is.na(deploymentRecordVersion)) { - # In pre-versioned dcf files, contentOrAppId is the id of the application. - # TODO: consider removing support for this case a year after the release of 0.8.29 + # In pre-versioned dcf files, outputOrApplicationId is the id of the application. + # TODO: consider removing support for this case a year after the release of 0.8.30 path <- paste0("/applications/", outputOrApplicationId) application <- GET(service, authInfo, path) From dfe32845c08ac7ac700c6f07eb6dbdf924fe2975 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 8 May 2023 14:05:54 -0500 Subject: [PATCH 27/28] make news bullet about appId change more comprehensible to non-Posit readers --- NEWS.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 1f87c6d4..4baaaf02 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,9 +3,9 @@ * `deployDoc()` and `deployApp()` now support deploying static content to Posit Cloud. -* For cloud deployments, appId now represents the content id (as seen in URLs - of the format `https://posit.cloud/content/{id}`) instead of the application - id. +* When recording details about deployments to Posit Cloud, appId now represents + the content id (as seen in URLs of the format + `https://posit.cloud/content/{id}`) instead of the application id. * A `version` field has been added to deployment DCF files to facilitate file format changes. Its value for this release is `1`. From 75b39cda68bad0c4c1e368671df5863f8f87fdd6 Mon Sep 17 00:00:00 2001 From: Matthew Lynch Date: Mon, 8 May 2023 14:06:15 -0500 Subject: [PATCH 28/28] update TODO with correct version of next release --- R/client-cloud.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/client-cloud.R b/R/client-cloud.R index 4b4ad333..9ecd6bc5 100644 --- a/R/client-cloud.R +++ b/R/client-cloud.R @@ -69,7 +69,7 @@ cloudClient <- function(service, authInfo) { getApplication = function(outputOrApplicationId, deploymentRecordVersion) { if (is.na(deploymentRecordVersion)) { # In pre-versioned dcf files, outputOrApplicationId is the id of the application. - # TODO: consider removing support for this case a year after the release of 0.8.30 + # TODO: consider removing support for this case a year after the release of 1.0.0 path <- paste0("/applications/", outputOrApplicationId) application <- GET(service, authInfo, path)