Caching improvements (#531)

* Use `cache_body()` also in `cache_prefetch()`
* Re-cache results if not modified, in order to capture updated If-Modified-Since and Cache-Control headers.

Fixes #442

NEWS.md

@@ -1,5 +1,7 @@
 # httr2 (development version)
 
+* `req_cache()` now re-caches the response if the body is hasn't been modified but the headers have changed (#442).
+* `req_cache()` works better when `req_perform()` sets a path (#442).
 * `req_body_*()` now give informative error if you attempt to change the body type (#451).
 * `resp_body_html()` and `resp_body_xml()` now work when `req_perform()` is given a path (#448).
 * `req_body_file()` now works with files >64kb once more (#524).

R/multi-req.R

@@ -162,7 +162,7 @@ Performance <- R6Class("Performance", public = list(
     self$error_call <- error_call
 
     req <- auth_oauth_sign(req)
-    req <- cache_pre_fetch(req)
+    req <- cache_pre_fetch(req, path)
     if (is_response(req)) {
       self$resp <- req
     } else {

R/req-cache.R

@@ -114,6 +114,8 @@ cache_get <- function(req) {
 }
 
 cache_set <- function(req, resp) {
+  signal("", "httr2_cache_save")
+
   if (resp_body_type(resp) == "disk") {
     body_path <- req_cache_path(req, ".body")
     file.copy(resp$body, body_path, overwrite = TRUE)
@@ -174,7 +176,7 @@ cache_prune_files <- function(info, to_remove, why, debug = TRUE) {
 # Hooks for req_perform -----------------------------------------------------
 
 # Can return request or response
-cache_pre_fetch <- function(req) {
+cache_pre_fetch <- function(req, path = NULL) {
   if (!cache_active(req)) {
     return(req)
   }
@@ -192,7 +194,10 @@ cache_pre_fetch <- function(req) {
   if (!is.na(info$expires) && info$expires >= Sys.time()) {
     signal("", "httr2_cache_cached")
     if (debug) cli::cli_text("Cached value is fresh; using response from cache")
-    cached_resp
+
+    resp <- cached_resp
+    resp$body <- cache_body(cached_resp, path)
+    resp
   } else {
     if (debug) cli::cli_text("Cached value is stale; checking for updates")
     req_headers(req,
@@ -222,14 +227,16 @@ cache_post_fetch <- function(req, resp, path = NULL) {
     signal("", "httr2_cache_not_modified")
     if (debug) cli::cli_text("Cached value still ok; retrieving body from cache")
 
+    # Combine headers & re-cache
+    resp$headers <- cache_headers(cached_resp, resp)
+    cache_set(req, resp)
+
     # Replace body with cached result
     resp$body <- cache_body(cached_resp, path)
-    # Combine headers
-    resp$headers <- cache_headers(cached_resp, resp)
     resp
   } else if (resp_is_cacheable(resp)) {
-    signal("", "httr2_cache_save")
     if (debug) cli::cli_text("Saving response to cache {.val {hash(req$url)}}")
+
     cache_set(req, resp)
     resp
   } else {
@@ -241,7 +248,6 @@ cache_body <- function(cached_resp, path = NULL) {
   check_response(cached_resp)
 
   body <- cached_resp$body
-
   if (is.null(path)) {
     return(body)
   }

R/req-perform.R

@@ -89,7 +89,7 @@ req_perform <- function(
   req <- req_verbosity(req, verbosity)
   req <- auth_oauth_sign(req)
 
-  req <- cache_pre_fetch(req)
+  req <- cache_pre_fetch(req, path)
   if (is_response(req)) {
     return(req)
   }

tests/testthat/test-req-perform.R

@@ -103,7 +103,61 @@ test_that("can cache requests with etags", {
   req <- request_test("/etag/:etag", etag = "abc") %>% req_cache(tempfile())
 
   resp1 <- req_perform(req)
-  expect_condition(resp2 <- req_perform(req), class = "httr2_cache_not_modified")
+  expect_condition(
+    expect_condition(resp2 <- req_perform(req), class = "httr2_cache_not_modified"),
+    class = "httr2_cache_save"
+  )
+})
+
+test_that("can cache requests with paths (cache-control)", {
+  req <- request(example_url()) %>%
+    req_url_path("/cache/1") %>%
+    req_cache(tempfile())
+
+  path1 <- tempfile()
+  expect_condition(
+    resp1 <- req %>% req_perform(path = path1),
+    class = "httr2_cache_save"
+  )
+  expect_equal(resp1$body[[1]], path1)
+
+  path2 <- tempfile()
+  expect_condition(
+    resp2 <- req %>% req_perform(path = path2),
+    class = "httr2_cache_cached"
+  )
+  expect_equal(resp2$body[[1]], path2)
+
+  Sys.sleep(1) # wait for cache to expire
+  path3 <- tempfile()
+  expect_condition(
+    resp3 <- req %>% req_perform(path = path3),
+    class = "httr2_cache_save"
+  )
+  expect_equal(resp3$body[[1]], path3)
+})
+
+test_that("can cache requests with paths (if-modified-since)", {
+  req <- request(example_url()) %>%
+    req_url_path("/cache") %>%
+    req_cache(tempfile())
+
+  path1 <- tempfile()
+  expect_condition(
+    resp1 <- req %>% req_perform(path = path1),
+    class = "httr2_cache_save"
+  )
+  expect_equal(resp1$body[[1]], path1)
+
+  path2 <- tempfile()
+  expect_condition(
+    expect_condition(
+      resp2 <- req %>% req_perform(path = path2),
+      class = "httr2_cache_not_modified"
+    ),
+    class = "httr2_cache_save"
+  )
+  expect_equal(resp2$body[[1]], path2)
 })
 
 test_that("can retrieve last request and response", {