add space parameter for Posit Cloud

NEWS.md

@@ -1,5 +1,7 @@
 # rsconnect (development version)
 
+* Added `space` parameter to deploy directly to a space in Posit Cloud.
+
 * Fixed analysis of directories that were smaller than the
   `rsconnect.max.bundle.files=10000` limit but larger than the
   `renv.config.dependencies.limit=1000` limit. (#968)

R/client-cloud.R

@@ -161,23 +161,27 @@ cloudClient <- function(service, authInfo) {
       GET(service, authInfo, path, query)
     },
 
-    createApplication = function(name, title, template, accountId, appMode) {
+    createApplication = function(name, title, template, accountId, appMode, spaceId = NULL) {
       json <- list()
       json$name <- name
       json$application_type <- if (appMode %in% c("rmd-static", "quarto-static", "static")) "static" else "connect"
       if (appMode %in% c("rmd-static", "quarto-static")) {
         json$render_by <- "server"
       }
 
-      currentProjectId <- getCurrentProjectId(service, authInfo)
-      # 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(currentProjectId)) {
-        json$project <- currentProjectId
+      if (is.null(spaceId)) {
+        currentProjectId <- getCurrentProjectId(service, authInfo)
+        # 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(currentProjectId)) {
+          json$project <- currentProjectId
 
-        path <- paste0("/content/", currentProjectId)
-        currentProject <- GET(service, authInfo, path)
-        json$space <- currentProject$space_id
+          path <- paste0("/content/", currentProjectId)
+          currentProject <- GET(service, authInfo, path)
+          json$space <- currentProject$space_id
+        }
+      } else {
+        json$space <- spaceId
       }
 
       output <- POST_JSON(service, authInfo, "/outputs", json)
@@ -230,12 +234,21 @@ cloudClient <- function(service, authInfo) {
         revision$application_id
     },
 
-    deployApplication = function(application, bundleId = NULL) {
+    deployApplication = function(application, bundleId = NULL, spaceId = NULL) {
+      outputPatchData <- list()
+
       currentProjectId <- getCurrentProjectId(service, authInfo)
       if (!is.null(currentProjectId)) {
+        outputPatchData$project <- currentProjectId
+      }
+
+      if (!is.null(spaceId)) {
+        outputPatchData$space <- spaceId
+      }
+
+      if (length(outputPatchData) > 0) {
         path <- paste0("/outputs/", application$id)
-        json <- list(project = currentProjectId)
-        PATCH_JSON(service, authInfo, path, json)
+        PATCH_JSON(service, authInfo, path, outputPatchData)
       }
 
       path <- paste0("/applications/", application$application_id, "/deploy")

R/client-shinyapps.R

@@ -90,7 +90,7 @@ shinyAppsClient <- function(service, authInfo) {
       GET(service, authInfo, path, query)
     },
 
-    createApplication = function(name, title, template, accountId, appMode) {
+    createApplication = function(name, title, template, accountId, appMode, spaceId) {
       json <- list()
       json$name <- name
       # the title field is only used on connect

R/deployApp.R

@@ -142,6 +142,10 @@
 #' @param image Optional. The name of the image to use when building and
 #'   executing this content. If none is provided, Posit Connect will
 #'   attempt to choose an image based on the content requirements.
+#' @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{
 #'
@@ -197,7 +201,8 @@ deployApp <- function(appDir = getwd(),
                       forceGeneratePythonEnvironment = FALSE,
                       quarto = NA,
                       appVisibility = NULL,
-                      image = NULL
+                      image = NULL,
+                      space = NULL
                       ) {
 
   check_string(appDir)
@@ -365,7 +370,8 @@ deployApp <- function(appDir = getwd(),
       target$appTitle,
       "shiny",
       accountDetails$accountId,
-      appMetadata$appMode
+      appMetadata$appMode,
+      space
     )
     taskComplete(quiet, "Created application with id {.val {application$id}}")
   } else {
@@ -453,7 +459,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)

tests/testthat/test-client-cloud.R

@@ -303,6 +303,50 @@ 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
+        )
+      })
+  ))
+
+  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?", "shiny", 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(
@@ -408,6 +452,7 @@ test_that("deployApplication updates the parent project", {
       content = function(methodAndPath, match, contentFile, ...) {
         content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
         expect_equal(content$project, 41)
+        expect_equal(content$space, 333)
         list(
           "id" = 41
         )
@@ -442,7 +487,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", {