trailong slash and add Rook

DESCRIPTION

@@ -25,5 +25,6 @@ Suggests:
     fs,
     lintr (>= 3.1.2),
     readr,
+    Rook,
     testthat,
     withr

R/router.R

@@ -1,4 +1,5 @@
 build_routes <- function() {
+  plumber::options_plumber(trailingSlash = TRUE)
   pr <- porcelain::porcelain$new(validate = TRUE)
   pr$registerHook(stage = "preserialize", function(data, req, res, value) {
     res$setHeader("Access-Control-Allow-Origin", "http://localhost:3000")
@@ -7,7 +8,7 @@ build_routes <- function() {
 
   pr$handle(get_root())
   pr$handle(get_version())
-  pr$handle("POST", "/dataset",
+  pr$handle("POST", "/dataset/",
             function(req, res) target_post_dataset(req, res),
             serializer = plumber::serializer_unboxed_json(null = "null"))
   pr$handle(get_dataset())
@@ -27,30 +28,30 @@ get_root <- function() {
 get_version <- function() {
   porcelain::porcelain_endpoint$new(
     "GET",
-    "/version",
+    "/version/",
     target_get_version,
     returning = porcelain::porcelain_returning_json("Version"))
 }
 
 get_dataset <- function() {
   porcelain::porcelain_endpoint$new(
-    "GET", "/dataset/<name>",
+    "GET", "/dataset/<name>/",
     target_get_dataset,
     returning = porcelain::porcelain_returning_json("DatasetMetadata"))
 }
 
 get_datasets <- function() {
   porcelain::porcelain_endpoint$new(
     "GET",
-    "/datasets",
+    "/datasets/",
     target_get_datasets,
     returning = porcelain::porcelain_returning_json("DatasetNames"))
 }
 
 get_trace <- function() {
   porcelain::porcelain_endpoint$new(
     "GET",
-    "/dataset/<name>/trace/<biomarker>",
+    "/dataset/<name>/trace/<biomarker>/",
     target_get_trace,
     porcelain::porcelain_input_query(disaggregate = "string",
                                      filter = "string"),

tests/testthat/helper.R

@@ -42,7 +42,7 @@ local_POST_dataset_request <- function(dat, filename, xcol = "day",
     }
   }, envir = env)
 
-  make_req("POST", "/dataset",
+  make_req("POST", "/dataset/",
            body = request_body,
            CONTENT_LENGTH = nchar(request_body),
            CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryvbfCGA1r00d8B0Vv")
@@ -67,7 +67,7 @@ local_POST_dataset_request_bad_file <- function(env = parent.frame()) {
     }
   }, envir = env)
 
-  make_req("POST", "/dataset",
+  make_req("POST", "/dataset/",
            body = request_body,
            CONTENT_LENGTH = nchar(request_body),
            CONTENT_TYPE = "multipart/form-data; boundary=----WebKitFormBoundaryvbfCGA1r00d8B0Vv")

tests/testthat/test-read.R

@@ -1,6 +1,6 @@
 test_that("GET /dataset<name> returns 404 if dataset not found", {
   router <- build_routes()
-  res <- router$request("GET", "/dataset/testdataset")
+  res <- router$request("GET", "/dataset/testdataset/")
   expect_equal(res$status, 404)
   validate_failure_schema(res$body)
   body <- jsonlite::fromJSON(res$body)
@@ -10,7 +10,7 @@ test_that("GET /dataset<name> returns 404 if dataset not found", {
 
 test_that("GET /trace/<biomarker> returns 404 if dataset not found", {
   router <- build_routes()
-  res <- router$request("GET", "/dataset/testdataset/trace/ab")
+  res <- router$request("GET", "/dataset/testdataset/trace/ab/")
   expect_equal(res$status, 404)
   validate_failure_schema(res$body)
   body <- jsonlite::fromJSON(res$body)
@@ -30,7 +30,7 @@ test_that("can get trace for uploaded dataset with xcol", {
   router <- build_routes()
   res <- router$call(request)
   expect_equal(res$status, 200)
-  res <- router$request("GET", "/dataset/testdata/trace/ab")
+  res <- router$request("GET", "/dataset/testdata/trace/ab/")
   expect_equal(res$status, 200)
   expected_warnings <- list("span too small.   fewer data values than degrees of freedom.",
                             "pseudoinverse used at 0.96",
@@ -62,7 +62,7 @@ test_that("can get disgagregated traces", {
   local_add_dataset(dat,
                     "testdataset")
   router <- build_routes()
-  res <- router$request("GET", "/dataset/testdataset/trace/ab",
+  res <- router$request("GET", "/dataset/testdataset/trace/ab/",
                         query = list(disaggregate = "sex"))
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
@@ -89,7 +89,7 @@ test_that("can get filtered traces", {
   local_add_dataset(dat,
                     "testdataset")
   router <- build_routes()
-  res <- router$request("GET", "/dataset/testdataset/trace/ab",
+  res <- router$request("GET", "/dataset/testdataset/trace/ab/",
                         query = list(filter = "sex:M"))
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
@@ -109,7 +109,7 @@ test_that("can get disgagregated and filtered traces", {
   local_add_dataset(dat,
                     "testdataset")
   router <- build_routes()
-  res <- router$request("GET", "/dataset/testdataset/trace/ab",
+  res <- router$request("GET", "/dataset/testdataset/trace/ab/",
                         query = list(disaggregate = "age", filter = "sex:M"))
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)

tests/testthat/test-router.R

@@ -19,7 +19,7 @@ test_that("GET /version", {
   expect_equal(res, jsonlite::unbox(as.character(packageVersion("serovizr"))))
 
   router <- build_routes()
-  res_api <- router$request("GET", "/version")
+  res_api <- router$request("GET", "/version/")
   expect_equal(res_api$status, 200)
   body <- jsonlite::fromJSON(res_api$body)
   expect_equal(unclass(res), unclass(body$data))
@@ -51,7 +51,7 @@ test_that("GET /datasets", {
   local_add_dataset(data.frame(biomarker = "ab", value = 1, day = 1:10),
                     "anotherdataset")
   router <- build_routes()
-  res <- router$request("GET", "/datasets")
+  res <- router$request("GET", "/datasets/")
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
   expect_equal(body$data, c("anotherdataset", "testdataset"))
@@ -65,7 +65,7 @@ test_that("GET /dataset<name>", {
                                sex = c("M", "F")),
                     "testdataset")
   router <- build_routes()
-  res <- router$request("GET", "/dataset/testdataset")
+  res <- router$request("GET", "/dataset/testdataset/")
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
   expect_equal(body$data$variables$name, c("age", "sex"))
@@ -89,7 +89,7 @@ test_that("GET /dataset/<name>/trace/<biomarker>", {
   })
   router <- build_routes()
   set.seed(1)
-  res <- router$request("GET", "/dataset/testdataset/trace/ab")
+  res <- router$request("GET", "/dataset/testdataset/trace/ab/")
   expect_equal(res$status, 200)
   expected_warnings <- list("span too small.   fewer data values than degrees of freedom.",
                             "pseudoinverse used at 0.96",
@@ -107,3 +107,9 @@ test_that("GET /dataset/<name>/trace/<biomarker>", {
   body <- jsonlite::fromJSON(res$body)
   expect_equal(body$data, jsonlite::fromJSON(expected))
 })
+
+test_that("requests without trailing slash are redirected", {
+  router <- build_routes()
+  res_api <- router$request("GET", "/version")
+  expect_equal(res_api$status, 307)
+})

tests/testthat/test-upload.R

@@ -91,7 +91,7 @@ test_that("can get uploaded dataset metadata with default xcol", {
   res <- router$call(request)
   expect_equal(res$status, 200)
 
-  res <- router$request("GET", "/dataset/testdata")
+  res <- router$request("GET", "/dataset/testdata/")
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
   expect_equal(body$data$variables$name, c("age", "sex"))
@@ -112,7 +112,7 @@ test_that("can get uploaded dataset metadata with xcol", {
   res <- router$call(request)
   expect_equal(res$status, 200)
 
-  res <- router$request("GET", "/dataset/testdata")
+  res <- router$request("GET", "/dataset/testdata/")
   expect_equal(res$status, 200)
   body <- jsonlite::fromJSON(res$body)
   expect_equal(body$data$variables$name, c("age", "sex"))