Skip to content

Commit

Permalink
Return stub deployments when matching records do not exist.
Browse files Browse the repository at this point in the history
The stub deployment is subsequently used to look-up the application by name.
This lets showLogs, configureApp, setProperty, and unsetProperty interact with
shinyapps.io when the client lacks a deployment record.

Does not address issues with publishing, such as #1013.

Fixes #985
Fixes #989
  • Loading branch information
aronatkins committed Oct 10, 2023
1 parent 7d964a5 commit b274af3
Show file tree
Hide file tree
Showing 7 changed files with 68 additions and 32 deletions.
4 changes: 4 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,9 @@
# rsconnect (development version)

* `showLogs()`, `configureApp()`, `setProperty()`, and `unsetProperty()`
search for the application by name when there are no matching deployment
records. (#985, #989)

# rsconnect 1.1.1

* Added `space` parameter to deploy directly to a space in Posit Cloud.
Expand Down
18 changes: 14 additions & 4 deletions R/applications.R
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,19 @@ applications <- function(account = NULL, server = NULL) {
return(res)
}

# Use the API to filter applications by name.
getAppByName <- function(client, accountInfo, name) {
# NOTE: returns a list with 0 or 1 elements
app <- client$listApplications(accountInfo$accountId, filters = list(name = name))
if (length(app)) {
return(app[[1]])
}

stop("No application found. Specify the application's directory, name, ",
"and/or associated account.", call. = FALSE)
}

# Use the API to list all applications then filter the results client-side.
resolveApplication <- function(accountDetails, appName) {
client <- clientForAccount(accountDetails)
apps <- client$listApplications(accountDetails$accountId)
Expand All @@ -145,7 +158,7 @@ getApplication <- function(account, server, appId) {
}

stopWithApplicationNotFound <- function(appName) {
stop(paste("No application named '", appName, "' is currently deployed",
stop(paste("No application named '", appName, "' is currently deployed.",
sep = ""), call. = FALSE)
}

Expand Down Expand Up @@ -227,9 +240,6 @@ showLogs <- function(appPath = getwd(), appFile = NULL, appName = NULL,
accountDetails <- accountInfo(deployment$account, deployment$server)
client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountDetails, deployment$name)
if (is.null(application))
stop("No application found. Specify the application's directory, name, ",
"and/or associated account.")

if (streaming) {
# streaming; poll for the entries directly
Expand Down
15 changes: 5 additions & 10 deletions R/configureApp.R
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ configureApp <- function(appName, appDir = getwd(), account = NULL, server = NUL
accountDetails <- accountInfo(account, server)
checkShinyappsServer(accountDetails$server)

if (is.null(appName))
appName <- basename(appDir)
application <- resolveApplication(accountDetails, appName)

displayStatus <- displayStatus(identical(logLevel, "quiet"))
Expand Down Expand Up @@ -109,9 +111,6 @@ setProperty <- function(propertyName, propertyValue, appPath = getwd(),

client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountDetails, deployment$name)
if (is.null(application))
stop("No application found. Specify the application's directory, name, ",
"and/or associated account.")

invisible(client$setApplicationProperty(application$id,
propertyName,
Expand Down Expand Up @@ -151,9 +150,6 @@ unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL,

client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountInfo, deployment$name)
if (is.null(application))
stop("No application found. Specify the application's directory, name, ",
"and/or associated account.")

invisible(client$unsetApplicationProperty(application$id,
propertyName,
Expand All @@ -163,7 +159,7 @@ unsetProperty <- function(propertyName, appPath = getwd(), appName = NULL,

#' Show Application property
#'
#' Show propreties of an application deployed to ShinyApps.
#' Show properties of an application deployed to ShinyApps.
#'
#' @param appName Name of application
#' @param appPath Directory or file that was deployed. Defaults to current
Expand All @@ -182,11 +178,10 @@ showProperties <- function(appPath = getwd(), appName = NULL, account = NULL, se
server = server
)
accountDetails <- accountInfo(deployment$account, deployment$server)
checkShinyappsServer(accountDetails$server)

client <- clientForAccount(accountDetails)
application <- getAppByName(client, accountDetails, deployment$name)
if (is.null(application))
stop("No application found. Specify the application's directory, name, ",
"and/or associated account.")

# convert to data frame
res <- do.call(rbind, application$deployment$properties)
Expand Down
6 changes: 0 additions & 6 deletions R/deployApp.R
Original file line number Diff line number Diff line change
Expand Up @@ -671,12 +671,6 @@ bundleApp <- function(appName,
bundlePath
}

getAppByName <- function(client, accountInfo, name) {
# NOTE: returns a list with 0 or 1 elements
app <- client$listApplications(accountInfo$accountId, filters = list(name = name))
if (length(app)) app[[1]] else NULL
}

validURL <- function(url) {
!(is.null(url) || url == "")
}
Expand Down
17 changes: 13 additions & 4 deletions R/deployments-find.R
Original file line number Diff line number Diff line change
@@ -1,4 +1,4 @@
findDeployment <- function(appPath = ".",
findDeployment <- function(appPath = getwd(),
appName = NULL,
server = NULL,
account = NULL,
Expand All @@ -11,9 +11,18 @@ findDeployment <- function(appPath = ".",
)

if (nrow(deps) == 0) {
cli::cli_abort(
"Couldn't find any deployments matching supplied criteria.",
call = error_call
# When the name and account information does not discover a single deployment, return a skeleton
# deployment object, which can subsequently be used to query the service.

# Infers account when not provided...
accountDetails <- accountInfo(account, server)
if (is.null(appName)) {
appName <- generateAppName(NULL, appPath, account = accountDetails$name, unique = FALSE)
}
list(
name = appName,
account = accountDetails$name,
server = accountDetails$server
)
} else if (nrow(deps) == 1) {
as.list(deps)
Expand Down
9 changes: 5 additions & 4 deletions tests/testthat/_snaps/deployments-find.md
Original file line number Diff line number Diff line change
@@ -1,10 +1,11 @@
# errors if no deployments
# error when no deployments and no accounts

Code
findDeployment(app)
findDeployment(app, appName = "placeholder")
Condition
Error:
! Couldn't find any deployments matching supplied criteria.
Error in `accountInfo()`:
! No accounts registered.
i Call `rsconnect::setAccountInfo()` to register an account.

# disambiguates multiple deployments

Expand Down
31 changes: 27 additions & 4 deletions tests/testthat/test-deployments-find.R
Original file line number Diff line number Diff line change
@@ -1,22 +1,45 @@
test_that("errors if no deployments", {
test_that("error when no deployments and no accounts", {
local_temp_config()

app <- local_temp_app()
expect_snapshot(findDeployment(app), error = TRUE)

expect_snapshot(findDeployment(app, appName = "placeholder"), error = TRUE)
})

test_that("finds single deployment", {
test_that("returns stubbed details when single account has no deployments", {
local_temp_config()
addTestServer()
addTestAccount()

app <- local_temp_app()

# derived from directory name.
dep <- findDeployment(app)
expect_equal(dep, list(name = basename(app), account = "ron", server = "example.com"))

# name given.
dep <- findDeployment(app, appName = "placeholder")
expect_equal(dep, list(name = "placeholder", account = "ron", server = "example.com"))
})

test_that("finds single deployment", {
local_temp_config()
addTestServer()
addTestAccount()

app <- local_temp_app()
addTestDeployment(app)

dep <- findDeployment(app)
expect_equal(dep$name, "test")
})

test_that("disambiguates multiple deployments", {
app <- local_temp_app()
local_temp_config()
addTestServer()
addTestAccount()

app <- local_temp_app()
addTestDeployment(app, "test1")
addTestDeployment(app, "test2")
expect_snapshot(findDeployment(app), error = TRUE)
Expand Down

0 comments on commit b274af3

Please sign in to comment.