basic tests for dataset endpoints

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]]))
     }))

inst/schema/UploadResult.schema.json

@@ -0,0 +1,4 @@
+{
+  "$schema": "http://json-schema.org/draft-04/schema#",
+  "type": "string"
+}

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")
+}

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())

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"))
 })

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"