Merge pull request #18 from seroanalytics/delete_session

endpoint to forcibly end a session, including deleting session files

R/api.R

@@ -235,6 +235,18 @@ target_get_individual <- function(req,
     auto_unbox = TRUE, null = "null")
 }
 
+target_delete_session <- function(req) {
+  session_id <- get_or_create_session_id(req)
+  unlink(file.path("uploads", session_id), recursive = TRUE)
+  req$session <- NULL
+  # The plumber::session_cookie hook looks to see if req$cookies contains a
+  # session cookie, and if the session is null, sends a Set-Cookie header
+  # removing the session cookie. For some rason req$cookies isn't being
+  # populated though, so manually doing it here
+  req$cookies <- plumber:::parseCookies(req$HTTP_COOKIE)
+  jsonlite::unbox("OK")
+}
+
 get_paged_ids <- function(ids, current_page, page_length) {
   page_start <- ((current_page - 1) * page_length) + 1
   page_end <- min(length(ids), page_start + (page_length - 1))
@@ -350,6 +362,7 @@ get_or_create_session_id <- function(req) {
   if (is.null(req$session$id)) {
     logger::log_info("Creating new session id")
     req$session$id <- generate_session_id()
+    dir.create(file.path("uploads", req$session$id), recursive = TRUE)
   }
   as.character(req$session$id)
 }

R/router.R

@@ -24,6 +24,8 @@ build_routes <- function(cookie_key = plumber::random_cookie_key(),
   pr$handle(get_datasets())
   pr$handle(get_trace())
   pr$handle(get_individual())
+  pr$handle(options_session())
+  pr$handle(delete_session())
   setup_docs(pr)
 }
 
@@ -79,6 +81,8 @@ prune_inactive_sessions <- function(cache) {
   old_sessions <- setdiff(subdirectories, active_sessions)
   if (length(old_sessions) > 0) {
     logger::log_info("Cleaning up expired sessions")
-    lapply(old_sessions, function(x) fs::dir_delete(file.path("uploads", x)))
+    lapply(old_sessions, function(x) {
+      unlink(file.path("uploads", x), recursive = TRUE)
+    })
   }
 }

R/routes.R

@@ -69,3 +69,17 @@ get_individual <- function() {
                                      page = "numeric"),
     returning = porcelain::porcelain_returning_json("Plotly"))
 }
+
+options_session <- function() {
+  porcelain::porcelain_endpoint$new(
+    "OPTIONS", "/api/session/",
+    function() "OK",
+    returning = porcelain::porcelain_returning_json())
+}
+
+delete_session <- function() {
+  porcelain::porcelain_endpoint$new(
+    "DELETE", "/api/session/",
+    target_delete_session,
+    returning = porcelain::porcelain_returning_json())
+}

tests/testthat/setup.R

@@ -2,6 +2,8 @@
 set.seed(1)
 dir.create("uploads")
 schema_root <- file.path(system.file("schema", package = "serovizr"))
+
+# test fixtures
 session_id <- generate_session_id()
 cookie_key <- plumber::random_cookie_key()
 session <- list(id = session_id)

tests/testthat/test-router.R

@@ -140,3 +140,28 @@ test_that("requests without trailing slash are redirected", {
   res_api <- router$request("GET", "/api/version")
   expect_equal(res_api$status, 307)
 })
+
+test_that("DELETE /session", {
+  router <- build_routes(cookie_key)
+  local_add_dataset(data.frame(biomarker = c("ab", "ba"),
+                               value = 1,
+                               day = 1:10,
+                               age = "0-5",
+                               sex = c("M", "F")),
+                    "testdataset")
+  res <- router$call(make_req("GET",
+                              "/datasets/",
+                              HTTP_COOKIE = cookie))
+  # expect the session cookie to be set and upload dir created
+  expect_true(grepl("serovizr=[a-zA-Z0-9_%]+;", res$headers[["Set-Cookie"]]))
+  expect_true(fs::dir_exists(file.path("uploads", session_id)))
+
+  res <- router$call(make_req("DELETE",
+                              "/session/",
+                              HTTP_COOKIE = cookie))
+  expect_equal(res$status, 200)
+
+  # expect the session cookie to be unset and upload dir deleted
+  expect_true(grepl("serovizr=;", res$headers[["Set-Cookie"]]))
+  expect_false(fs::dir_exists(file.path("uploads", session_id)))
+})