diff --git a/NAMESPACE b/NAMESPACE index 280adeec..a73f7e89 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,13 +1,55 @@ # Generated by roxygen2: do not edit by hand +S3method(addsUtmParameters,connectClient) +S3method(addsUtmParameters,connectCloudClient) +S3method(addsUtmParameters,shinyAppsClient) S3method(as.data.frame,rsconnect_secret) S3method(format,rsconnect_secret) S3method(print,linterResults) S3method(print,rsconnect_secret) +S3method(pythonEnabledByDefault,connectClient) +S3method(pythonEnabledByDefault,connectCloudClient) +S3method(pythonEnabledByDefault,shinyAppsClient) +S3method(redactsUserEmails,connectClient) +S3method(redactsUserEmails,connectCloudClient) +S3method(redactsUserEmails,shinyAppsClient) +S3method(requiresUpload,connectClient) +S3method(requiresUpload,connectCloudClient) +S3method(requiresUpload,shinyAppsClient) +S3method(serverDisplayName,connectClient) +S3method(serverDisplayName,connectCloudClient) +S3method(serverDisplayName,shinyAppsClient) +S3method(staticRmdNeedsShiny,connectClient) +S3method(staticRmdNeedsShiny,connectCloudClient) +S3method(staticRmdNeedsShiny,shinyAppsClient) S3method(str,rsconnect_secret) +S3method(supportsEnvVarManagement,connectClient) +S3method(supportsEnvVarManagement,connectCloudClient) +S3method(supportsEnvVarManagement,shinyAppsClient) +S3method(supportsEnvVars,connectClient) +S3method(supportsEnvVars,connectCloudClient) +S3method(supportsEnvVars,shinyAppsClient) +S3method(supportsMetadataSync,connectClient) +S3method(supportsMetadataSync,connectCloudClient) +S3method(supportsMetadataSync,shinyAppsClient) +S3method(supportsNodejs,connectClient) +S3method(supportsNodejs,connectCloudClient) +S3method(supportsNodejs,shinyAppsClient) +S3method(supportsOptionalInviteEmail,connectClient) +S3method(supportsOptionalInviteEmail,connectCloudClient) +S3method(supportsOptionalInviteEmail,shinyAppsClient) +S3method(supportsUserManagement,connectClient) +S3method(supportsUserManagement,connectCloudClient) +S3method(supportsUserManagement,shinyAppsClient) +S3method(supportsVisibility,connectClient) +S3method(supportsVisibility,connectCloudClient) +S3method(supportsVisibility,shinyAppsClient) S3method(uploadBundle,connectClient) S3method(uploadBundle,connectCloudClient) S3method(uploadBundle,shinyAppsClient) +S3method(usesPasswordFile,connectClient) +S3method(usesPasswordFile,connectCloudClient) +S3method(usesPasswordFile,shinyAppsClient) export(accountInfo) export(accountUsage) export(accounts) diff --git a/R/appMetadata.R b/R/appMetadata.R index 44e6e523..3257037f 100644 --- a/R/appMetadata.R +++ b/R/appMetadata.R @@ -5,7 +5,7 @@ appMetadata <- function( quarto = NA, appMode = NULL, contentCategory = NULL, - isShinyappsServer = FALSE, + staticRmdNeedsShiny = FALSE, metadata = list() ) { check_bool(quarto, allow_na = TRUE) @@ -35,7 +35,7 @@ appMetadata <- function( appDir, appFiles, usesQuarto = quarto, - isShinyappsServer = isShinyappsServer + staticRmdNeedsShiny = staticRmdNeedsShiny ) appMode <- appModeResult$appMode inferredPrimaryFile <- appModeResult$primaryFile @@ -50,7 +50,7 @@ appMetadata <- function( appDir, appFiles, usesQuarto = quarto, - isShinyappsServer = isShinyappsServer + staticRmdNeedsShiny = staticRmdNeedsShiny )$primaryFile } @@ -136,7 +136,7 @@ inferAppMode <- function( appDir, appFiles, usesQuarto = NA, - isShinyappsServer = FALSE + staticRmdNeedsShiny = FALSE ) { rootFiles <- appFiles[dirname(appFiles) == "."] absoluteRootFiles <- file.path(appDir, rootFiles) @@ -236,9 +236,9 @@ inferAppMode <- function( primaryFile = basename(primaryDocFile) )) } else { - # For shinyapps.io, treat "rmd-static" app mode as "rmd-shiny" so that - # it can be served from a shiny process in Connect - if (isShinyappsServer) { + # Some servers can only serve R Markdown from a Shiny process, so they + # get "rmd-shiny" in place of "rmd-static". + if (staticRmdNeedsShiny) { return(list( appMode = "rmd-shiny", primaryFile = basename(primaryDocFile) diff --git a/R/applications.R b/R/applications.R index 39dcbd28..c4adedee 100644 --- a/R/applications.R +++ b/R/applications.R @@ -403,15 +403,16 @@ syncAppMetadata <- function(appPath = ".") { for (i in seq_len(nrow(deploys))) { curDeploy <- deploys[i, ] - # don't sync if published to RPubs or Connect Cloud + # RPubs has no client, so check it before the client is created if (isRPubs(curDeploy$server)) { next - } else if (isPositConnectCloudServer(curDeploy$server)) { - next } account <- accountInfo(curDeploy$account, curDeploy$server) client <- clientForAccount(account) + if (!supportsMetadataSync(client)) { + next + } application <- tryCatch( client$getApplication(curDeploy$appId), diff --git a/R/auth.R b/R/auth.R index 8e42fd2c..2b64c857 100644 --- a/R/auth.R +++ b/R/auth.R @@ -118,6 +118,15 @@ cleanupPasswordFile <- function(appDir) { invisible(TRUE) } +checkSupportsUserManagement <- function(client, call = caller_env()) { + if (!supportsUserManagement(client)) { + cli::cli_abort( + "rsconnect can't manage application users on {serverDisplayName(client)}.", + call = call + ) + } +} + # Internal: resolve the target content for collaborator management functions. # On PCC, an explicit contentId targets the content directly; otherwise reads # the local deployment record to get the content id (appId) rather than matching @@ -214,9 +223,8 @@ addAuthorizedUser <- function( emailMessage = NULL ) { accountDetails <- accountInfo(account, server) - if (!isPositConnectCloudServer(accountDetails$server)) { - checkShinyappsServer(accountDetails$server) - } + api <- clientForAccount(accountDetails) + checkSupportsUserManagement(api) application <- resolveContentTarget( accountDetails, @@ -225,23 +233,18 @@ addAuthorizedUser <- function( contentId ) - # check for and remove password file (shinyapps.io only; PCC has no password file) - if (!isPositConnectCloudServer(accountDetails$server)) { + if (usesPasswordFile(api)) { cleanupPasswordFile(appDir) } - # PCC always emails invitees; warn only when caller explicitly opts out - if ( - isPositConnectCloudServer(accountDetails$server) && - identical(sendEmail, FALSE) - ) { + # Warn only when the caller explicitly opts out of the email. + if (!supportsOptionalInviteEmail(api) && identical(sendEmail, FALSE)) { cli::cli_warn( - "{.arg sendEmail} is ignored on Posit Connect Cloud; PCC always sends an invitation email." + "{.arg sendEmail} is ignored on {serverDisplayName(api)}, which always sends an invitation email." ) } # fetch authorization list - api <- clientForAccount(accountDetails) api$inviteApplicationUser( application$id, validateEmail(email), @@ -290,9 +293,8 @@ removeAuthorizedUser <- function( server = NULL ) { accountDetails <- accountInfo(account, server) - if (!isPositConnectCloudServer(accountDetails$server)) { - checkShinyappsServer(accountDetails$server) - } + api <- clientForAccount(accountDetails) + checkSupportsUserManagement(api) application <- resolveContentTarget( accountDetails, @@ -301,8 +303,7 @@ removeAuthorizedUser <- function( contentId ) - # check and remove password file (shinyapps.io only; PCC has no password file) - if (!isPositConnectCloudServer(accountDetails$server)) { + if (usesPasswordFile(api)) { cleanupPasswordFile(appDir) } @@ -310,7 +311,6 @@ removeAuthorizedUser <- function( # resolveContentTarget() a second time (a second interactive prompt could # return a different record, causing removeApplicationUser to act on the # wrong content). - api <- clientForAccount(accountDetails) users <- showUsers_impl( api, application$id, @@ -325,15 +325,13 @@ removeAuthorizedUser <- function( } else if (user %in% users$email) { user <- users[which(users$email == user), ] } else { - # Only PCC redacts emails, and the hint only helps someone who searched by - # email (an id-based lookup already avoids the problem). - redactionHint <- - isPositConnectCloudServer(accountDetails$server) && - grepl("@", user, fixed = TRUE) + # The hint only helps someone who searched by email. A lookup by id is not + # affected by redaction. + redactionHint <- redactsUserEmails(api) && grepl("@", user, fixed = TRUE) cli::cli_abort(c( "User {.val {user}} not found.", i = if (redactionHint) { - "On Posit Connect Cloud an email can be redacted and won't match; pass the user id from {.fn showUsers} instead." + "On {serverDisplayName(api)} an email can be redacted and won't match; pass the user id from {.fn showUsers} instead." } )) } @@ -393,9 +391,8 @@ showUsers <- function( server = NULL ) { accountDetails <- accountInfo(account, server) - if (!isPositConnectCloudServer(accountDetails$server)) { - checkShinyappsServer(accountDetails$server) - } + api <- clientForAccount(accountDetails) + checkSupportsUserManagement(api) application <- resolveContentTarget( accountDetails, @@ -404,7 +401,6 @@ showUsers <- function( contentId ) - api <- clientForAccount(accountDetails) showUsers_impl( api, application$id, @@ -449,9 +445,8 @@ showInvited <- function( server = NULL ) { accountDetails <- accountInfo(account, server) - if (!isPositConnectCloudServer(accountDetails$server)) { - checkShinyappsServer(accountDetails$server) - } + api <- clientForAccount(accountDetails) + checkSupportsUserManagement(api) application <- resolveContentTarget( accountDetails, @@ -460,7 +455,6 @@ showInvited <- function( contentId ) - api <- clientForAccount(accountDetails) showInvited_impl(api, application$id) } @@ -505,9 +499,8 @@ resendInvitation <- function( server = NULL ) { accountDetails <- accountInfo(account, server) - if (!isPositConnectCloudServer(accountDetails$server)) { - checkShinyappsServer(accountDetails$server) - } + api <- clientForAccount(accountDetails) + checkSupportsUserManagement(api) # resolve content exactly once, then fetch invitations via impl (avoids a # second resolveContentTarget() call). @@ -517,7 +510,6 @@ resendInvitation <- function( appName, contentId ) - api <- clientForAccount(accountDetails) invited <- showInvited_impl(api, application$id) invite <- as.character(invite) diff --git a/R/bundlePython.R b/R/bundlePython.R index 9070402e..ac116562 100644 --- a/R/bundlePython.R +++ b/R/bundlePython.R @@ -24,10 +24,11 @@ pythonConfigurator <- function(python, forceGenerate = FALSE) { } } -# python is enabled on Connect, but not on Shinyapps -getPythonForTarget <- function(path, accountDetails) { - targetIsShinyapps <- isShinyappsServer(accountDetails$server) - pythonEnabled <- getOption("rsconnect.python.enabled", !targetIsShinyapps) +getPythonForTarget <- function(path, client) { + pythonEnabled <- getOption( + "rsconnect.python.enabled", + pythonEnabledByDefault(client) + ) if (pythonEnabled) { getPython(path) } else { diff --git a/R/client-connect.R b/R/client-connect.R index 736c71e3..ec17d566 100644 --- a/R/client-connect.R +++ b/R/client-connect.R @@ -1,11 +1,5 @@ # Docs: https://docs.posit.co/connect/api/ -stripConnectTimestamps <- function(messages) { - # Strip timestamps, if found - timestamp_re <- "^\\d{4}/\\d{2}/\\d{2} \\d{2}:\\d{2}:\\d{2}\\.\\d{3,} " - gsub(timestamp_re, "", messages) -} - connectClient <- function(service, authInfo) { self <- list( # The connection identity. Methods read these to make requests. @@ -172,6 +166,78 @@ uploadBundle.connectClient <- function(client, application, bundlePath) { ) } +#' @export +serverDisplayName.connectClient <- function(client) { + "Posit Connect" +} + +#' @export +supportsEnvVars.connectClient <- function(client) { + TRUE +} + +#' @export +supportsEnvVarManagement.connectClient <- function(client) { + TRUE +} + +# Connect needs a minimum version for Node.js content, which +# `checkConnectSupportsNodejs()` checks. +#' @export +supportsNodejs.connectClient <- function(client) { + TRUE +} + +#' @export +supportsUserManagement.connectClient <- function(client) { + FALSE +} + +#' @export +usesPasswordFile.connectClient <- function(client) { + FALSE +} + +#' @export +supportsOptionalInviteEmail.connectClient <- function(client) { + FALSE +} + +#' @export +redactsUserEmails.connectClient <- function(client) { + FALSE +} + +#' @export +requiresUpload.connectClient <- function(client) { + TRUE +} + +#' @export +pythonEnabledByDefault.connectClient <- function(client) { + TRUE +} + +#' @export +supportsVisibility.connectClient <- function(client) { + FALSE +} + +#' @export +supportsMetadataSync.connectClient <- function(client) { + TRUE +} + +#' @export +staticRmdNeedsShiny.connectClient <- function(client) { + FALSE +} + +#' @export +addsUtmParameters.connectClient <- function(client) { + FALSE +} + getSnowflakeAuthToken <- function(url, snowflakeConnectionName) { parsedURL <- parseHttpUrl(url) ingressURL <- parsedURL$host @@ -260,3 +326,9 @@ connectDashboardUrl <- function(serverUrl, contentGuid) { prefix <- sub("/__api__$", "", serverUrl) paste(prefix, "connect/#/apps", contentGuid, sep = "/") } + +stripConnectTimestamps <- function(messages) { + # Strip timestamps, if found + timestamp_re <- "^\\d{4}/\\d{2}/\\d{2} \\d{2}:\\d{2}:\\d{2}\\.\\d{3,} " + gsub(timestamp_re, "", messages) +} diff --git a/R/client-connectCloud.R b/R/client-connectCloud.R index ecc98426..d821c249 100644 --- a/R/client-connectCloud.R +++ b/R/client-connectCloud.R @@ -1,85 +1,5 @@ # Docs: https://posit-hosted.github.io/vivid-api -# Resolves the browsable URL for `contentId`, based on the account it -# actually belongs to (`accountId`) rather than the caller's own account -- -# necessary because content may belong to a different (e.g. team) account -# than the one authenticating the request. `getAccounts` is a zero-arg -# function returning the accounts the caller has a role on (shared by -# `connectCloudClient()$getAccounts` and `migrateToConnectCloud()`). -connectCloudContentUrl <- function(getAccounts, accountId, contentId) { - ownerAccount <- Find( - function(a) identical(a$id, accountId), - getAccounts()$data - ) - if (is.null(ownerAccount)) { - cli::cli_abort( - c( - "Unable to determine the Connect Cloud account for content {.val {contentId}}.", - i = "You may not have access to the account this content belongs to." - ) - ) - } - paste0(connectCloudUrls()$ui, "/", ownerAccount$name, "/content/", contentId) -} - -# Standalone (served) content URL -- the link handed to app consumers, and the -# value returned in the `url` column of `applications()`. Consistent with the -# served URL that shinyapps.io and Posit Connect report. The canonical scheme is -# .share. (e.g. -# https://abc-123.share.connect.posit.cloud/). Derived from the UI base so it -# tracks the active environment (production/staging/development). -connectCloudStandaloneUrl <- function(contentId) { - host <- sub("^https?://", "", connectCloudUrls()$ui) - paste0("https://", contentId, ".share.", host, "/") -} - -# Map rsconnect appMode to Connect Cloud contentType -cloudContentTypeFromAppMode <- function(appMode) { - switch( - appMode, - "jupyter-notebook" = "jupyter", - "python-bokeh" = "bokeh", - "python-dash" = "dash", - "python-shiny" = "shiny", - "shiny" = "shiny", - "python-streamlit" = "streamlit", - "quarto" = "quarto", - "quarto-static" = "quarto", - "quarto-shiny" = "quarto", - "rmd-static" = "rmarkdown", - "rmd-shiny" = "rmarkdown", - "static" = "static", - stop( - "appMode '", - appMode, - "' is not supported by Connect Cloud", - call. = FALSE - ) - ) -} - -cloudSecrets <- function(envVars) { - if (length(envVars) == 0L) { - return(I(list())) - } - values <- Sys.getenv(envVars, unset = NA) - keep <- !is.na(values) - if (!any(keep)) { - return(I(list())) - } - - unname(Map( - function(name, value) { - list( - name = name, - value = value - ) - }, - envVars[keep], - values[keep] - )) -} - # Creates a client for interacting with the Connect Cloud API. connectCloudClient <- function(service, authInfo) { # Generic retry wrapper. If a request fails with 401 Unauthorized, it will @@ -552,3 +472,155 @@ uploadBundle.connectCloudClient <- function(client, application, bundlePath) { # Connect Cloud has no bundle id, so the deploy template gets NULL here. NULL } + +#' @export +serverDisplayName.connectCloudClient <- function(client) { + "Posit Connect Cloud" +} + +#' @export +supportsEnvVars.connectCloudClient <- function(client) { + TRUE +} + +#' @export +supportsEnvVarManagement.connectCloudClient <- function(client) { + FALSE +} + +#' @export +supportsNodejs.connectCloudClient <- function(client) { + FALSE +} + +#' @export +supportsUserManagement.connectCloudClient <- function(client) { + TRUE +} + +#' @export +usesPasswordFile.connectCloudClient <- function(client) { + FALSE +} + +# Connect Cloud always sends the invitation email. +#' @export +supportsOptionalInviteEmail.connectCloudClient <- function(client) { + FALSE +} + +# Connect Cloud can return a user record with a redacted email. +#' @export +redactsUserEmails.connectCloudClient <- function(client) { + TRUE +} + +#' @export +requiresUpload.connectCloudClient <- function(client) { + FALSE +} + +#' @export +pythonEnabledByDefault.connectCloudClient <- function(client) { + TRUE +} + +#' @export +supportsVisibility.connectCloudClient <- function(client) { + FALSE +} + +#' @export +supportsMetadataSync.connectCloudClient <- function(client) { + FALSE +} + +#' @export +staticRmdNeedsShiny.connectCloudClient <- function(client) { + FALSE +} + +#' @export +addsUtmParameters.connectCloudClient <- function(client) { + TRUE +} + +# Resolves the browsable URL for `contentId`, based on the account it +# actually belongs to (`accountId`) rather than the caller's own account -- +# necessary because content may belong to a different (e.g. team) account +# than the one authenticating the request. `getAccounts` is a zero-arg +# function returning the accounts the caller has a role on (shared by +# `connectCloudClient()$getAccounts` and `migrateToConnectCloud()`). +connectCloudContentUrl <- function(getAccounts, accountId, contentId) { + ownerAccount <- Find( + function(a) identical(a$id, accountId), + getAccounts()$data + ) + if (is.null(ownerAccount)) { + cli::cli_abort( + c( + "Unable to determine the Connect Cloud account for content {.val {contentId}}.", + i = "You may not have access to the account this content belongs to." + ) + ) + } + paste0(connectCloudUrls()$ui, "/", ownerAccount$name, "/content/", contentId) +} + +# Standalone (served) content URL -- the link handed to app consumers, and the +# value returned in the `url` column of `applications()`. Consistent with the +# served URL that shinyapps.io and Posit Connect report. The canonical scheme is +# .share. (e.g. +# https://abc-123.share.connect.posit.cloud/). Derived from the UI base so it +# tracks the active environment (production/staging/development). +connectCloudStandaloneUrl <- function(contentId) { + host <- sub("^https?://", "", connectCloudUrls()$ui) + paste0("https://", contentId, ".share.", host, "/") +} + +# Map rsconnect appMode to Connect Cloud contentType +cloudContentTypeFromAppMode <- function(appMode) { + switch( + appMode, + "jupyter-notebook" = "jupyter", + "python-bokeh" = "bokeh", + "python-dash" = "dash", + "python-shiny" = "shiny", + "shiny" = "shiny", + "python-streamlit" = "streamlit", + "quarto" = "quarto", + "quarto-static" = "quarto", + "quarto-shiny" = "quarto", + "rmd-static" = "rmarkdown", + "rmd-shiny" = "rmarkdown", + "static" = "static", + stop( + "appMode '", + appMode, + "' is not supported by Connect Cloud", + call. = FALSE + ) + ) +} + +cloudSecrets <- function(envVars) { + if (length(envVars) == 0L) { + return(I(list())) + } + values <- Sys.getenv(envVars, unset = NA) + keep <- !is.na(values) + if (!any(keep)) { + return(I(list())) + } + + unname(Map( + function(name, value) { + list( + name = name, + value = value + ) + }, + envVars[keep], + values[keep] + )) +} diff --git a/R/client-generics.R b/R/client-generics.R index 60576163..6b2738e9 100644 --- a/R/client-generics.R +++ b/R/client-generics.R @@ -22,3 +22,101 @@ uploadBundle <- function(client, application, bundlePath) { UseMethod("uploadBundle") } + +#' Get the display name of the server a client talks to +#' +#' Use this name in messages to the user. +#' +#' @param client A client object. +#' @return A string, for example `"Posit Connect"`. +#' @noRd +serverDisplayName <- function(client) { + UseMethod("serverDisplayName") +} + +#' Can a deploy set environment variables? +#' @noRd +supportsEnvVars <- function(client) { + UseMethod("supportsEnvVars") +} + +#' Can the account list and update environment variables on all its content? +#' +#' This is different from `supportsEnvVars()`. It needs the `getEnvVars` and +#' `setEnvVars` API calls. +#' @noRd +supportsEnvVarManagement <- function(client) { + UseMethod("supportsEnvVarManagement") +} + +#' Can the server run Node.js content? +#' +#' A `TRUE` result does not check the server version. +#' @noRd +supportsNodejs <- function(client) { + UseMethod("supportsNodejs") +} + +#' Can the user add, remove, and list the users of an application? +#' @noRd +supportsUserManagement <- function(client) { + UseMethod("supportsUserManagement") +} + +#' Can an application directory have a legacy scrypt password file? +#' @noRd +usesPasswordFile <- function(client) { + UseMethod("usesPasswordFile") +} + +#' Can the caller choose not to send the invitation email? +#' @noRd +supportsOptionalInviteEmail <- function(client) { + UseMethod("supportsOptionalInviteEmail") +} + +#' Can the server redact user emails in the list of users? +#' +#' A redacted email does not match the email that the caller gives. +#' @noRd +redactsUserEmails <- function(client) { + UseMethod("redactsUserEmails") +} + +#' Must each deploy upload a bundle? +#' @noRd +requiresUpload <- function(client) { + UseMethod("requiresUpload") +} + +#' Is Python detection on by default? +#' +#' The `rsconnect.python.enabled` option overrides this value. +#' @noRd +pythonEnabledByDefault <- function(client) { + UseMethod("pythonEnabledByDefault") +} + +#' Can a deploy set the visibility of an application? +#' @noRd +supportsVisibility <- function(client) { + UseMethod("supportsVisibility") +} + +#' Can `syncAppMetadata()` update deployment records from the server? +#' @noRd +supportsMetadataSync <- function(client) { + UseMethod("supportsMetadataSync") +} + +#' Must static R Markdown be deployed as `"rmd-shiny"`? +#' @noRd +staticRmdNeedsShiny <- function(client) { + UseMethod("staticRmdNeedsShiny") +} + +#' Must the content URL get UTM parameters before it opens in the browser? +#' @noRd +addsUtmParameters <- function(client) { + UseMethod("addsUtmParameters") +} diff --git a/R/client-shinyapps.R b/R/client-shinyapps.R index 808c5e15..1a927491 100644 --- a/R/client-shinyapps.R +++ b/R/client-shinyapps.R @@ -396,6 +396,78 @@ uploadBundle.shinyAppsClient <- function(client, application, bundlePath) { client$getBundle(bundle$id) } +#' @export +serverDisplayName.shinyAppsClient <- function(client) { + "shinyapps.io" +} + +#' @export +supportsEnvVars.shinyAppsClient <- function(client) { + FALSE +} + +#' @export +supportsEnvVarManagement.shinyAppsClient <- function(client) { + FALSE +} + +#' @export +supportsNodejs.shinyAppsClient <- function(client) { + FALSE +} + +#' @export +supportsUserManagement.shinyAppsClient <- function(client) { + TRUE +} + +#' @export +usesPasswordFile.shinyAppsClient <- function(client) { + TRUE +} + +#' @export +supportsOptionalInviteEmail.shinyAppsClient <- function(client) { + TRUE +} + +#' @export +redactsUserEmails.shinyAppsClient <- function(client) { + FALSE +} + +#' @export +requiresUpload.shinyAppsClient <- function(client) { + FALSE +} + +#' @export +pythonEnabledByDefault.shinyAppsClient <- function(client) { + FALSE +} + +#' @export +supportsVisibility.shinyAppsClient <- function(client) { + TRUE +} + +#' @export +supportsMetadataSync.shinyAppsClient <- function(client) { + TRUE +} + +# shinyapps.io serves all content from a Shiny process, so it cannot serve +# `"rmd-static"` content. +#' @export +staticRmdNeedsShiny.shinyAppsClient <- function(client) { + TRUE +} + +#' @export +addsUtmParameters.shinyAppsClient <- function(client) { + FALSE +} + putPresignedBundle <- function(bundle, bundleSize, bundlePath) { presigned_service <- parseHttpUrl(bundle$presigned_url) diff --git a/R/configureApp.R b/R/configureApp.R index 8c30286c..b61e9766 100644 --- a/R/configureApp.R +++ b/R/configureApp.R @@ -61,20 +61,11 @@ configureApp <- function( propertyName <- i propertyValue <- properties[[i]] - # dispatch to the appropriate client implementation - if (is.function(client$setApplicationProperty)) { - client$setApplicationProperty( - application$id, - propertyName, - propertyValue - ) - } else { - stop( - "Server ", - accountDetails$server, - " has no appropriate configuration method." - ) - } + client$setApplicationProperty( + application$id, + propertyName, + propertyValue + ) } # redeploy application if requested diff --git a/R/deployApp.R b/R/deployApp.R index a766991c..cc7dd9fa 100644 --- a/R/deployApp.R +++ b/R/deployApp.R @@ -487,27 +487,21 @@ deployApp <- function( ) } + client <- clientForAccount(accountDetails) + # Run checks prior to first saveDeployment() to avoid errors that will always # prevent a successful upload from generating a partial deployment - if ( - isConnectServer(accountDetails$server) && - identical(upload, FALSE) - ) { - # it is not possible to deploy to Connect without uploading + if (requiresUpload(client) && identical(upload, FALSE)) { stop( - "Posit Connect does not support deploying without uploading. ", + serverDisplayName(client), + " does not support deploying without uploading. ", "Specify upload=TRUE to upload and re-deploy your application." ) } - client <- clientForAccount(accountDetails) - - if ( - !serverSupportsEnvVars(accountDetails$server, client) && - length(envVars) > 0 - ) { + if (!supportsEnvVars(client) && length(envVars) > 0) { cli::cli_abort( - "{accountDetails$server} does not support setting {.arg envVars}" + "{serverDisplayName(client)} does not support setting {.arg envVars}" ) } @@ -515,8 +509,6 @@ deployApp <- function( showCookies(serverInfo(accountDetails$server)$url) } - isShinyappsServer <- isShinyappsServer(accountDetails$server) - logger("Inferring App mode and parameters") appMetadata <- appMetadata( appDir = appDir, @@ -525,16 +517,15 @@ deployApp <- function( quarto = quarto, appMode = appMode, contentCategory = contentCategory, - isShinyappsServer = isShinyappsServer, + staticRmdNeedsShiny = staticRmdNeedsShiny(client), metadata = metadata ) if (appMetadata$appMode == "nodejs") { - if (isShinyappsServer(accountDetails$server)) { - cli::cli_abort("Node.js content is not supported on shinyapps.io.") - } - if (isPositConnectCloudServer(accountDetails$server)) { - cli::cli_abort("Node.js content is not supported on Posit Connect Cloud.") + if (!supportsNodejs(client)) { + cli::cli_abort( + "Node.js content is not supported on {serverDisplayName(client)}." + ) } checkConnectSupportsNodejs(client) } @@ -657,9 +648,7 @@ deployApp <- function( taskComplete(quiet, "Content updated") } } else { - if ( - needsVisibilityChange(accountDetails$server, application, appVisibility) - ) { + if (needsVisibilityChange(client, application, appVisibility)) { taskStart(quiet, "Setting visibility to {appVisibility}...") client$setApplicationProperty( application$id, @@ -678,7 +667,7 @@ deployApp <- function( bundle <- NULL if (upload) { - python <- getPythonForTarget(python, accountDetails) + python <- getPythonForTarget(python, client) pythonConfig <- pythonConfigurator(python, forceGeneratePythonEnvironment) if (dependencyResolution == "library") { @@ -787,7 +776,6 @@ deployApp <- function( openURL( client, application, - accountDetails$server, launch.browser, on.failure, deploymentSucceeded @@ -840,15 +828,6 @@ connectVersionLt <- function(version, minimum) { ) } -serverSupportsEnvVars <- function(server, client) { - return( - # Connect Cloud supports setting environment variables, but not through a - # setEnvVars client method - isPositConnectCloudServer(server) || - (isConnectServer(server) && "setEnvVars" %in% names(client)) - ) -} - taskStart <- function(quiet, message, .envir = caller_env()) { if (quiet) { return() @@ -899,16 +878,8 @@ checkAppVisibility <- function( } # Need to set _before_ deploy -needsVisibilityChange <- function(server, application, appVisibility = NULL) { - if (is.null(appVisibility)) { - return(FALSE) - } - - if (isConnectServer(server)) { - # Defaults to private visibility - return(FALSE) - } - if (isPositConnectCloudServer(server)) { +needsVisibilityChange <- function(client, application, appVisibility = NULL) { + if (is.null(appVisibility) || !supportsVisibility(client)) { return(FALSE) } @@ -1086,14 +1057,13 @@ validURL <- function(url) { openURL <- function( client, application, - server, launch.browser, on.failure, deploymentSucceeded ) { # function to browse to a URL using user-supplied browser (config or final) showURL <- function(url) { - if (isPositConnectCloudServer(server)) { + if (addsUtmParameters(client)) { url <- addUtmParameters(url) } if (isTRUE(launch.browser)) { diff --git a/R/envvars.R b/R/envvars.R index 5dbee3d7..b251fef0 100644 --- a/R/envvars.R +++ b/R/envvars.R @@ -18,7 +18,8 @@ #' `envVars`. `envVars` is a list-column. listAccountEnvVars <- function(server = NULL, account = NULL) { accountDetails <- accountInfo(account, server) - checkServerHasEnvVars(accountDetails$server) + client <- clientForAccount(accountDetails) + checkServerHasEnvVars(client) apps <- applications( account = accountDetails$name, @@ -26,7 +27,6 @@ listAccountEnvVars <- function(server = NULL, account = NULL) { ) apps <- apps[c("id", "guid", "name")] - client <- clientForAccount(accountDetails) envVars <- lapply(apps$guid, client$getEnvVars) apps$envVars <- envVars apps @@ -43,7 +43,8 @@ updateAccountEnvVars <- function(envVars, server = NULL, account = NULL) { check_character(envVars) accountDetails <- accountInfo(account, server) - checkServerHasEnvVars(accountDetails$server) + client <- clientForAccount(accountDetails) + checkServerHasEnvVars(client) apps <- listAccountEnvVars( account = accountDetails$name, @@ -59,7 +60,6 @@ updateAccountEnvVars <- function(envVars, server = NULL, account = NULL) { guids <- apps$guid[uses_vars] cli::cli_progress_bar("Updating application...", total = length(guids)) - client <- clientForAccount(accountDetails) for (guid in guids) { client$setEnvVars(guid, envVars) cli::cli_progress_update() @@ -68,12 +68,13 @@ updateAccountEnvVars <- function(envVars, server = NULL, account = NULL) { # Helpers ----------------------------------------------------------------- -checkServerHasEnvVars <- function(server, error_call = caller_env()) { - if (isConnectServer(server)) { +checkServerHasEnvVars <- function(client, error_call = caller_env()) { + if (supportsEnvVarManagement(client)) { return() } cli::cli_abort( - "The {.arg server} {.str {server}} does not support environment variables" + "{serverDisplayName(client)} does not support environment variables", + call = error_call ) } diff --git a/tests/testthat/test-appMetadata.R b/tests/testthat/test-appMetadata.R index 5e59e1de..b301ad47 100644 --- a/tests/testthat/test-appMetadata.R +++ b/tests/testthat/test-appMetadata.R @@ -351,7 +351,7 @@ test_that("can infer mode for rmd as shiny quarto with guidance", { dir <- local_temp_app(list("foo.Rmd" = "")) paths <- list.files(dir) expect_equal( - inferAppMode(dir, paths, isShinyappsServer = TRUE), + inferAppMode(dir, paths, staticRmdNeedsShiny = TRUE), list(appMode = "rmd-shiny", primaryFile = "foo.Rmd") ) }) diff --git a/tests/testthat/test-applications.R b/tests/testthat/test-applications.R index b2db1f68..471a9ae1 100644 --- a/tests/testthat/test-applications.R +++ b/tests/testthat/test-applications.R @@ -37,6 +37,29 @@ test_that("syncAppMetadata deletes deployment records if needed", { expect_equal(nrow(deployments(app)), 0) }) +test_that("syncAppMetadata skips Connect Cloud deployment records", { + local_temp_config() + addTestAccount("myaccount", server = "connect.posit.cloud") + + app <- local_temp_app() + addTestDeployment( + app, + appId = "123", + account = "myaccount", + server = "connect.posit.cloud", + metadata = list(when = 123) + ) + local_mocked_bindings(clientForAccount = function(...) { + fake_client( + "connectCloudClient", + getApplication = function(...) stop("getApplication should not be called") + ) + }) + + syncAppMetadata(app) + expect_equal(deployments(app)$when, "123") +}) + test_that("applications() builds config_url for standard Connect accounts", { local_temp_config() addTestServer(url = "https://connect.example.com") diff --git a/tests/testthat/test-auth.R b/tests/testthat/test-auth.R index 2b83d77e..9d7f0d4d 100644 --- a/tests/testthat/test-auth.R +++ b/tests/testthat/test-auth.R @@ -403,7 +403,7 @@ test_that("showUsers errors on a non-shinyapps, non-PCC server", { account = "myaccount", server = "connect.example.com" ), - regexp = "shinyapps\\.io" + regexp = "rsconnect can't manage application users on Posit Connect" ) }) @@ -1056,6 +1056,9 @@ test_that("cleanupPasswordFile is NOT called on PCC accounts", { test_that("addAuthorizedUser() aborts targeting a Posit Connect server", { local_mocked_account_info() + local_mocked_bindings( + clientForAccount = function(...) fake_client("connectClient") + ) appDir <- local_temp_app() expect_error( @@ -1066,12 +1069,15 @@ test_that("addAuthorizedUser() aborts targeting a Posit Connect server", { account = "connect-user", server = "connect-server" ), - regexp = "`server` must be shinyapps\\.io" + regexp = "rsconnect can't manage application users on Posit Connect" ) }) test_that("removeAuthorizedUser() aborts targeting a Posit Connect server", { local_mocked_account_info() + local_mocked_bindings( + clientForAccount = function(...) fake_client("connectClient") + ) appDir <- local_temp_app() expect_error( @@ -1082,12 +1088,15 @@ test_that("removeAuthorizedUser() aborts targeting a Posit Connect server", { account = "connect-user", server = "connect-server" ), - regexp = "`server` must be shinyapps\\.io" + regexp = "rsconnect can't manage application users on Posit Connect" ) }) test_that("showInvited() aborts targeting a Posit Connect server", { local_mocked_account_info() + local_mocked_bindings( + clientForAccount = function(...) fake_client("connectClient") + ) appDir <- local_temp_app() expect_error( @@ -1097,12 +1106,15 @@ test_that("showInvited() aborts targeting a Posit Connect server", { account = "connect-user", server = "connect-server" ), - regexp = "`server` must be shinyapps\\.io" + regexp = "rsconnect can't manage application users on Posit Connect" ) }) test_that("resendInvitation() aborts targeting a Posit Connect server", { local_mocked_account_info() + local_mocked_bindings( + clientForAccount = function(...) fake_client("connectClient") + ) appDir <- local_temp_app() expect_error( @@ -1113,6 +1125,24 @@ test_that("resendInvitation() aborts targeting a Posit Connect server", { account = "connect-user", server = "connect-server" ), - regexp = "`server` must be shinyapps\\.io" + regexp = "rsconnect can't manage application users on Posit Connect" + ) +}) + +test_that("showUsers() aborts targeting a Posit Connect server", { + local_mocked_account_info() + local_mocked_bindings( + clientForAccount = function(...) fake_client("connectClient") + ) + appDir <- local_temp_app() + + expect_error( + showUsers( + appDir = appDir, + appName = "myapp", + account = "connect-user", + server = "connect-server" + ), + regexp = "rsconnect can't manage application users on Posit Connect" ) }) diff --git a/tests/testthat/test-bundlePython.R b/tests/testthat/test-bundlePython.R index 38bece25..6251ed18 100644 --- a/tests/testthat/test-bundlePython.R +++ b/tests/testthat/test-bundlePython.R @@ -24,16 +24,16 @@ test_that("getPython looks in argument, RETICULATE_PYTHON, then RETICULATE_PYTHO test_that("rsconnect.python.enabled overrides getPythonForTarget() default", { skip_on_cran() - expect_equal(getPythonForTarget("p", list(server = "shinyapps.io")), NULL) - expect_equal(getPythonForTarget("p", list(server = "example.com")), "p") + expect_equal(getPythonForTarget("p", fake_client("shinyAppsClient")), NULL) + expect_equal(getPythonForTarget("p", fake_client("connectClient")), "p") withr::local_options(rsconnect.python.enabled = FALSE) - expect_equal(getPythonForTarget("p", list(server = "shinyapps.io")), NULL) - expect_equal(getPythonForTarget("p", list(server = "example.com")), NULL) + expect_equal(getPythonForTarget("p", fake_client("shinyAppsClient")), NULL) + expect_equal(getPythonForTarget("p", fake_client("connectClient")), NULL) withr::local_options(rsconnect.python.enabled = TRUE) - expect_equal(getPythonForTarget("p", list(server = "shinyapps.io")), "p") - expect_equal(getPythonForTarget("p", list(server = "example.com")), "p") + expect_equal(getPythonForTarget("p", fake_client("shinyAppsClient")), "p") + expect_equal(getPythonForTarget("p", fake_client("connectClient")), "p") }) test_that("can infer env from existing directory", { diff --git a/tests/testthat/test-deployApp.R b/tests/testthat/test-deployApp.R index 49a2a26f..4f5ab9e6 100644 --- a/tests/testthat/test-deployApp.R +++ b/tests/testthat/test-deployApp.R @@ -44,16 +44,24 @@ test_that("needsVisibilityChange() returns FALSE when no change needed", { ) } - expect_false(needsVisibilityChange("connect.com")) - expect_false(needsVisibilityChange("shinyapps.io", dummyApp("public"), NULL)) + expect_false(needsVisibilityChange(fake_client("connectClient"))) expect_false(needsVisibilityChange( - "shinyapps.io", + fake_client("shinyAppsClient"), + dummyApp("public"), + NULL + )) + expect_false(needsVisibilityChange( + fake_client("shinyAppsClient"), dummyApp("public"), "public" )) - expect_true(needsVisibilityChange("shinyapps.io", dummyApp(NULL), "private")) expect_true(needsVisibilityChange( - "shinyapps.io", + fake_client("shinyAppsClient"), + dummyApp(NULL), + "private" + )) + expect_true(needsVisibilityChange( + fake_client("shinyAppsClient"), dummyApp("public"), "private" )) @@ -308,9 +316,8 @@ test_that("openURL() does not launch the browser on success with no valid url", # can't resolve the content's owning account. launched <- FALSE openURL( - client = NULL, + client = fake_client("connectCloudClient"), application = list(url = "", dashboard_url = NULL), - server = "connect.posit.cloud", launch.browser = function(url) launched <<- TRUE, on.failure = function(url) { stop("on.failure should not be called on success") @@ -323,12 +330,11 @@ test_that("openURL() does not launch the browser on success with no valid url", test_that("openURL() launches the browser on success with a valid url", { launched <- FALSE openURL( - client = NULL, + client = fake_client("connectCloudClient"), application = list( url = "https://connect.posit.cloud/acct/content/abc123", dashboard_url = NULL ), - server = "connect.posit.cloud", launch.browser = function(url) launched <<- TRUE, on.failure = function(url) { stop("on.failure should not be called on success") @@ -338,6 +344,33 @@ test_that("openURL() launches the browser on success with a valid url", { expect_true(launched) }) +test_that("openURL() adds UTM parameters only for Connect Cloud", { + withr::local_envvar(RSTUDIO = "") + application <- list(url = "https://example.com/app/", dashboard_url = NULL) + + expect_message( + openURL( + client = fake_client("connectCloudClient"), + application = application, + launch.browser = function(url) message(url), + on.failure = NULL, + deploymentSucceeded = TRUE + ), + "https://example.com/app/?utm_source=rsconnect", + fixed = TRUE + ) + expect_message( + openURL( + client = fake_client("shinyAppsClient"), + application = application, + launch.browser = function(url) message(url), + on.failure = NULL, + deploymentSucceeded = TRUE + ), + "^https://example.com/app/\n$" + ) +}) + test_that("checkAppVisibility() accepts values the server supports", { expect_no_error(checkAppVisibility(NULL, "shinyapps.io")) expect_no_error(checkAppVisibility("private", "shinyapps.io")) @@ -1068,7 +1101,8 @@ test_that("deployApp(upload = FALSE) aborts on Posit Connect", { accountDetails = list(name = "connect-user", server = "connect-server"), deployment = list(name = "myapp", appId = "42") ) - } + }, + clientForAccount = function(...) fake_client("connectClient") ) expect_error( diff --git a/tests/testthat/test-envvars.R b/tests/testthat/test-envvars.R index 12918aae..72ce4347 100644 --- a/tests/testthat/test-envvars.R +++ b/tests/testthat/test-envvars.R @@ -31,3 +31,13 @@ test_that("updateAccountEnvVars() aborts for shinyapps.io and Connect Cloud acco regexp = "does not support environment variables" ) }) + +test_that("env var errors name the server and the calling function", { + local_mocked_account_info() + + err <- expect_error( + listAccountEnvVars(account = "cloud-user", server = "connect.posit.cloud"), + regexp = "Posit Connect Cloud does not support environment variables" + ) + expect_equal(rlang::call_name(err$call), "listAccountEnvVars") +})