diff --git a/NEWS.md b/NEWS.md index c82348b4..8f9ad502 100644 --- a/NEWS.md +++ b/NEWS.md @@ -194,6 +194,12 @@ * `accountInfo()` and `removeAccount()` no longer require `account` be supplied (#666). +* Functions that should only interact with shinyapps.io enforce the server + type. Updated `addAuthorizedUser()`, `removeAuthorizedUser()`, + `showUsers()`, `showInvited()`, `resendInvitation()`, `configureApp()`, + `setProperty()`, `unsetProperty()`, `purgeApp()`, `restartApp()`, + `terminateApp()`, `showUsage()`, and `showMetrics()` (#863, #864). + * When needed packages are not installed, and you're in an interactive environment, rsconnect will now prompt you to install them (#665). diff --git a/R/applications.R b/R/applications.R index 1adaf084..e2120a19 100644 --- a/R/applications.R +++ b/R/applications.R @@ -149,16 +149,15 @@ stopWithApplicationNotFound <- function(appName) { sep = ""), call. = FALSE) } -applicationTask <- function(taskDef, appName, account, server, quiet) { +applicationTask <- function(taskDef, appName, accountDetails, quiet) { + # resolve target account and application + application <- resolveApplication(accountDetails, appName) + # get status function and display initial status displayStatus <- displayStatus(quiet) displayStatus(paste(taskDef$beginStatus, "...\n", sep = "")) - # resolve target account and application - accountDetails <- accountInfo(account, server) - application <- resolveApplication(accountDetails, appName) - # perform the action client <- clientForAccount(accountDetails) task <- taskDef$action(client, application) diff --git a/R/auth.R b/R/auth.R index 4176b545..8d3135d8 100644 --- a/R/auth.R +++ b/R/auth.R @@ -48,6 +48,7 @@ addAuthorizedUser <- function(email, appDir = getwd(), appName = NULL, emailMessage = NULL) { accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # resolve application if (is.null(appName)) @@ -81,6 +82,7 @@ removeAuthorizedUser <- function(user, appDir = getwd(), appName = NULL, account = NULL, server = NULL) { accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # resolve application if (is.null(appName)) @@ -131,10 +133,7 @@ showUsers <- function(appDir = getwd(), appName = NULL, account = NULL, server = NULL) { accountDetails <- accountInfo(account, server) - - if (!isCloudServer(accountDetails$server)) { - stop("This method only works for ShinyApps or posit.cloud servers.") - } + checkShinyappsServer(accountDetails$server) # resolve application if (is.null(appName)) @@ -177,6 +176,7 @@ showInvited <- function(appDir = getwd(), appName = NULL, account = NULL, server = NULL) { accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # resolve application if (is.null(appName)) @@ -220,6 +220,7 @@ resendInvitation <- function(invite, regenerate = FALSE, account = NULL, server = NULL) { accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # get invitations invited <- showInvited(appDir, appName, account, server) diff --git a/R/configureApp.R b/R/configureApp.R index c65d5bc6..41d7534d 100644 --- a/R/configureApp.R +++ b/R/configureApp.R @@ -24,8 +24,9 @@ configureApp <- function(appName, appDir = getwd(), account = NULL, server = NUL redeploy = TRUE, size = NULL, instances = NULL, logLevel = c("normal", "quiet", "verbose")) { - # resolve target account and application accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) + application <- resolveApplication(accountDetails, appName) displayStatus <- displayStatus(identical(logLevel, "quiet")) @@ -78,8 +79,7 @@ configureApp <- function(appName, appDir = getwd(), account = NULL, server = NUL #' @param appName Name of application #' @param appPath Directory or file that was deployed. Defaults to current #' working directory. -#' @param account Account name. If a single account is registered on the system -#' then this parameter can be omitted. +#' @inheritParams deployApp #' @param force Forcibly set the property #' #' @note This function only works for ShinyApps servers. @@ -96,11 +96,13 @@ configureApp <- function(appName, appDir = getwd(), account = NULL, server = NUL #' } #' @export setProperty <- function(propertyName, propertyValue, appPath = getwd(), - appName = NULL, account = NULL, force = FALSE) { + appName = NULL, account = NULL, server = NULL, force = FALSE) { # resolve the application target and target account info - target <- findDeployment(appPath, appName, account) - accountDetails <- accountInfo(target$account) + target <- findDeployment(appPath, appName, account, server) + accountDetails <- accountInfo(target$account, target$server) + checkShinyappsServer(accountDetails$server) + client <- clientForAccount(accountDetails) application <- getAppByName(client, accountDetails, target$appName) if (is.null(application)) @@ -122,8 +124,7 @@ setProperty <- function(propertyName, propertyValue, appPath = getwd(), #' @param appName Name of application #' @param appPath Directory or file that was deployed. Defaults to current #' working directory. -#' @param account Account name. If a single account is registered on the system -#' then this parameter can be omitted. +#' @inheritParams deployApp #' @param force Forcibly unset the property #' #' @note This function only works for ShinyApps servers. @@ -137,11 +138,13 @@ setProperty <- function(propertyName, propertyValue, appPath = getwd(), #' } #' @export unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL, - account = NULL, force = FALSE) { + account = NULL, server = NULL, force = FALSE) { # resolve the application target and target account info - target <- findDeployment(appPath, appName, account) - accountDetails <- accountInfo(target$account) + target <- findDeployment(appPath, appName, account, server) + accountDetails <- accountInfo(target$account, target$server) + checkShinyappsServer(accountDetails$server) + client <- clientForAccount(accountDetails) application <- getAppByName(client, accountInfo, target$appName) if (is.null(application)) diff --git a/R/purgeApp.R b/R/purgeApp.R index 04b5bcc1..f8bbb755 100644 --- a/R/purgeApp.R +++ b/R/purgeApp.R @@ -23,6 +23,8 @@ #' @export purgeApp <- function(appName, account = NULL, server = NULL, quiet = FALSE) { + accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # define purge task taskDef <- list() @@ -33,5 +35,5 @@ purgeApp <- function(appName, account = NULL, server = NULL, } # perform it - applicationTask(taskDef, appName, account, server = server, quiet) + applicationTask(taskDef, appName, accountDetails, quiet) } diff --git a/R/restartApp.R b/R/restartApp.R index 7281c946..8a72b783 100644 --- a/R/restartApp.R +++ b/R/restartApp.R @@ -20,6 +20,8 @@ #' @note This function works only for ShinyApps servers. #' @export restartApp <- function(appName, account = NULL, server = NULL, quiet = FALSE) { + accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # define deploy task taskDef <- list() @@ -30,5 +32,5 @@ restartApp <- function(appName, account = NULL, server = NULL, quiet = FALSE) { } # perform it - applicationTask(taskDef, appName, account, server, quiet) + applicationTask(taskDef, appName, accountDetails, quiet) } diff --git a/R/servers.R b/R/servers.R index 9772a3f3..18de90e0 100644 --- a/R/servers.R +++ b/R/servers.R @@ -64,10 +64,22 @@ isCloudServer <- function(server) { server %in% cloudServers } +checkCloudServer <- function(server, call = caller_env()) { + if (!isCloudServer(server)) { + cli::cli_abort("`server` must be shinyapps.io or posit.cloud", call = call) + } +} + isShinyappsServer <- function(server) { identical(server, "shinyapps.io") } +checkShinyappsServer <- function(server, call = caller_env()) { + if (!isShinyappsServer(server)) { + cli::cli_abort("`server` must be shinyapps.io", call = call) + } +} + isRPubs <- function(server) { identical(server, "rpubs.com") } diff --git a/R/terminateApp.R b/R/terminateApp.R index 52bfe20b..26c08951 100644 --- a/R/terminateApp.R +++ b/R/terminateApp.R @@ -23,6 +23,8 @@ #' @export terminateApp <- function(appName, account = NULL, server = NULL, quiet = FALSE) { + accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) # define terminate task taskDef <- list() @@ -33,5 +35,5 @@ terminateApp <- function(appName, account = NULL, server = NULL, } # perform it - applicationTask(taskDef, appName, account, server = server, quiet) + applicationTask(taskDef, appName, accountDetails, quiet) } diff --git a/R/usage.R b/R/usage.R index 2c18e6bb..77ffd3b5 100644 --- a/R/usage.R +++ b/R/usage.R @@ -18,6 +18,8 @@ showUsage <- function(appDir = getwd(), appName = NULL, account = NULL, server = usageType = "hours", from = NULL, until = NULL, interval = NULL) { accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) + api <- clientForAccount(accountDetails) # resolve application @@ -121,6 +123,8 @@ showMetrics <- function(metricSeries, accountUsage <- function(account = NULL, server = NULL, usageType = "hours", from = NULL, until = NULL, interval = NULL) { accountDetails <- accountInfo(account, server) + checkShinyappsServer(accountDetails$server) + api <- clientForAccount(accountDetails) # get application usage diff --git a/tests/testthat/test-servers.R b/tests/testthat/test-servers.R index d705cb78..71e4b33f 100644 --- a/tests/testthat/test-servers.R +++ b/tests/testthat/test-servers.R @@ -126,6 +126,27 @@ test_that("All hosted product names are identified as cloud", { expect_false(isCloudServer("connect.internal")) }) +test_that("All hosted product names are identified as cloud", { + checkCloudServer("shinyapps.io") + checkCloudServer("rstudio.cloud") + checkCloudServer("posit.cloud") + expect_error(checkCloudServer("connect.internal")) +}) + +test_that("only shinyapps.io is identified as shinyapps.io", { + expect_true(isShinyappsServer("shinyapps.io")) + expect_false(isShinyappsServer("rstudio.cloud")) + expect_false(isShinyappsServer("posit.cloud")) + expect_false(isShinyappsServer("connect.internal")) +}) + +test_that("only shinyapps.io is identified as shinyapps.io", { + checkShinyappsServer("shinyapps.io") + expect_error(checkShinyappsServer("rstudio.cloud")) + expect_error(checkShinyappsServer("posit.cloud")) + expect_error(checkShinyappsServer("connect.internal")) +}) + test_that("predefined servers includes cloud and shinyapps", { local_temp_config()