diff --git a/R/api.R b/R/api.R index d75b123..cc56323 100644 --- a/R/api.R +++ b/R/api.R @@ -10,12 +10,15 @@ target_post_dataset <- function(req, res) { logger::log_info("Parsing multipart form request") parsed <- mime::parse_multipart(req) xcol <- parsed$xcol + if (is.null(xcol)) { + res$status <- 400L + msg <- "Missing required field: xcol." + return(bad_request_response(msg)) + } if (is.null(parsed$file$type) || parsed$file$type != "text/csv") { res$status <- 400L msg <- "Invalid file type; please upload file of type text/csv." - error <- list(error = "BAD_REQUEST", - detail = msg) - return(list(status = "failure", errors = list(error), data = NULL)) + return(bad_request_response(msg)) } file_body <- utils::read.csv(parsed$file$datapath) filename <- parsed$file$name @@ -29,18 +32,15 @@ target_post_dataset <- function(req, res) { res$status <- 400L msg <- paste(filename, "already exists.", "Please choose a unique name for this dataset.") - error <- list(error = "BAD_REQUEST", - detail = msg) - return(list(status = "failure", errors = list(error), data = NULL)) + return(bad_request_response(msg)) } required_cols <- c("value", "biomarker", xcol) missing_cols <- required_cols[!(required_cols %in% colnames(file_body))] if (length(missing_cols) > 0) { res$status <- 400L - error <- list(error = "BAD_REQUEST", - detail = paste("Missing required columns:", - paste(missing_cols, collapse = ", "))) - return(list(status = "failure", errors = list(error), data = NULL)) + msg <- paste("Missing required columns:", + paste(missing_cols, collapse = ", ")) + return(bad_request_response(msg)) } logger::log_info(paste("Saving dataset", filename, "to disk")) @@ -169,3 +169,9 @@ apply_filter <- function(filter, dat, cols) { } dat[dat[filter_var] == filter_level,] } + +bad_request_response <- function(msg) { + error <- list(error = "BAD_REQUEST", + detail = msg) + return(list(status = "failure", errors = list(error), data = NULL)) +} diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index 16f5a37..d0f315f 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -48,6 +48,29 @@ local_POST_dataset_request <- function(dat, filename, xcol = "day", CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryvbfCGA1r00d8B0Vv") } +local_POST_dataset_request_no_xcol <- function(dat, filename, + env = parent.frame()) { + EOL <- "\r\n" + boundary <- "------WebKitFormBoundaryvbfCGA1r00d8B0Vv" + request_body <- paste0(boundary, EOL, + sprintf("Content-Disposition: form-data; name=\"file\"; filename=\"%s\"", filename), + EOL, + "Content-Type: text/csv", EOL, EOL, + readr::format_csv(dat, eol = EOL), EOL, + boundary, "--") + filepath <- file.path("uploads", filename) + withr::defer({ + if (fs::file_exists(filepath)) { + fs::file_delete(filepath) + } + }, envir = env) + + make_req("POST", "/dataset/", + body = request_body, + CONTENT_LENGTH = nchar(request_body), + CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryvbfCGA1r00d8B0Vv") +} + local_POST_dataset_request_bad_file <- function(env = parent.frame()) { filename <- "baddata" EOL <- "\r\n" diff --git a/tests/testthat/test-upload.R b/tests/testthat/test-upload.R index cc4ff16..2dbe48c 100644 --- a/tests/testthat/test-upload.R +++ b/tests/testthat/test-upload.R @@ -120,3 +120,34 @@ test_that("can get uploaded dataset metadata with xcol", { expect_equal(body$data$biomarkers, c("ab", "ba")) expect_equal(body$data$xcol, "time") }) + +test_that("can get uploaded dataset without covariates", { + request <- local_POST_dataset_request(data.frame(biomarker = c("ab", "ba"), + value = 1, + time = 1:10), + "testdata", + xcol = "time") + router <- build_routes() + res <- router$call(request) + expect_equal(res$status, 200) + + res <- router$request("GET", "/dataset/testdata/") + expect_equal(res$status, 200) + body <- jsonlite::fromJSON(res$body) + expect_equal(length(body$data$variables), 0) + expect_equal(body$data$biomarkers, c("ab", "ba")) + expect_equal(body$data$xcol, "time") +}) + +test_that("returns 400 if no xcol", { + request <- local_POST_dataset_request_no_xcol(data.frame(biomarker = c("ab", "ba"), + value = 1, + time = 1:10), + "testdata") + router <- build_routes() + res <- router$call(request) + expect_equal(res$status, 400) + body <- jsonlite::fromJSON(res$body) + expect_equal(body$errors[1, "detail"], + "Missing required field: xcol.") +})