diff --git a/R/api.R b/R/api.R index 842c584..659731a 100644 --- a/R/api.R +++ b/R/api.R @@ -13,6 +13,7 @@ target_post_dataset <- function(req, res) { logger::log_info("Parsing multipart form request") parsed <- mime::parse_multipart(req) xcol <- get_xcol(parsed) + series_type <- parsed$series_type name <- get_dataset_name(parsed) if (is.null(parsed$file$type) || parsed$file$type != "text/csv") { return(invalid_file_type(res)) @@ -35,17 +36,18 @@ target_post_dataset <- function(req, res) { } logger::log_info(paste("Saving dataset", name, "to disk")) - save_dataset(path, file_body, xcol) + save_dataset(path, file_body, xcol, series_type) response_success(jsonlite::unbox(name)) } -save_dataset <- function(path, file_body, xcol) { +save_dataset <- function(path, file_body, xcol, series_type) { xtype <- get_xtype(file_body[, xcol]) dir.create(path, recursive = TRUE) utils::write.csv(file_body, file.path(path, "data"), row.names = FALSE) write(xcol, file.path(path, "xcol")) write(xtype, file.path(path, "xtype")) + write(series_type, file.path(path, "series_type")) } get_parsed_values <- function(raw_values) { @@ -111,6 +113,7 @@ target_get_dataset <- function(name, req) { logger::log_info(paste("Found dataset:", name)) dat <- dataset$data xcol <- dataset$xcol + series_type <- dataset$series_type cols <- setdiff(colnames(dat), c("value", "biomarker", xcol)) if (length(cols) == 0) { logger::log_info("No covariates detected") @@ -128,7 +131,8 @@ target_get_dataset <- function(name, req) { } list(variables = unname(variables), biomarkers = biomarkers, - xcol = jsonlite::unbox(xcol)) + xcol = jsonlite::unbox(xcol), + type = jsonlite::unbox(series_type)) } target_get_datasets <- function(req) { @@ -293,11 +297,12 @@ read_dataset <- function(req, name, scale) { } xcol <- readLines(file.path(path, "xcol")) xtype <- readLines(file.path(path, "xtype")) + series_type <- readLines(file.path(path, "series_type")) logger::log_info("Parsing x column values") if (xtype == "date") { dat[, xcol] <- as.Date(dat[, xcol], origin = "1970-01-01") } - list(data = dat, xcol = xcol, xtype = xtype) + list(data = dat, xcol = xcol, xtype = xtype, series_type = series_type) } model_out <- function(dat, xcol, diff --git a/inst/schema/DatasetMetadata.schema.json b/inst/schema/DatasetMetadata.schema.json index e78b19d..b04cdbd 100644 --- a/inst/schema/DatasetMetadata.schema.json +++ b/inst/schema/DatasetMetadata.schema.json @@ -16,12 +16,16 @@ }, "xcol": { "type": "string" + }, + "type": { + "enum": ["surveillance", "post-exposure"] } }, "additionalProperties": false, "required": [ "variables", "biomarkers", - "xcol" + "xcol", + "type" ] } diff --git a/inst/spec.yaml b/inst/spec.yaml index db881bb..940d754 100644 --- a/inst/spec.yaml +++ b/inst/spec.yaml @@ -142,6 +142,7 @@ paths: - ab_unit - ab_spike xcol: day_of_study + type: surveillance '404': description: Dataset with the given name not found content: diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 66a21a3..a66f74d 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -23,6 +23,7 @@ local_add_dataset <- function(dat, name, session = session_id, env = parent.fram write.csv(dat, file.path(filepath, "data"), row.names = FALSE) write("day", file.path(filepath, "xcol")) write("number", file.path(filepath, "xtype")) + write("surveillance", file.path(filepath, "series_type")) withr::defer({ if (dir.exists(filepath)) { fs::dir_delete(filepath) @@ -33,6 +34,7 @@ local_add_dataset <- function(dat, name, session = session_id, env = parent.fram local_POST_dataset_request <- function(dat, filename, xcol = "day", + series_type = "surveillance", env = parent.frame(), session = session_id, cookie = "") { @@ -44,6 +46,9 @@ local_POST_dataset_request <- function(dat, filename, "Content-Type: text/csv", EOL, EOL, readr::format_csv(dat, eol = EOL), EOL, boundary, EOL, + "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL, + series_type, EOL, + boundary, EOL, "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL, xcol, EOL, boundary, "--") @@ -70,6 +75,9 @@ local_POST_dataset_request_no_xcol <- function(dat, filename, EOL, "Content-Type: text/csv", EOL, EOL, readr::format_csv(dat, eol = EOL), EOL, + boundary, EOL, + "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL, + "surveillance", EOL, boundary, "--") filepath <- file.path("uploads", session_id, filename) withr::defer({ @@ -88,6 +96,7 @@ local_POST_dataset_request_with_name <- function(dat, filename, name, xcol = "day", + series_type = "surveillance", env = parent.frame(), cookie = cookie) { EOL <- "\r\n" @@ -101,6 +110,9 @@ local_POST_dataset_request_with_name <- function(dat, "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL, xcol, EOL, boundary, EOL, + "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL, + series_type, EOL, + boundary, EOL, "Content-Disposition: form-data; name=\"name\"", EOL, EOL, name, EOL, boundary, "--") @@ -128,6 +140,9 @@ local_POST_dataset_request_bad_file <- function(env = parent.frame()) { "Content-Type: image/png", EOL, EOL, "1234", EOL, boundary, EOL, + "Content-Disposition: form-data; name=\"series_type\"", EOL, EOL, + "surveillance", EOL, + boundary, EOL, "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL, "day", EOL, boundary, "--") diff --git a/tests/testthat/test-upload.R b/tests/testthat/test-upload.R index ad9b275..4d110a8 100644 --- a/tests/testthat/test-upload.R +++ b/tests/testthat/test-upload.R @@ -100,13 +100,14 @@ test_that("uploading wrong file type returns 400", { "Invalid file type; please upload file of type text/csv.") }) -test_that("saves file and xcol", { +test_that("saves file, xcol and series_type", { router <- build_routes(cookie_key) request <- local_POST_dataset_request(data.frame(biomarker = "ab", time = 1:10, value = 1), filename = "testdataset", xcol = "time", + series_type = "surveillance", cookie = cookie) res <- router$call(request) expect_equal(res$status, 200) @@ -115,6 +116,8 @@ test_that("saves file and xcol", { expect_equal(nrow(dat), 10) xcol <- readLines(file.path("uploads", session_id, "/testdataset/xcol")) expect_equal(xcol, "time") + xcol <- readLines(file.path("uploads", session_id, "/testdataset/series_type")) + expect_equal(xcol, "surveillance") }) test_that("can get uploaded dataset metadata with default xcol", { @@ -140,14 +143,16 @@ test_that("can get uploaded dataset metadata with default xcol", { expect_equal(body$data$xcol, "day") }) -test_that("can get uploaded dataset metadata with xcol", { +test_that("can get uploaded dataset metadata with xcol and series_type", { request <- local_POST_dataset_request(data.frame(biomarker = c("ab", "ba"), value = 1, time = 1:10, age = "0-5", sex = c("M", "F")), "testdata", - xcol = "time", cookie = cookie) + xcol = "time", + series_type = "post-exposure", + cookie = cookie) router <- build_routes(cookie_key) res <- router$call(request) expect_equal(res$status, 200) @@ -160,6 +165,7 @@ test_that("can get uploaded dataset metadata with xcol", { expect_equal(body$data$variables$levels, list(c("0-5"), c("M", "F"))) expect_equal(body$data$biomarkers, c("ab", "ba")) expect_equal(body$data$xcol, "time") + expect_equal(body$data$type, "post-exposure") }) test_that("can get uploaded dataset without covariates", {