From 314a91dbbec076f826f40537eb7c5efb041228ef Mon Sep 17 00:00:00 2001 From: "alex.hill@gmail.com" Date: Mon, 19 Aug 2024 17:27:30 +0100 Subject: [PATCH] basic tests for dataset endpoints --- R/api.R | 26 +++++++------ inst/schema/UploadResult.schema.json | 4 ++ tests/testthat/helper.R | 42 +++++++++++++++++++++ tests/testthat/setup.R | 5 +++ tests/testthat/test-router.R | 32 +++++++++++++--- tests/testthat/testdata/population_data.csv | 5 +++ 6 files changed, 98 insertions(+), 16 deletions(-) create mode 100644 inst/schema/UploadResult.schema.json create mode 100644 tests/testthat/helper.R create mode 100644 tests/testthat/setup.R create mode 100644 tests/testthat/testdata/population_data.csv diff --git a/R/api.R b/R/api.R index 97f893c..64268f9 100644 --- a/R/api.R +++ b/R/api.R @@ -3,16 +3,19 @@ target_get_root <- function() { } target_get_version <- function() { - jsonlite::toJSON(as.character(utils::packageVersion("serovizr")), - auto_unbox = TRUE) + jsonlite::unbox(as.character(utils::packageVersion("serovizr"))) } target_post_dataset <- function(req, res) { - parsed <- Rook::Multipart$parse(req) - file_body <- utils::read.csv(parsed$file$tempfile) - filename <- parsed$file$filename - filename <- stringr::str_remove_all(filename, - paste0(".", tools::file_ext(filename))) + logger::log_info("Parsing multipart form request") + parsed <- mime::parse_multipart(req) + file_body <- utils::read.csv(parsed$file$datapath) + filename <- parsed$file$name + file_ext <- tools::file_ext(filename) + if (nchar(file_ext) > 0) { + filename <- stringr::str_remove_all(filename, + paste0(".", file_ext)) + } path <- file.path("uploads", filename) if (file.exists(path)) { res$status <- 400L @@ -32,8 +35,9 @@ target_post_dataset <- function(req, res) { return(list(status = "failure", errors = list(error), data = NULL)) } + logger::log_info(paste("Saving dataset", filename, "to disk")) utils::write.csv(file_body, path, row.names = FALSE) - return(filename) + porcelain:::response_success(jsonlite::unbox(filename)) } target_get_dataset <- function(name) { @@ -51,8 +55,7 @@ target_get_dataset <- function(name) { } target_get_datasets <- function() { - files <- list.files("uploads") - jsonlite::toJSON(files) + list.files("uploads") } target_get_trace <- function(name, biomarker, facet = NULL, trace = NULL) { @@ -74,8 +77,9 @@ target_get_trace <- function(name, biomarker, facet = NULL, trace = NULL) { if (length(trace) > 0) { logger::log_info(paste("Disaggregating by trace variables", trace)) groups <- split(dat, eval(parse(text = paste("~", trace)))) + nms <- names(groups) return(lapply(seq_along(groups), function(i) { - list(name = jsonlite::unbox(nms[[g]]), + list(name = jsonlite::unbox(nms[[i]]), model = model_out(groups[[i]]), raw = data_out(groups[[i]])) })) diff --git a/inst/schema/UploadResult.schema.json b/inst/schema/UploadResult.schema.json new file mode 100644 index 0000000..78deaeb --- /dev/null +++ b/inst/schema/UploadResult.schema.json @@ -0,0 +1,4 @@ +{ + "$schema": "http://json-schema.org/draft-04/schema#", + "type": "string" +} diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R new file mode 100644 index 0000000..2113703 --- /dev/null +++ b/tests/testthat/helper.R @@ -0,0 +1,42 @@ +make_req <- function(verb = "GET", path = "/", qs = "", body = "", pr = NULL, ...) { + req <- as.environment(list(...)) + req$REQUEST_METHOD <- toupper(verb) + req$PATH_INFO <- path + req$QUERY_STRING <- qs + + if (is.character(body)) { + body <- charToRaw(body) + } + stopifnot(is.raw(body)) + req$rook.input <- Rook::RhttpdInputStream$new(body) + req$pr <- pr + req +} + +local_add_dataset <- function(dat, name, env = parent.frame()) { + filepath <- file.path("uploads", name) + write.csv(dat, file.path("uploads", name)) + withr::defer(fs::file_delete(filepath), envir = env) + name +} + +local_POST_dataset_request <- function(dat, name, env = parent.frame()) { + EOL <- "\r\n" + boundary <- "------WebKitFormBoundaryvbfCGA1r00d8B0Vv" + request_body <- paste0(boundary, EOL, + sprintf("Content-Disposition: form-data; name=\"file\"; filename=\"%s\"", name), + EOL, + "Content-Type: text/csv", EOL, EOL, + readr::format_csv(dat), EOL, EOL, + boundary, "--") + filepath <- file.path("uploads", name) + withr::defer({ + if (fs::file_exists(filepath)) { + fs::file_delete(filepath) + } + }, envir = env) + make_req("POST", "/dataset/", + body = request_body, + CONTENT_LENGTH = length(request_body), + CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryvbfCGA1r00d8B0Vv") +} \ No newline at end of file diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R new file mode 100644 index 0000000..713414f --- /dev/null +++ b/tests/testthat/setup.R @@ -0,0 +1,5 @@ +# Run before any test +dir.create("uploads") + +# Run after all tests +withr::defer(fs::dir_delete("uploads"), teardown_env()) diff --git a/tests/testthat/test-router.R b/tests/testthat/test-router.R index 6771ac3..b8a6408 100644 --- a/tests/testthat/test-router.R +++ b/tests/testthat/test-router.R @@ -1,4 +1,4 @@ -test_that("root endpoint", { +test_that("GET /", { res <- target_get_root() expect_equal(res, jsonlite::unbox("Welcome to serovizr")) @@ -14,13 +14,35 @@ test_that("root endpoint", { expect_equal(res_api$body, res_endpoint$body) }) -test_that("version endpoint", { - res <- jsonlite::fromJSON(target_get_version()) - expect_equal(res, as.character(packageVersion("serovizr"))) +test_that("GET /version", { + res <- target_get_version() + expect_equal(res, jsonlite::unbox(as.character(packageVersion("serovizr")))) router <- build_routes() res_api <- router$request("GET", "/version") expect_equal(res_api$status, 200) body <- jsonlite::fromJSON(res_api$body) - expect_equal(res, body$data) + expect_equal(unclass(res), unclass(body$data)) +}) + +test_that("POST /dataset/", { + router <- build_routes() + request <- local_POST_dataset_request(data.frame(biomarker = "ab", value = 1, day = 1:10), + "testdataset") + res_upload <- router$call(request) + expect_equal(res_upload$status, 200) + body <- jsonlite::fromJSON(res_upload$body) + expect_equal(body$data, "testdataset") +}) + +test_that("GET /datasets/", { + local_add_dataset(data.frame(biomarker = "ab", value = 1, day = 1:10), + "testdataset") + local_add_dataset(data.frame(biomarker = "ab", value = 1, day = 1:10), + "anotherdataset") + router <- build_routes() + res <- router$request("GET", "/datasets/") + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + expect_equal(body$data, c("anotherdataset", "testdataset")) }) diff --git a/tests/testthat/testdata/population_data.csv b/tests/testthat/testdata/population_data.csv new file mode 100644 index 0000000..0cea870 --- /dev/null +++ b/tests/testthat/testdata/population_data.csv @@ -0,0 +1,5 @@ +"pid","day","biomarker","value","age","sex" +"01",0,"abunits_spike",300.1,"[18,49)","Female" +"01",0,"abunits_NCP",30.1,"[18,49)","Female" +"01",10,"abunits_spike",180.5,"[18,49)","Female" +"01",10,"abunits_NCP",18.5,"[18,49)","Female"