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", {