#5 add WEBMIDDENS_EXPIRY_SEC env var

Author: sckott

DESCRIPTION

@@ -2,7 +2,7 @@ Package: webmiddens
 Title: Cache Mocked 'HTTP' Requests
 Description: Cache mocked 'HTTP' requests, leveraging 'webmockr'
     for the 'HTTP' request matching.
-Version: 0.0.2.91
+Version: 0.0.2.94
 Authors@R: c(
     person("Scott", "Chamberlain", role = c("aut", "cre"),
         email = "[email protected]", 

R/midden.R

@@ -14,8 +14,17 @@
 #' x <- midden$new()
 #' x
 #' x$init(path = "rainforest3")
-#' x$cache
 #' x
+#' x$cache
+#' x$expire()
+#' x$expire(5)
+#' x$expire()
+#' x$expire(reset = TRUE)
+#' x$expire()
+#' Sys.setenv(WEBMIDDENS_EXPIRY_SEC = 35)
+#' x$expire()
+#' x$expire(reset = TRUE)
+#' x$expire()
 #' # first request is a real HTTP request
 #' x$r(con$get("get", query = list(stuff = "bananas")))
 #' # following requests use the cached response
@@ -47,8 +56,6 @@ midden <- R6::R6Class(
     cache_path = NULL,
     #' @field verbose (logical) verbose or not
     verbose = FALSE,
-    #' @field expiry (integer) expiry time (seconds)
-    expiry = NULL,
 
     #' @description Create a new `midden` object
     #' @param verbose (logical) get messages about whats going on.
@@ -62,7 +69,11 @@ midden <- R6::R6Class(
     #' @param ... ignored
     print = function(x, ...) {
       cat("<midden> ", sep = "\n")
-      cat(paste0("  path: ", self$cache_path), sep = "\n")
+      pth <- if (inherits(self$cache, "HoardClient"))
+        self$cache$cache_path_get()
+      else
+        self$cache_path
+      cat(paste0("  path: ", pth), sep = "\n")
     },
     #' @description an http request code block
     #' @param ... an http request block
@@ -79,7 +90,8 @@ midden <- R6::R6Class(
       res <- force(...)
       stub <- private$make_stub(res$method, res$url, res$content,
         res$request$headers, res$response_headers)
-      checked_stub <- private$in_stored_stubs(stub, expire)
+      exp <- private$set_expiry(expire)
+      checked_stub <- private$in_stored_stubs(stub, exp)
       private$m(paste0("request found: ", checked_stub$found))
       private$m(paste0("request rerun: ", checked_stub$rerun))
       if (!checked_stub$found || (checked_stub$found && checked_stub$rerun)) {
@@ -90,7 +102,7 @@ midden <- R6::R6Class(
           stub <- private$make_stub(res$method, res$url,
             res$content, res$request$headers, res$response_headers)
         }
-        private$cache_stub(stub, expire)
+        private$cache_stub(stub, exp)
       }
       private$webmock_cleanup()
       return(res)
@@ -118,14 +130,30 @@ midden <- R6::R6Class(
       unlink(self$cache$cache_path_get(), TRUE, TRUE)
     },
     #' @description set an expiration time
-    #' @param time (integer) seconds to expire
+    #' @param expire (integer) seconds to expire - OR, set via the
+    #' environment variable `WEBMIDDENS_EXPIRY_SEC`
+    #' @param reset (logical) reset to `NULL`? default: `FALSE`
     #' @return NULL
-    expire = function(time) {
-      self$expiry <- time
+    #' @examples
+    #' z <- midden$new()
+    #' z$expire(35) # set to expire all requests in 35 seconds
+    #' # or set by env var
+    #' Sys.setenv(WEBMIDDENS_EXPIRY_SEC = 35)
+    expire = function(expire = NULL, reset = FALSE) {
+      assert(reset, "logical")
+      if (reset) {
+        private$expiry <- NULL
+        Sys.setenv("WEBMIDDENS_EXPIRY_SEC" = "")
+        return(NULL)
+      }
+      private$set_expiry(expire)
+      # if (!is.null(time)) private$expiry <- time
+      # return(private$expiry)
     }
   ),
 
   private = list(
+    expiry = NULL,
     webmock_init = function() {
       private$m(webmockr::enable())
       private$m(webmockr::webmockr_allow_net_connect())
@@ -200,6 +228,16 @@ midden <- R6::R6Class(
         stop("WEBMIDDENS_TURN_OFF must be logical",
           call. = FALSE)
       assert(x, "logical")
+    },
+    set_expiry = function(expire = NULL) {
+      expire <-
+        expire %||% private$expiry %||%
+        Sys.getenv("WEBMIDDENS_EXPIRY_SEC") %||% NULL
+      if (!is.null(expire))
+        expire <- tryCatch(as.numeric(expire), warning = function(w) w)
+      assert(expire, c("numeric", "integer"))
+      private$expiry <- expire
+      return(private$expiry)
     }
   )
 )

R/zzz.R

@@ -9,3 +9,9 @@ assert <- function(x, y) {
   }
   return(x)
 }
+
+`%||%` <- function(x, y) {
+  if (
+    is.null(x) || length(x) == 0 || all(nchar(x) == 0) || all(is.na(x))
+  ) y else x
+}

man/midden.Rd

@@ -41,7 +41,7 @@ test_that("env vars with midden class", {
   Sys.setenv("WEBMIDDENS_TURN_OFF" = "")
 })
 
-test_that("env vars fail as expected", {
+test_that("env vars fail as expected: WEBMIDDENS_TURN_OFF", {
   x <- midden$new()
   x$init(path = "forest31", type = 'tempdir')
   library(crul)
@@ -59,10 +59,38 @@ test_that("env vars fail as expected", {
   Sys.setenv("WEBMIDDENS_TURN_OFF" = "asdfasdfs")
   expect_error(x$r(con$get("get", query = list(fruit = "apples"))))
 
+  # back to an allowed value
   Sys.setenv("WEBMIDDENS_TURN_OFF" = "true")
   expect_is(x$r(con$get("get", query = list(fruit = "apples"))),
     "HttpResponse")
 
   # reset to default
   Sys.setenv("WEBMIDDENS_TURN_OFF" = "")
 })
+
+test_that("env vars fail as expected: WEBMIDDENS_EXPIRY_SEC", {
+  x <- midden$new()
+  x$init(path = "forest33", type = 'tempdir')
+  library(crul)
+  con <- crul::HttpClient$new("https://httpbin.org")
+
+  # env var not set
+  Sys.setenv("WEBMIDDENS_EXPIRY_SEC" = "")
+  expect_is(x$r(con$get("get", query = list(fruit = "apples"))),
+    "HttpResponse")
+
+  # env var set to something not allowed
+  Sys.setenv("WEBMIDDENS_EXPIRY_SEC" = "foobar")
+  expect_error(x$r(con$get("get", query = list(fruit = "apples"))))
+
+  Sys.setenv("WEBMIDDENS_EXPIRY_SEC" = TRUE)
+  expect_error(x$r(con$get("get", query = list(fruit = "apples"))))
+
+  # back to an allowed value
+  Sys.setenv("WEBMIDDENS_EXPIRY_SEC" = 3)
+  expect_is(x$r(con$get("get", query = list(fruit = "apples"))),
+    "HttpResponse")
+
+  # reset to default
+  Sys.unsetenv("WEBMIDDENS_EXPIRY_SEC")
+})

tests/testthat/test-env_vars.R

@@ -4,7 +4,6 @@ test_that("midden - basic structure, before calling init", {
   mid <- midden$new()
   expect_is(mid, "midden")
   expect_is(mid, "R6")
-  expect_null(mid$expiry)
   expect_null(mid$cach_path)
   expect_null(mid$cache)
   expect_false(mid$verbose)
@@ -19,7 +18,6 @@ test_that("midden - structure after calling init", {
   mid$init(path = "rainforest10", type = 'tempdir')
   expect_is(mid, "midden")
   expect_is(mid, "R6")
-  expect_null(mid$expiry)
   expect_null(mid$cach_path)
   expect_is(mid$cache, "HoardClient")
   expect_true(mid$verbose)
@@ -74,9 +72,9 @@ context('midden: expire method')
 test_that("midden - expire function", {
   library(crul)
   x <- midden$new()
-  expect_null(x$expiry)
+  expect_null(x$expire())
   x$expire(5)
-  expect_equal(x$expiry, 5)
+  expect_equal(x$expire(), 5)
 })
 
 context('midden: fails well')