API spec

DESCRIPTION

@@ -24,9 +24,11 @@ Imports:
     plotly,
     plumber,
     porcelain,
+    redoc,
     rlang,
     stringr,
-    tibble
+    tibble,
+    yaml
 Remotes:
     hillalex/porcelain@i39,
 Suggests:

R/api.R

@@ -96,12 +96,12 @@ get_xcol <- function(parsed) {
 target_delete_dataset <- function(name, req) {
   session_id <- get_or_create_session_id(req)
   path <- file.path("uploads", session_id, name)
-  if (!file.exists(path)) {
-    porcelain::porcelain_stop(paste("Did not find dataset with name:", name),
-                              code = "DATASET_NOT_FOUND", status_code = 404L)
+  if (file.exists(path)) {
+    logger::log_info(paste("Deleting dataset:", name))
+    fs::dir_delete(path)
+  } else {
+    logger::log_info(paste("No dataset found with name", name))
   }
-  logger::log_info(paste("Deleting dataset: ", name))
-  fs::dir_delete(path)
   jsonlite::unbox(name)
 }
 
@@ -194,8 +194,6 @@ target_get_individual <- function(req,
                                     color = NULL,
                                     linetype = NULL,
                                     page = 1) {
-  .data <- value <- NULL
-
   data <- read_dataset(req, name, scale)
   dat <- data$data
   xcol <- data$xcol
@@ -244,6 +242,7 @@ get_paged_ids <- function(ids, current_page, page_length) {
 }
 
 get_aes <- function(color, linetype, xcol) {
+  .data <- value <- NULL
   if (is.null(color)) {
     if (is.null(linetype)) {
       aes <- ggplot2::aes(x = .data[[xcol]], y = value)
@@ -347,12 +346,6 @@ 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))
-}
-
 get_or_create_session_id <- function(req) {
   if (is.null(req$session$id)) {
     logger::log_info("Creating new session id")

R/dataset-validation.R

@@ -1,3 +1,12 @@
+# The POST /dataset endpoint isn't using Porcelain, so we can't use
+# porcelain::porcelain_stop when something goes wrong. Instead we have
+# to manually return failure responses with the desired error messages
+bad_request_response <- function(msg) {
+  error <- list(error = "BAD_REQUEST",
+                detail = msg)
+  return(list(status = "failure", errors = list(error), data = NULL))
+}
+
 invalid_file_type <- function(res) {
   res$status <- 400L
   msg <- "Invalid file type; please upload file of type text/csv."

R/router.R

@@ -5,123 +5,72 @@
   }
   plumber::options_plumber(trailingSlash = TRUE)
   pr <- porcelain::porcelain$new(validate = TRUE)
-  pr$registerHook(stage = "preserialize", function(data, req, res, value) {
-    if (!is.null(req$HTTP_ORIGIN) &&
-      req$HTTP_ORIGIN %in% c("http://localhost:3000", "http://localhost")) {
-      # allow local app and integration tests to access endpoints
-      res$setHeader("Access-Control-Allow-Origin", req$HTTP_ORIGIN)
-      res$setHeader("Access-Control-Allow-Credentials", "true")
-      res$setHeader("Access-Control-Allow-Methods",
-                    c("GET, POST, OPTIONS, PUT, DELETE"))
-    }
-
-    tryCatch({
-      if (!is.null(req$session$id)) {
-        logger::log_info("Updating session cache")
-        id <- as.character(req$session$id)
-        cache$set(id, TRUE)
-      }
-      logger::log_info("Looking for inactive sessions")
-      prune_inactive_sessions(cache)
-    }, error = function(e) logger::log_error(conditionMessage(e)))
-
-    value
-  })
-
+  pr$registerHook(stage = "preserialize", preserialize_hook(cache))
   pr$registerHooks(plumber::session_cookie(cookie_key,
                                            name = "serovizr",
                                            path = "/"))
 
-  pr$filter("logger", function(req, res) {
-    logger::log_info(paste(as.character(Sys.time()), "-",
-                           req$REQUEST_METHOD, req$PATH_INFO, "-",
-                           req$HTTP_USER_AGENT, "@", req$REMOTE_ADDR, "\n"))
-    plumber::forward()
-  })
+  pr$filter("logger", logging_filter)
 
   pr$handle(get_root())
   pr$handle(get_version())
-  pr$handle("POST", "/api/dataset/",
-            function(req, res) target_post_dataset(req, res),
+  # porcelain doesn't support multipart form content yet; for now wire this
+  # endpoint up using plumber arguments instead
+  pr$handle("POST", "/api/dataset/", target_post_dataset,
             serializer = plumber::serializer_unboxed_json(null = "null"))
   pr$handle(options_dataset())
   pr$handle(delete_dataset())
   pr$handle(get_dataset())
   pr$handle(get_datasets())
   pr$handle(get_trace())
   pr$handle(get_individual())
+  setup_docs(pr)
 }
 
-get_root <- function() {
-  porcelain::porcelain_endpoint$new(
-    "GET",
-    "/api/",
-    target_get_root,
-    returning = porcelain::porcelain_returning_json())
-}
-
-get_version <- function() {
-  porcelain::porcelain_endpoint$new(
-    "GET",
-    "/api/version/",
-    target_get_version,
-    returning = porcelain::porcelain_returning_json("Version"))
-}
-
-get_dataset <- function() {
-  porcelain::porcelain_endpoint$new(
-    "GET", "/api/dataset/<name>/",
-    target_get_dataset,
-    returning = porcelain::porcelain_returning_json("DatasetMetadata"))
-}
-
-delete_dataset <- function() {
-  porcelain::porcelain_endpoint$new(
-    "DELETE", "/api/dataset/<name>/",
-    target_delete_dataset,
-    returning = porcelain::porcelain_returning_json())
+logging_filter <- function(req, res) {
+  logger::log_info(paste(as.character(Sys.time()), "-",
+                         req$REQUEST_METHOD, req$PATH_INFO, "-",
+                         req$HTTP_USER_AGENT, "@", req$REMOTE_ADDR, "\n"))
+  plumber::forward()
 }
 
-options_dataset <- function() {
-  porcelain::porcelain_endpoint$new(
-    "OPTIONS", "/api/dataset/<name>/",
-    function(name) "OK",
-    returning = porcelain::porcelain_returning_json())
-}
+preserialize_hook <- function(cache) {
+  function(data, req, res, value) {
+    if (!is.null(req$HTTP_ORIGIN) &&
+      req$HTTP_ORIGIN %in% c("http://localhost:3000", "http://localhost")) {
+      # allow local app and integration tests to access endpoints
+      res$setHeader("Access-Control-Allow-Origin", req$HTTP_ORIGIN)
+      res$setHeader("Access-Control-Allow-Credentials", "true")
+      res$setHeader("Access-Control-Allow-Methods",
+                    c("GET, POST, OPTIONS, PUT, DELETE"))
+    }
 
-get_datasets <- function() {
-  porcelain::porcelain_endpoint$new(
-    "GET",
-    "/api/datasets/",
-    target_get_datasets,
-    returning = porcelain::porcelain_returning_json("DatasetNames"))
-}
+    tryCatch({
+      if (!is.null(req$session$id)) {
+        logger::log_info("Updating session cache")
+        id <- as.character(req$session$id)
+        cache$set(id, TRUE)
+      }
+      logger::log_info("Looking for inactive sessions")
+      prune_inactive_sessions(cache)
+    }, error = function(e) logger::log_error(conditionMessage(e)))
 
-get_trace <- function() {
-  porcelain::porcelain_endpoint$new(
-    "GET",
-    "/api/dataset/<name>/trace/<biomarker>/",
-    target_get_trace,
-    porcelain::porcelain_input_query(disaggregate = "string",
-                                     filter = "string",
-                                     scale = "string",
-                                     method = "string",
-                                     span = "numeric",
-                                     k = "numeric"),
-    returning = porcelain::porcelain_returning_json("DataSeries"))
+    value
+  }
 }
 
-get_individual <- function() {
-  porcelain::porcelain_endpoint$new(
-    "GET",
-    "/api/dataset/<name>/individual/<pidcol>/",
-    target_get_individual,
-    porcelain::porcelain_input_query(scale = "string",
-                                     color = "string",
-                                     filter = "string",
-                                     linetype = "string",
-                                     page = "numeric"),
-    returning = porcelain::porcelain_returning_json("Plotly"))
+setup_docs <- function(pr) {
+  api <- yaml::read_yaml(file.path(system.file("spec.yaml",
+                                               package = "serovizr")),
+                         eval.expr = FALSE)
+  pr$setApiSpec(api)
+  # this is a bit annoying, but setDocs fails if the package isn't
+  # already loaded
+  requireNamespace("redoc")
+  pr$setDocs("redoc")
+  pr$mount("/schema", plumber::PlumberStatic$new(
+    file.path(system.file("schema", package = "serovizr"))))
+  pr
 }
 
 prune_inactive_sessions <- function(cache) {

R/routes.R

@@ -0,0 +1,71 @@
+get_root <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET",
+    "/api/",
+    target_get_root,
+    returning = porcelain::porcelain_returning_json())
+}
+
+get_version <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET",
+    "/api/version/",
+    target_get_version,
+    returning = porcelain::porcelain_returning_json("Version"))
+}
+
+get_dataset <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET", "/api/dataset/<name>/",
+    target_get_dataset,
+    returning = porcelain::porcelain_returning_json("DatasetMetadata"))
+}
+
+delete_dataset <- function() {
+  porcelain::porcelain_endpoint$new(
+    "DELETE", "/api/dataset/<name>/",
+    target_delete_dataset,
+    returning = porcelain::porcelain_returning_json())
+}
+
+options_dataset <- function() {
+  porcelain::porcelain_endpoint$new(
+    "OPTIONS", "/api/dataset/<name>/",
+    function(name) "OK",
+    returning = porcelain::porcelain_returning_json())
+}
+
+get_datasets <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET",
+    "/api/datasets/",
+    target_get_datasets,
+    returning = porcelain::porcelain_returning_json("DatasetNames"))
+}
+
+get_trace <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET",
+    "/api/dataset/<name>/trace/<biomarker>/",
+    target_get_trace,
+    porcelain::porcelain_input_query(disaggregate = "string",
+                                     filter = "string",
+                                     scale = "string",
+                                     method = "string",
+                                     span = "numeric",
+                                     k = "numeric"),
+    returning = porcelain::porcelain_returning_json("DataSeries"))
+}
+
+get_individual <- function() {
+  porcelain::porcelain_endpoint$new(
+    "GET",
+    "/api/dataset/<name>/individual/<pidcol>/",
+    target_get_individual,
+    porcelain::porcelain_input_query(scale = "string",
+                                     color = "string",
+                                     filter = "string",
+                                     linetype = "string",
+                                     page = "numeric"),
+    returning = porcelain::porcelain_returning_json("Plotly"))
+}

