mockServerFactory <- function(initialResponses) {
# Stock responses for certain endpoints. Can still be overridden by tests.
if (is.null(initialResponses$"^GET /v1/users/current")) {
initialResponses$"GET /v1/users/current" <- list(
content = list(
id = 100
)
)
}
if (is.null(initialResponses$"^GET /v1/accounts/?")) {
initialResponses$"^GET /v1/accounts/?" <- list(
content = list(
count = 1,
total = 1,
offset = 0,
accounts = list(
list(
id = 50,
name = "testthat-account",
account = "testthat-account"
),
list(
id = 51,
name = "testthat-superfluous-account",
account = "testthat-superfluous-account"
)
)
)
)
}
mockServer <- list(
responses = initialResponses
)
mockServer$addResponse <- function(methodAndPath, response) {
mockServer$responses <- append(mockServer$responses, response)
}
mockServer$impl <- function(protocol,
host,
port,
method,
path,
headers,
contentType = NULL,
contentFile = NULL,
certificate = NULL,
timeout = NULL) {
methodAndPath <- paste(method, path)
request <- list(
protocol = protocol,
host = host,
port = port,
method = method,
path = path
)
response <- list(
req = request,
status = 200,
location = "",
contentType = "application/json"
)
found <- FALSE
for (pathRegex in names(mockServer$responses)) {
match <- regexec(pathRegex, methodAndPath)[[1]]
if (match[1] != -1) {
found <- TRUE
responseSupplement <- mockServer$responses[[pathRegex]]
for (respProperty in names(responseSupplement)) {
if (is.function(responseSupplement[[respProperty]])) {
responseSupplement[[respProperty]] <- responseSupplement[[respProperty]](
methodAndPath,
match,
headers = headers,
contentType = contentType,
contentFile = contentFile)
}
response[[respProperty]] <- responseSupplement[[respProperty]]
}
if (is.list(response$content)) {
response$content <- jsonlite::toJSON(response$content, auto_unbox = TRUE)
}
break
}
}
if (!found) {
stop(paste("No mocked response defined for", methodAndPath))
}
response
}
mockServer
}
configureTestAccount <- function(server = "posit.cloud", name = NULL) {
if (is.null(name)) {
name <- "testthat-account"
}
existingAccount <- NULL
tryCatch(
existingAccount <- accountInfo(name, server),
error = function(e) { existingAccount <- NULL }
)
if (is.null(existingAccount)) {
setAccountInfo(
name = name,
token = "foo",
secret = "bar",
server = server
)
}
name
}
test_that("Get application", {
mockServer <- mockServerFactory(list(
"^GET /outputs/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
if (output_id != 5) {
cli::cli_abort(
"404 error",
class = "rsconnect_http_404"
)
}
list(
"id" = 5,
"source_id" = 10,
"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))
if (application_id != 10) {
cli::cli_abort(
"404 error",
class = "rsconnect_http_404"
)
}
list(
"id" = application_id,
"content_id" = 5
)
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$getApplication("10", NA)
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication("5", 1)
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication("5", "unknown")
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication("10", "unknown")
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Get application output trashed", {
mockServer <- mockServerFactory(list(
"^GET /outputs/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = output_id,
"source_id" = 1,
"url" = "http://fake-url.test.me/",
"state" = "trashed"
)
}
),
"^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" = 5
)
}
),
"^PATCH /outputs/5" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
list()
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$getApplication(10, NA)
expect_equal(app$id, 5)
expect_equal(app$application_id, 10)
expect_equal(app$url, "http://fake-url.test.me/")
app <- client$getApplication(5, deploymentRecordVersion)
expect_equal(app$id, 5)
expect_equal(app$application_id, 1)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create application", {
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")
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")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
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(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, "static")
expect_equal(content$content_category, "document")
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?", "static", "document")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create static server-side-rendered application", {
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, "static")
expect_equal(content$render_by, "server")
expect_equal(content$content_category, "document")
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?", "quarto-static", "document")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("deployApplication updates the parent project", {
mockServer <- mockServerFactory(list(
"^GET /applications/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- substr(methodAndPath, match[2], end)
expect_equal(application_id, "42")
list(
"id" = 42,
"content_id" = 41
)
}
),
"^PATCH /outputs" = list(
content = function(methodAndPath, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
if (!is.null(content$project)) {
expect_equal(content$project, 41)
} else {
expect_equal(content$space, 333)
}
list(
"id" = 41
)
}
),
"^POST /applications/([0-9]+)/deploy" = list(
content = function(methodAndPath, match, contentFile, ...) {
end <- attr(match, "match.length")[2] + match[2]
application_id <- substr(methodAndPath, match[2], end)
expect_equal(application_id, "101/")
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$rebuild, FALSE)
list(
"id" = 101
)
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
withr::local_envvar(LUCID_APPLICATION_ID = "42")
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
application <- list(
"id" = 100,
"application_id" = 101
)
client$deployApplication(application, spaceId = 333)
})
test_that("Create static RMD application", {
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, "static")
expect_equal(content$render_by, "server")
expect_equal(content$content_category, "document")
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?", "1", "rmd-static", "document")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("Create application with linked source project", {
mockServer <- mockServerFactory(list(
"^POST /outputs" = list(
content = function(methodAndPAth, match, contentFile, ...) {
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$project, 41)
expect_equal(content$space, 99)
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" = application_id - 1
)
}
),
"^GET /content/41" = list(
content = list(
"id" = 41,
"space_id" = 99
)
)
))
withr::local_options(rsconnect.http = mockServer$impl)
Sys.setenv(LUCID_APPLICATION_ID = "42")
withr::defer(Sys.unsetenv("LUCID_APPLICATION_ID"))
fakeService <- list(
protocol = "test",
host = "unit-test",
port = 42
)
client <- cloudClient(fakeService, NULL)
app <- client$createApplication("test app", "unused?", "unused?", "unused?", "static")
expect_equal(app$id, 1)
expect_equal(app$application_id, 2)
expect_equal(app$url, "http://fake-url.test.me/")
})
test_that("findDeploymentTarget() results in correct Cloud API calls when given appId", {
local_temp_config()
mockServer <- mockServerFactory(list(
"^GET /v1/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" = application_id - 1,
"name" = paste("testthat app", application_id)
)
}
),
"^GET /v1/outputs/([0-9]+)" = list(
content = function(methodAndPath, match, ...) {
end <- attr(match, "match.length")[2] + match[2]
output_id <- strtoi(substr(methodAndPath, match[2], end))
list(
"id" = output_id,
"source_id" = output_id + 1,
"url" = "http://fake-url.test.me/",
"state" = "active",
"name" = "my output"
)
}
)
))
withr::local_options(rsconnect.http = mockServer$impl)
testAccount <- configureTestAccount()
withr::defer(removeAccount(testAccount))
target <- findDeploymentTarget(
appId = 3,
account = testAccount,
server = "posit.cloud",
)
accountDetails <- target$accountDetails
deployment <- target$deployment
expect_equal(deployment$name, "my output")
expect_equal(deployment$account, testAccount)
expect_equal(deployment$server, "posit.cloud")
expect_equal(deployment$appId, 3)
})
deployAppMockServerFactory <- function(expectedAppType, outputState) {
outputResponse <- list(
"id" = 1,
"source_id" = 2,
"url" = "http://fake-url.test.me/",
"state" = outputState
)
actualCalls <- list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = FALSE,
bundleUploaded = FALSE,
bundleReady = FALSE,
deployStarted = FALSE
)
server <- mockServerFactory(list(
# An attempt to search for preexisting applications with the same name.
# This call should change, see https://github.com/rstudio/rsconnect/issues/808
"^GET /v1/applications/[?]filter=account_id:50&filter=type:connect" = list(
content = list(
count = 0,
total = 0,
applications = list()
)
),
"^POST /v1/outputs$" = list(
content = function(methodAndPath, match, contentFile, ...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$outputCreated <- TRUE
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$application_type, expectedAppType)
expect_equal(content$name, "Desired name here")
outputResponse
}
),
"^GET /v1/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 = application_id - 1,
name = paste("testthat app", application_id),
type = expectedAppType
)
}
),
"^POST /v1/bundles/123/status$" = list(
content = function(methodAndPath, match, contentFile, ...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$bundleReady <- TRUE
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
expect_equal(content$status, "ready")
list()
}
),
"^POST /v1/bundles$" = list(
content = function(methodAndPath, match, contentFile, ...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$bundleCreated <- TRUE
content <- jsonlite::fromJSON(readChar(contentFile, file.info(contentFile)$size))
list(
id = 123,
presigned_url = "https://write-only-memory.com/fake-presigned-url",
presigned_checksum = content$checksum
)
}
),
"^PUT /fake-presigned-url" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$bundleUploaded <- TRUE
}
),
"^GET /v1/bundles/123$" = list(
content = list(
id = 123,
status = "ready"
)
),
"^POST /v1/applications/[23]/deploy$" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$deployStarted <- TRUE
list(
task_id = "testthat-task-id"
)
}
),
"^GET /v1/tasks/testthat-task-id$" = list(
content = list(
status = "success",
finished = TRUE
)
),
# Fetch existing output when re-deploying from .dcf data
"^GET /v1/outputs/1$" = list(
content = outputResponse
),
"^POST /v1/outputs/1/revisions" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$revisionCreated <- TRUE
list(
application_id = 3
)
}
),
"^PATCH /v1/outputs" = list(
content = function(...) {
e <- environment()
p <- parent.env(e)
p$actualCalls$outputStateUpdated <- TRUE
}
)
))
expect_calls <- function(expectedCalls) {
expect_equal(actualCalls, expectedCalls)
}
reset_calls <- function() {
e <- environment()
p <- parent.env(e)
p$actualCalls <- list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = FALSE,
bundleUploaded = FALSE,
bundleReady = FALSE,
deployStarted = FALSE
)
}
list(
server = server,
expect_calls = expect_calls,
reset_calls = reset_calls
)
}
test_that("deployApp() for shiny results in correct Cloud API calls", {
skip_on_cran()
local_temp_config()
withr::local_options(renv.verbose = TRUE)
mock <- deployAppMockServerFactory(expectedAppType = "connect", outputState = "active")
mockServer <- mock$server
withr::local_options(rsconnect.http = mockServer$impl)
testAccount <- configureTestAccount()
withr::defer(removeAccount(testAccount))
sourcePath <- test_path("shinyapp-simple")
# Remove local deployment info at end for reproducibility and tidiness.
withr::defer(forgetDeployment(appPath = sourcePath, force = TRUE))
deployApp(
appName = "Desired name here",
appDir = sourcePath,
server = "posit.cloud",
account = testAccount,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = TRUE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
mock$reset_calls()
# deploy again to test existing deployment path
deployApp(
appDir = sourcePath,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
# Start over, add another posit.cloud account and test again with that environment
mock$reset_calls()
forgetDeployment(appPath = sourcePath, force = TRUE)
extraLocalAccount <- configureTestAccount(name = "testthat-superfluous-account")
withr::defer(removeAccount(extraLocalAccount))
deployApp(
appName = "Desired name here",
appDir = sourcePath,
server = "posit.cloud",
account = testAccount,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = TRUE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
mock$reset_calls()
# deploy again to test existing deployment path
deployApp(
appDir = sourcePath,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
})
test_that("deployDoc() results in correct Cloud API calls", {
skip_on_cran()
skip_if_not_installed("rmarkdown")
local_temp_config()
mock <- deployAppMockServerFactory(expectedAppType = "static", outputState = "active")
mockServer <- mock$server
withr::local_options(rsconnect.http = mockServer$impl)
testAccount <- configureTestAccount()
withr::defer(removeAccount(testAccount))
sourcePath <- test_path("static-with-quarto-yaml")
# Remove local deployment info at end for reproducibility and tidiness.
withr::defer(forgetDeployment(appPath = sourcePath, force = TRUE))
deployDoc(
paste(sourcePath, "slideshow.html", sep = "/"),
appName = "Desired name here",
server = "posit.cloud",
account = testAccount,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = TRUE,
outputStateUpdated = FALSE,
revisionCreated = FALSE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
mock$reset_calls()
# deploy again to test existing deployment path
deployApp(
appDir = sourcePath,
logLevel = "quiet"
)
mock$expect_calls(list(
outputCreated = FALSE,
outputStateUpdated = FALSE,
revisionCreated = TRUE,
bundleCreated = TRUE,
bundleUploaded = TRUE,
bundleReady = TRUE,
deployStarted = TRUE
))
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.