cleanup logic

DESCRIPTION

@@ -11,6 +11,7 @@ Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.3.1
 Imports:
     base64enc,
+    cachem,
     docopt,
     jsonlite,
     logger,

R/api.R

@@ -42,7 +42,7 @@ target_post_dataset <- function(req, res) {
   if (length(missing_cols) > 0) {
     res$status <- 400L
     msg <- paste("Missing required columns:",
-                                 paste(missing_cols, collapse = ", "))
+                 paste(missing_cols, collapse = ", "))
     return(bad_request_response(msg))
   }
 
@@ -101,9 +101,9 @@ target_get_trace <- function(name,
     filters <- strsplit(filter, "+", fixed = TRUE)[[1]]
     logger::log_info(paste("Filtering by variables:", paste(filters,
                                                             collapse = ", ")))
-   for (f in filters) {
-     dat <- apply_filter(f, dat, cols)
-   }
+    for (f in filters) {
+      dat <- apply_filter(f, dat, cols)
+    }
   }
   dat <- dat[dat["biomarker"] == biomarker, ]
   if (length(disaggregate) > 0) {
@@ -191,5 +191,10 @@ get_or_create_session_id <- function(req) {
 }
 
 generate_session_id <- function() {
-  rawToChar(as.raw(sample(c(65:90, 97:122), 10, replace = TRUE)))
+  tolower(rawToChar(sample(c(as.raw(sample(c(65:90, 97:122),
+                                           5,
+                                           replace = TRUE)),
+                             as.raw(sample(48:57,
+                                           5,
+                                           replace = TRUE))))))
 }

R/router.R

@@ -1,4 +1,5 @@
-build_routes <- function(cookie_key = plumber::random_cookie_key()) {
+build_routes <- function(cookie_key = plumber::random_cookie_key(),
+                         cache = cachem::cache_mem(max_age = 60)) {
   if (!dir.exists("uploads")) {
     dir.create("uploads")
   }
@@ -11,12 +12,19 @@ build_routes <- function(cookie_key = plumber::random_cookie_key()) {
       res$setHeader("Access-Control-Allow-Origin", req$HTTP_ORIGIN)
       res$setHeader("Access-Control-Allow-Credentials", "true")
     }
+
+    if (!is.null(req$session$id)) {
+      id <- as.character(req$session$id)
+      cache$set(id, TRUE)
+    }
+    prune_inactive_sessions(cache)
     value
   })
 
   pr$registerHooks(plumber::session_cookie(cookie_key,
                                            name = "serovizr",
-                                           path = "/"))
+                                           path = "/",
+                                           expiration = 60))
 
   pr$handle(get_root())
   pr$handle(get_version())
@@ -68,3 +76,13 @@ get_trace <- function() {
                                      filter = "string"),
     returning = porcelain::porcelain_returning_json("DataSeries"))
 }
+
+prune_inactive_sessions <- function(cache) {
+  active_sessions <- cache$keys()
+  subdirectories <- list.files("uploads")
+  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)))
+  }
+}

tests/testthat/test-router.R

@@ -117,4 +117,4 @@ test_that("requests without trailing slash are redirected", {
   router <- build_routes()
   res_api <- router$request("GET", "/version")
   expect_equal(res_api$status, 307)
-})
+})