README.md

@@ -8,7 +8,29 @@
 ![GitHub License](https://img.shields.io/github/license/seroanalytics/serovizr)
 <!-- badges: end -->
 
-R API for the SeroViz app. Based on the [porcelain](https://github.com/reside-ic/porcelain) framework.
+R API for the SeroViz app. Based on the [porcelain](https://github.com/reside-ic/porcelain) and [plumber](https://github.com/rstudio/plumber) frameworks.
+
+## API Specification
+Docs are available when running the API locally on port 8888, via 
+```
+http://127.0.0.1:8888/__docs__/
+```
+
+The easiest way to run the API locally is via Docker:
+
+``` 
+ docker run -p 8888:8888 seroanalytics/serovizr:main
+```
+
+Alternatively, to run from R, first clone this repo and then from this directory run:
+
+```r
+  devtools::load_all()
+  serovizr:::main()
+```
+
+The docs are maintained via an [openapi](https://www.openapis.org/) specification
+contained in `inst/spec.yaml`, and [JSON Schema](https://json-schema.org/) files in `inst/schema`.
 
 ## Developing
 Install dependencies with:
@@ -35,20 +57,20 @@ devtools::test()
 
 To build a Docker image:
 
-``` r
+``` 
 ./docker/build
 ```
 
 To push to Dockerhub:
 
-``` r
+``` 
 ./docker/push
 ```
 
 
 To run a built image:
 
-``` r
+``` 
  docker run -p 8888:8888 seroanalytics/serovizr:<branch-name>
 ```
 

docker/Dockerfile

@@ -23,10 +23,12 @@ RUN install_packages --repo=https://mrc-ide.r-universe.dev \
         jsonvalidate \
         plotly \
         plumber \
+        redoc \
         remotes \
         Rook \
         stringr \
-        tibble
+        tibble \
+        yaml
 
 RUN Rscript -e "install.packages('remotes')"
 RUN Rscript -e 'remotes::install_github("hillalex/porcelain@i39")'

inst/schema/ErrorDetail.schema.json

@@ -9,6 +9,6 @@
       "type": ["string", "null"]
     }
   },
-  "additionalProperties": true,
+  "additionalProperties": false,
   "required": [ "error", "detail" ]
 }

inst/schema/ResponseFailure.schema.json

@@ -16,5 +16,5 @@
     }
   },
   "required": ["status", "data", "errors"],
-  "additionalProperties": true
+  "additionalProperties": false
 }