validate xcol

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

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"

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