Merge pull request #983 from rstudio/space-parameter

add space parameter for Posit Cloud
rstudio · Sep 12, 2023 · 21b1f53 · 21b1f53
2 parents 3e96601 + ab46dd1
commit 21b1f53
Show file tree

Hide file tree

Showing 7 changed files with 92 additions and 35 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,7 @@
 # rsconnect (development version)
 
+* Added `space` parameter to deploy directly to a space in Posit Cloud.
+
 # rsconnect 1.1.0
 
 * Fixed analysis of directories that were smaller than the

diff --git a/R/client-cloud.R b/R/client-cloud.R
@@ -161,7 +161,7 @@ cloudClient <- function(service, authInfo) {
       GET(service, authInfo, path, query)
     },
 
-    createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL) {
+    createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL, spaceId = NULL) {
       json <- list()
       json$name <- name
       json$application_type <- if (appMode %in% c("rmd-static", "quarto-static", "static")) "static" else "connect"
@@ -182,6 +182,10 @@ cloudClient <- function(service, authInfo) {
 
       json$content_category <- contentCategory
 
+      if (is.null(currentProjectId) && !is.null(spaceId)) {
+        json$space <- spaceId
+      }
+
       output <- POST_JSON(service, authInfo, "/outputs", json)
       path <- paste0("/applications/", output$source_id)
       application <- GET(service, authInfo, path)
@@ -233,12 +237,14 @@ cloudClient <- function(service, authInfo) {
         revision$application_id
     },
 
-    deployApplication = function(application, bundleId = NULL) {
+    deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
       currentProjectId <- getCurrentProjectId(service, authInfo)
       if (!is.null(currentProjectId)) {
-        path <- paste0("/outputs/", application$id)
-        json <- list(project = currentProjectId)
-        PATCH_JSON(service, authInfo, path, json)
+        PATCH_JSON(service, authInfo, paste0("/outputs/", application$id), list(project = currentProjectId))
+      }
+
+      if (!is.null(spaceId)) {
+        PATCH_JSON(service, authInfo, paste0("/outputs/", application$id), list(space = spaceId))
       }
 
       path <- paste0("/applications/", application$application_id, "/deploy")

diff --git a/R/client-connect.R b/R/client-connect.R
@@ -48,7 +48,7 @@ connectClient <- function(service, authInfo) {
       listApplicationsRequest(service, authInfo, path, query, "applications")
     },
 
-    createApplication = function(name, title, template, accountId, appMode, contentCategory) {
+    createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL, spaceId = NULL) {
       # add name; inject title if specified
       details <- list(name = name)
       if (!is.null(title) && nzchar(title))
@@ -80,7 +80,7 @@ connectClient <- function(service, authInfo) {
       )
     },
 
-    deployApplication = function(application, bundleId = NULL) {
+    deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
       path <- paste("/applications/", application$id, "/deploy", sep = "")
       json <- list()
       json$bundle <- as.numeric(bundleId)

diff --git a/R/client-shinyapps.R b/R/client-shinyapps.R
@@ -90,7 +90,7 @@ shinyAppsClient <- function(service, authInfo) {
       GET(service, authInfo, path, query)
     },
 
-    createApplication = function(name, title, template, accountId, appMode, contentCategory) {
+    createApplication = function(name, title, template, accountId, appMode, contentCategory = NULL, spaceId = NULL) {
       json <- list()
       json$name <- name
       # the title field is only used on connect
@@ -138,7 +138,7 @@ shinyAppsClient <- function(service, authInfo) {
       )
     },
 
-    deployApplication = function(application, bundleId = NULL) {
+    deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
       path <- paste("/applications/", application$id, "/deploy", sep = "")
       json <- list()
       if (length(bundleId) > 0 && nzchar(bundleId))

diff --git a/R/deployApp.R b/R/deployApp.R
@@ -165,6 +165,10 @@
 #'   server default if no application default is defined.
 #'
 #'   (This option is ignored when `envManagement` is non-`NULL`.)
+#' @param space Optional. For Posit Cloud, the id of the space where the content
+#'   should be deployed. If none is provided, content will be deployed to the
+#'   deploying user's workspace or deployed to the same space in case of
+#'   redeploy.
 #' @examples
 #' \dontrun{
 #'
@@ -223,7 +227,8 @@ deployApp <- function(appDir = getwd(),
                       image = NULL,
                       envManagement = NULL,
                       envManagementR = NULL,
-                      envManagementPy = NULL
+                      envManagementPy = NULL,
+                      space = NULL
                       ) {
 
   check_string(appDir)
@@ -392,7 +397,8 @@ deployApp <- function(appDir = getwd(),
       "shiny",
       accountDetails$accountId,
       appMetadata$appMode,
-      contentCategory
+      contentCategory,
+      space
     )
     taskComplete(quiet, "Created application with id {.val {application$id}}")
   } else {
@@ -483,7 +489,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, space)
   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/man/deployApp.Rd b/man/deployApp.Rd
diff --git a/tests/testthat/test-client-cloud.R b/tests/testthat/test-client-cloud.R
@@ -171,8 +171,7 @@ test_that("Get application", {
     )
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   fakeService <- list(
     protocol = "test",
@@ -237,8 +236,7 @@ test_that("Get application output trashed", {
     )
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   fakeService <- list(
     protocol = "test",
@@ -286,8 +284,7 @@ test_that("Create application", {
       })
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   fakeService <- list(
     protocol = "test",
@@ -303,6 +300,49 @@ test_that("Create application", {
   expect_equal(app$url, "http://fake-url.test.me/")
 })
 
+test_that("Create application with space id", {
+  mockServer <- mockServerFactory(list(
+    "^POST /outputs" = list(
+      content = function(methodAndPath, match, contentFile, ...) {
+        content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
+        expect_equal(content$application_type, "connect")
+        expect_equal(content$space, 333)
+        list(
+          "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]
+        application_id <- strtoi(substr(methodAndPath, match[2], end))
+
+        list(
+          "id" = application_id,
+          "content_id" = 1
+        )
+      })
+  ))
+
+  withr::local_options(rsconnect.http = mockServer$impl)
+
+  fakeService <- list(
+    protocol = "test",
+    host = "unit-test",
+    port = 42
+  )
+  client <- cloudClient(fakeService, NULL)
+
+  app <- client$createApplication("test app", "unused?", "unused?", "unused?", "shiny", spaceId = 333)
+
+  expect_equal(app$id, 1)
+  expect_equal(app$application_id, 2)
+  expect_equal(app$url, "http://fake-url.test.me/")
+})
+
 test_that("Create static application", {
   mockServer <- mockServerFactory(list(
     "^POST /outputs" = list(
@@ -330,8 +370,7 @@ test_that("Create static application", {
       })
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   fakeService <- list(
     protocol = "test",
@@ -375,8 +414,7 @@ test_that("Create static server-side-rendered application", {
       })
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   fakeService <- list(
     protocol = "test",
@@ -409,7 +447,11 @@ test_that("deployApplication updates the parent project", {
     "^PATCH /outputs" = list(
       content = function(methodAndPath, match, contentFile, ...) {
         content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
-        expect_equal(content$project, 41)
+        if (!is.null(content$project)) {
+          expect_equal(content$project, 41)
+        } else {
+          expect_equal(content$space, 333)
+        }
         list(
           "id" = 41
         )
@@ -444,7 +486,7 @@ test_that("deployApplication updates the parent project", {
     "id" = 100,
     "application_id" = 101
   )
-  client$deployApplication(application)
+  client$deployApplication(application, spaceId = 333)
 })
 
 test_that("Create static RMD application", {
@@ -475,8 +517,7 @@ test_that("Create static RMD application", {
       })
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   fakeService <- list(
     protocol = "test",
@@ -527,8 +568,7 @@ test_that("Create application with linked source project", {
     )
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   Sys.setenv(LUCID_APPLICATION_ID = "42")
   withr::defer(Sys.unsetenv("LUCID_APPLICATION_ID"))
@@ -576,8 +616,7 @@ test_that("deploymentTargetForApp() results in correct Cloud API calls", {
     )
   ))
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   testAccount <- configureTestAccount()
   withr::defer(removeAccount(testAccount))
@@ -760,8 +799,7 @@ test_that("deployApp() for shiny results in correct Cloud API calls", {
   mock <- deployAppMockServerFactory(expectedAppType = "connect", outputState = "active")
   mockServer <- mock$server
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   testAccount <- configureTestAccount()
   withr::defer(removeAccount(testAccount))
@@ -854,8 +892,7 @@ test_that("deployDoc() results in correct Cloud API calls", {
   mock <- deployAppMockServerFactory(expectedAppType = "static", outputState = "active")
   mockServer <- mock$server
 
-  restoreOpt <- options(rsconnect.http = mockServer$impl)
-  withr::defer(options(restoreOpt))
+  withr::local_options(rsconnect.http = mockServer$impl)
 
   testAccount <- configureTestAccount()
   withr::defer(removeAccount(testAccount))