also support name

seroanalytics · Sep 22, 2024 · b86573c · b86573c
1 parent 8e48558
commit b86573c
Show file tree

Hide file tree

Showing 4 changed files with 65 additions and 12 deletions.
diff --git 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 <- parsed$xcol
+  name <- parsed$name
   if (is.null(xcol)) {
     res$status <- 400L
     msg <- "Missing required field: xcol."
@@ -24,16 +25,19 @@ target_post_dataset <- function(req, res) {
     return(bad_request_response(msg))
   }
   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))
+  if (is.null(name)) {
+    filename <- parsed$file$name
+    file_ext <- tools::file_ext(filename)
+    if (nchar(file_ext) > 0) {
+      filename <- stringr::str_remove_all(filename,
+                                          paste0(".", file_ext))
+    }
+    name <- filename
   }
-  path <- file.path("uploads", session_id, filename)
+  path <- file.path("uploads", session_id, name)
   if (dir.exists(path)) {
     res$status <- 400L
-    msg <- paste(filename, "already exists.",
+    msg <- paste(name, "already exists.",
                  "Please choose a unique name for this dataset.")
     return(bad_request_response(msg))
   }
@@ -63,12 +67,12 @@ target_post_dataset <- function(req, res) {
     xtype <- "number"
   }
 
-  logger::log_info(paste("Saving dataset", filename, "to disk"))
+  logger::log_info(paste("Saving dataset", name, "to disk"))
   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"))
-  response_success(jsonlite::unbox(filename))
+  response_success(jsonlite::unbox(name))
 }
 
 target_delete_dataset <- function(name, req) {

diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R
@@ -24,14 +24,15 @@ local_add_dataset <- function(dat, name, session = session_id, env = parent.fram
   write("day", file.path(filepath, "xcol"))
   write("number", file.path(filepath, "xtype"))
   withr::defer({
-    if (dir.exists(filepath)){
+    if (dir.exists(filepath)) {
       fs::dir_delete(filepath)
     }
   }, envir = env)
   name
 }
 
-local_POST_dataset_request <- function(dat, filename, xcol = "day",
+local_POST_dataset_request <- function(dat, filename,
+                                       xcol = "day",
                                        env = parent.frame(),
                                        session = session_id,
                                        cookie = "") {
@@ -83,6 +84,40 @@ local_POST_dataset_request_no_xcol <- function(dat, filename,
            CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryvbfCGA1r00d8B0Vv")
 }
 
+local_POST_dataset_request_with_name <- function(dat,
+                                                 filename,
+                                                 name,
+                                                 xcol = "day",
+                                                 env = parent.frame(),
+                                                 cookie = cookie) {
+  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, EOL,
+                         "Content-Disposition: form-data; name=\"xcol\"", EOL, EOL,
+                         xcol, EOL,
+                         boundary, EOL,
+                         "Content-Disposition: form-data; name=\"name\"", EOL, EOL,
+                         name, EOL,
+                         boundary, "--")
+  filepath <- file.path("uploads", session_id, 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),
+           HTTP_COOKIE = cookie,
+           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-router.R b/tests/testthat/test-router.R
@@ -55,7 +55,7 @@ test_that("DELETE /dataset", {
                               HTTP_COOKIE = cookie))
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
-  expect_equal(body$data, "OK")
+  expect_equal(body$data, "testdataset")
 })
 
 test_that("DELETE /dataset returns 404 if not found", {

diff --git a/tests/testthat/test-upload.R b/tests/testthat/test-upload.R
@@ -75,6 +75,20 @@ test_that("can upload dataset with different xcol", {
   expect_equal(res$status, 200)
 })
 
+test_that("can upload dataset with different name", {
+  router <- build_routes(cookie_key)
+  request <- local_POST_dataset_request_with_name(data.frame(biomarker = "ab",
+                                                             day = 1:10,
+                                                             value = 1),
+                                                  "testdataset",
+                                                  name = "othername",
+                                                  cookie = cookie)
+  res <- router$call(request)
+  expect_equal(res$status, 200)
+  body <- jsonlite::fromJSON(res$body)
+  expect_equal(body$data, "othername")
+})
+
 test_that("uploading wrong file type returns 400", {
   router <- build_routes()
   request <- local_POST_dataset_request_bad_file()