Nothing
test_that("dsDisconnect calls /logout endpoint ", {
post <- mock()
with_mock(
"httr::POST" = post,
dsDisconnect(connection)
)
expect_called(post, 1)
expect_args(post, 1,
handle = handle,
path = "/logout",
config = httr::add_headers("Authorization" = "Bearer token"))
})
test_that("dsDisconnect saves the workspace", {
post <- mock(list(status_code = 200), cycle = TRUE)
with_mock(
"httr::POST" = post,
dsDisconnect(connection, save = "keepit")
)
expect_called(post, 2)
expect_args(post, 1,
handle = handle,
path = "/workspaces/keepit",
config = httr::add_headers("Authorization" = "Bearer token"))
})
test_that("dsListProfiles retrieves profiles", {
profiles <- list(
available = list("default", "exposome"),
current = "exposome")
get <- mock(list(status_code = 200))
content <- mock(profiles)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListProfiles(connection)
)
expect_args(get, 1,
handle = handle,
path = "/profiles",
config = httr::add_headers("Authorization" = "Bearer token"))
expect_equal(result, profiles)
})
test_that("dsListProfiles returns default result if none found", {
get <- mock(list(status_code = 404))
content <- mock(profiles)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListProfiles(connection)
)
expect_args(get, 1,
handle = handle,
path = "/profiles",
config = httr::add_headers("Authorization" = "Bearer token"))
expect_equal(result, list(
available = "default",
current = "default"
))
})
test_that("dsListTables retrieves tables", {
tables <- list("a", "b")
get <- mock(list(status_code = 200))
content <- mock(tables)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListTables(connection)
)
expect_args(get, 1,
handle = handle,
path = "/tables",
config = httr::add_headers("Authorization" = "Bearer token"))
expect_equal(result, unlist(tables))
})
test_that("dsListResources retrieves resources", {
resources <- list("a", "b")
get <- mock(list(status_code = 200))
content <- mock(resources)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListResources(connection)
)
expect_args(get, 1,
handle = handle,
path = "/resources",
config = httr::add_headers("Authorization" = "Bearer token"))
expect_equal(result, unlist(resources))
})
test_that("dsHasTable returns TRUE if table exists", {
head <- mock(list(status_code = 200))
with_mock(
"httr::HEAD" = head,
expect_true(dsHasTable(connection, "project/folder/name.parquet"))
)
expect_args(head, 1,
handle = handle,
path = "/tables/project/folder/name.parquet",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsHasTable returns FALSE if table doesnot exist", {
head <- mock(list(status_code = 404))
with_mock(
"httr::HEAD" = head,
expect_false(dsHasTable(connection, "project/folder/name.parquet"))
)
expect_args(head, 1,
handle = handle,
path = "/tables/project/folder/name.parquet",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsHasResource returns TRUE if resource exists", {
head <- mock(list(status_code = 200))
with_mock(
"httr::HEAD" = head,
expect_true(dsHasResource(connection, "project/folder/name"))
)
expect_args(head, 1,
handle = handle,
path = "/resources/project/folder/name",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsHasResource returns FALSE if table doesnot exist", {
head <- mock(list(status_code = 404))
with_mock(
"httr::HEAD" = head,
expect_false(dsHasResource(connection, "project/folder/name"))
)
expect_args(head, 1,
handle = handle,
path = "/resources/project/folder/name",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsIsAsync returns boolean list", {
expect_equal(
dsIsAsync(connection),
list(
aggregate = TRUE,
assignTable = TRUE,
assignResource = TRUE,
assignExpr = TRUE
)
)
})
test_that("dsListSymbols returns symbols", {
symbols <- list("a", "b")
get <- mock(list(status_code = 200))
content <- mock(symbols)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListSymbols(connection)
)
expect_args(get, 1,
handle = handle,
path = "/symbols",
config = httr::add_headers("Authorization" = "Bearer token"))
expect_equal(result, unlist(symbols))
})
test_that("dsRmSymbol removes symbol", {
delete <- mock(list(status_code = 200))
result <- with_mock(
"httr::DELETE" = delete,
dsRmSymbol(connection, "D")
)
expect_args(delete, 1,
handle = handle,
path = "/symbols/D",
config = httr::add_headers("Authorization" = "Bearer token"))
})
test_that("dsAssignTable assigns table to symbol", {
post <- mock(list(status_code = 200))
result <- with_mock(
"httr::POST" = post,
dsAssignTable(connection, "D", "project/folder/name.parquet")
)
expect_args(post, 1,
handle = handle,
path = "/load-table",
query = list(
table = "project/folder/name.parquet",
symbol = "D",
async = TRUE
),
config = httr::add_headers("Authorization" = "Bearer token")
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAssignTable allows variable selection", {
post <- mock(list(status_code = 200))
result <- with_mock(
"httr::POST" = post,
dsAssignTable(connection, "D",
"project/folder/name.parquet",
variables = c("foo", "bar")
)
)
expect_args(post, 1,
handle = handle,
path = "/load-table",
query = list(
table = "project/folder/name.parquet",
symbol = "D",
async = TRUE,
variables = "foo,bar"
),
config = httr::add_headers("Authorization" = "Bearer token")
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAssignTable, when called synchronously, waits for result", {
post <- mock(list(status_code = 200))
retry <- mock(list(status_code = 200))
httr_content <- mock(NULL)
result <- with_mock(
"httr::POST" = post,
"httr::RETRY" = retry,
"httr::content" = httr_content,
dsAssignTable(connection, "D", "project/folder/name.parquet")
)
expect_args(post, 1,
handle = handle,
path = "/load-table",
query = list(
table = "project/folder/name.parquet", symbol = "D",
async = TRUE
),
config = httr::add_headers("Authorization" = "Bearer token")
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAssignResource assigns resource to symbol", {
post <- mock(list(status_code = 200))
result <- with_mock(
"httr::POST" = post,
dsAssignResource(connection, "D", "project/folder/name")
)
expect_args(post, 1,
handle = handle,
path = "/load-resource",
query = list(
resource = "project/folder/name",
symbol = "D",
async = TRUE
),
config = httr::add_headers("Authorization" = "Bearer token")
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAssignResource, when called synchronously, waits for result", {
post <- mock(list(status_code = 200))
retry <- mock(list(status_code = 200))
httr_content <- mock(NULL)
result <- with_mock(
"httr::POST" = post,
"httr::RETRY" = retry,
"httr::content" = httr_content,
dsAssignResource(connection, "D", "project/folder/name")
)
expect_args(post, 1,
handle = handle,
path = "/load-resource",
query = list(
resource = "project/folder/name", symbol = "D",
async = TRUE
),
config = httr::add_headers("Authorization" = "Bearer token")
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsListMethods returns assign methods", {
methods <- list(list(
name = "foo",
"function" = "dsBase::foo",
version = "6.0.0-03",
package = "dsBase"
), list(
name = "bar",
"function" = "dsBase::bar",
version = "6.0.0-03",
package = "dsBase"
))
get <- mock(list(status_code = 200))
content <- mock(methods)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListMethods(connection, type = "assign")
)
expect_args(get, 1,
handle = handle,
path = "/methods/assign",
config = httr::add_headers("Authorization" = "Bearer token"))
expected <- tibble(
name = list("foo", "bar"),
value = list("dsBase::foo", "dsBase::bar"),
version = list("6.0.0-03", "6.0.0-03"),
package = list("dsBase", "dsBase"),
type = "assign",
class = "function"
)
expect_equivalent(result, expected)
})
test_that("dsListPackages extracts name and version from packages", {
packages <- list(list(
built = "3.6.3",
libPath = "/usr/local/lib/R/site-library",
name = "minqa",
version = "1.2.4"
), list(
built = "3.6.3",
libPath = "/usr/local/lib/R/site-library",
name = "RANN",
version = "2.6.1"
))
get <- mock(list(status_code = 200))
content <- mock(packages)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListPackages(connection)
)
expect_equivalent(result, tibble(
name = list("minqa", "RANN"),
version = list("1.2.4", "2.6.1")
))
})
test_that("dsListWorkspaces lists workspaces", {
workspaces <- list(
list(
name = "hello",
size = 48L,
ETag = "\"ca5d3a000723844e874b93a65c3888a1-1\"",
lastModified = "2020-05-06T13:09:00.725Z"
),
list(
name = "world",
size = 378L,
ETag = "\"1f45d1a6f13adda1d05adf1f3da4c4ca-1\"",
lastModified = "2020-05-06T13:09:07.617Z"
)
)
get <- mock(list(status_code = 200))
content <- mock(workspaces)
result <- with_mock(
"httr::GET" = get,
"httr::content" = content,
dsListWorkspaces(connection)
)
expect_equivalent(result, tibble(
name = list("hello", "world"),
size = list(48L, 378L),
ETag = list(
"\"ca5d3a000723844e874b93a65c3888a1-1\"",
"\"1f45d1a6f13adda1d05adf1f3da4c4ca-1\""
),
lastAccessDate = list(
"2020-05-06T13:09:00.725Z",
"2020-05-06T13:09:07.617Z"
),
user = NA_character_
))
})
test_that("dsSaveWorkspace saves workspace", {
post <- mock(list(status_code = 201))
with_mock(
"httr::POST" = post,
dsSaveWorkspace(connection, "keepit")
)
expect_args(post, 1,
handle = handle,
path = "/workspaces/keepit",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsRmWorkspace removes workspace", {
delete <- mock(list(status_code = 204))
with_mock(
"httr::DELETE" = delete,
dsRmWorkspace(connection, "keepit")
)
expect_args(delete, 1,
handle = handle,
path = "/workspaces/keepit",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsAssignExpr assigns expression to symbol", {
post <- mock(list(status_code = 200))
result <- with_mock(
"httr::POST" = post,
dsAssignExpr(connection, "D", "ls()")
)
expect_args(post, 1,
handle = handle,
query = list(async = TRUE),
path = "/symbols/D",
body = "ls()",
config = httr::add_headers(c("Content-Type" = "text/plain",
"Authorization" = "Bearer token"))
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAssignExpr deparses function calls in expression", {
post <- mock(list(status_code = 200))
result <- with_mock(
"httr::POST" = post,
dsAssignExpr(connection, "D", call("ls"))
)
expect_args(post, 1,
handle = handle,
query = list(async = TRUE),
path = "/symbols/D",
body = "ls()",
config = httr::add_headers(c("Content-Type" = "text/plain",
"Authorization" = "Bearer token"))
)
})
test_that("dsAssignExpr, when called synchronously, waits for result", {
post <- mock(list(status_code = 200))
retry <- mock(list(status_code = 200))
httr_content <- mock(NULL)
result <- with_mock(
"httr::POST" = post,
"httr::RETRY" = retry,
"httr::content" = httr_content,
dsAssignExpr(connection, "D", "ls()", async = FALSE)
)
expect_args(post, 1,
handle = handle,
query = list(async = FALSE),
path = "/symbols/D",
body = "ls()",
config = httr::add_headers(c("Content-Type" = "text/plain",
"Authorization" = "Bearer token"))
)
expect_args(retry, 1,
verb = "GET",
handle = handle,
path = "/lastresult",
terminate_on = c(200, 404, 401),
config = httr::add_headers(c("Accept" = "application/octet-stream",
"Authorization" = "Bearer token"))
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAggregate executes deparsed query", {
post <- mock(list(status_code = 200))
result <- with_mock(
"httr::POST" = post,
dsAggregate(connection, call("ls"))
)
expect_args(post, 1,
handle = handle,
query = list(async = TRUE),
path = "/execute",
body = "ls()",
config = httr::add_headers(c("Content-Type" = "text/plain",
"Authorization" = "Bearer token"))
)
expect_s4_class(result, "ArmadilloResult")
})
test_that("dsAssignExpr, when called synchronously, waits for result", {
post <- mock(list(status_code = 200))
retry <- mock(list(status_code = 200))
httr_content <- mock(base::serialize("Hello World!", NULL))
result <- with_mock(
"httr::POST" = post,
"httr::RETRY" = retry,
"httr::content" = httr_content,
dsAggregate(connection, "ls()", async = FALSE)
)
expect_args(post, 1,
handle = handle,
query = list(async = FALSE),
path = "/execute",
body = "ls()",
config = httr::add_headers(c("Content-Type" = "text/plain",
"Authorization" = "Bearer token"))
)
expect_args(retry, 1,
verb = "GET",
handle = handle,
path = "/lastresult",
terminate_on = c(200, 404, 401),
config = httr::add_headers(c("Accept" = "application/octet-stream",
"Authorization" = "Bearer token"))
)
expect_s4_class(result, "ArmadilloResult")
expect_equal(dsFetch(result), "Hello World!")
})
test_that("dsAssignExpr handles error when called synchronously", {
post <- mock(list(status_code = 500))
get <- mock(list(status_code = 200))
content <- mock(list(
status = "FAILED",
message = "Error"
))
error <- expect_error(with_mock(
"httr::POST" = post,
"httr::GET" = get,
"httr::content" = content,
dsAggregate(connection, "ls()", async = FALSE)
), "Internal server error: Error")
})
test_that("dsGetInfo returns server info", {
get <- mock(list(status_code = 200))
server_info <- list(
git = list(
branch = "master",
commit = list(
id = "1a8ec4e",
time = "2020-04-29T10:32:51Z"
)
),
build = list(
java = list(version = "11"),
version = "0.0.1-SNAPSHOT",
artifact = "datashield",
name = "datashield",
time = "2020-04-29T13:18:59.833Z",
group = "org.molgenis"
)
)
httr_content <- mock(server_info)
result <- with_mock(
"httr::GET" = get,
"httr::content" = httr_content,
dsGetInfo(connection)
)
expected <- list(
git = server_info$git,
build = server_info$build,
url = connection@handle$url,
name = connection@name,
cookies = connection@cookies
)
expect_equivalent(result, expected)
expect_args(get, 1,
handle = handle,
path = "/actuator/info",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
test_that("dsKeepAlive pings server info endpoint", {
get <- mock(list(status_code = 200))
result <- with_mock(
"httr::GET" = get,
dsKeepAlive(connection)
)
expect_args(get, 1,
handle = handle,
path = "/actuator/info",
config = httr::add_headers("Authorization" = "Bearer token")
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.