Use an R option or env variable to turn on/off Connect content cache

NAMESPACE

@@ -172,6 +172,7 @@ export(board_url)
 export(cache_browse)
 export(cache_info)
 export(cache_prune)
+export(clear_connect_cache)
 export(legacy_azure)
 export(legacy_datatxt)
 export(legacy_dospace)
@@ -210,6 +211,7 @@ export(pin_versions_prune)
 export(pin_write)
 export(ui_addin_pin_find)
 export(ui_connection_create)
+export(use_connect_cache)
 import(rlang)
 importFrom(glue,glue)
 importFrom(lifecycle,deprecated)

NEWS.md

@@ -4,6 +4,10 @@
 
 * Improved error message for `pin_versions()` (#657).
 
+* Added a new R option "pins_connect_cache" (as well as environment variable 
+  "PINS_CONNECT_CACHE") to turn on/off the content and user caches for RStudio 
+  Connect (#660). See `?use_connect_cache()` for more details.
+
 # pins 1.0.3
 
 * The `arrow` package is now suggested, rather than imported (#644, @jonthegeek).

R/board_rsconnect.R

@@ -63,8 +63,7 @@
 #' # Download a shared dataset
 #' board %>% pin_read("timothy/mtcars")
 #' }
-board_rsconnect <- function(
-                            auth = c("auto", "manual", "envvar", "rsconnect"),
+board_rsconnect <- function(auth = c("auto", "manual", "envvar", "rsconnect"),
                             server = NULL,
                             account = NULL,
                             key = NULL,
@@ -84,7 +83,8 @@ board_rsconnect <- function(
 
   cache <- cache %||% board_cache_path(paste0("rsc-", hash(url)))
 
-  board <- new_board("pins_board_rsconnect",
+  board <- new_board(
+    "pins_board_rsconnect",
     api = c(0, 1),
     name = name,
     cache = cache,
@@ -198,7 +198,8 @@ pin_meta.pins_board_rsconnect <- function(board, name, version = NULL, ...) {
   )
 
   meta <- read_meta(cache_path)
-  local_meta(meta,
+  local_meta(
+    meta,
     name = name,
     dir = cache_path,
     url = url,
@@ -258,7 +259,8 @@ pin_store.pins_board_rsconnect <- function(
   bundle_file <- fs::file_temp(ext = "tar.gz")
 
   # suppress warnings about "invalid uid value" / "invalid gid value"
-  withr::with_dir(bundle_dir,
+  withr::with_dir(
+    bundle_dir,
     suppressWarnings(utils::tar(
       bundle_file,
       compression = "gzip",
@@ -269,14 +271,14 @@ pin_store.pins_board_rsconnect <- function(
   # Upload bundle
   # https://docs.rstudio.com/connect/api/#post-/v1/content/{guid}/bundles
   json <- rsc_POST(board, rsc_v1("content", content_guid, "bundles"),
-    body = httr::upload_file(bundle_file)
+                   body = httr::upload_file(bundle_file)
   )
   bundle_id <- json$id
 
   # Deploy bundle
   # https://docs.rstudio.com/connect/api/#post-/v1/experimental/content/{guid}/deploy
   json <- rsc_POST(board, rsc_v1("content", content_guid, "deploy"),
-    body = list(bundle_id = bundle_id),
+                   body = list(bundle_id = bundle_id),
   )
   task_id <- json$task_id
 
@@ -345,8 +347,8 @@ board_pin_get.pins_board_rsconnect <- function(board, name, version = NULL, ...,
 
 #' @export
 board_pin_create.pins_board_rsconnect <- function(board, path, name, metadata, code = NULL,
-                                       search_all = FALSE,
-                                       ...) {
+                                                  search_all = FALSE,
+                                                  ...) {
 
   path <- fs::dir_ls(path)
   metadata$file <- fs::path_file(path)
@@ -362,11 +364,11 @@ board_pin_create.pins_board_rsconnect <- function(board, path, name, metadata, c
 
 #' @export
 board_pin_find.pins_board_rsconnect <- function(board,
-                                               text = NULL,
-                                               name = NULL,
-                                               extended = FALSE,
-                                               metadata = FALSE,
-                                     ...) {
+                                                text = NULL,
+                                                name = NULL,
+                                                extended = FALSE,
+                                                metadata = FALSE,
+                                                ...) {
 
   params <- list(
     search = text,
@@ -393,7 +395,6 @@ rsc_content_find <- function(board, name, version = NULL, warn = TRUE) {
 
   cache_path <- fs::path(board$cache, "content-cache.yml")
   if (!is.null(name$owner)) {
-
     cache <- read_cache(cache_path)
     if (has_name(cache, name$full)) {
       return(cache[[name$full]])
@@ -520,11 +521,11 @@ rsc_content_version_cached <- function(board, guid) {
 rsc_content_delete <- function(board, name) {
   content <- rsc_content_find(board, name)
   rsc_DELETE(board, rsc_v1("content", content$guid))
-
   cache_path <- fs::path(board$cache, "content-cache.yml")
   update_cache(cache_path, name, NULL)
 }
 
+
 rsc_parse_name <- function(x) {
   parts <- strsplit(x, "/", fixed = TRUE)[[1]]
 
@@ -549,20 +550,80 @@ rsc_user_name <- function(board, guid) {
 }
 
 read_cache <- function(path) {
-  if (file.exists(path)) {
+  if (file.exists(path) && use_connect_cache()) {
     yaml::read_yaml(path, eval.expr = FALSE)
   } else {
     list()
   }
 }
-update_cache <- function(path, key, value) {
-  cache <- read_cache(path)
-  cache[[key]] <- value
-  write_yaml(cache, path)
 
+update_cache <- function(path, key, value) {
+  if (use_connect_cache()) {
+    cache <- read_cache(path)
+    cache[[key]] <- value
+    write_yaml(cache, path)
+  }
   value
 }
 
+#' @export
+#' @rdname use_connect_cache
+clear_connect_cache <- function(board,
+                                cache = c("content-cache.yml", "users-cache.yml")) {
+  path <- fs::path(board$cache, cache)
+  cli::cli_inform("Deleting {.file {path}}")
+  fs::file_delete(path)
+}
+
+#' Detect whether to use content and user caches on RStudio Connect
+#'
+#' Sometimes the content and user caches for RStudio Connect can get out of
+#' sync with the server. While we work on solving this problem, the function
+#' `use_connect_cache()` helps you by detecting whether or not to use these
+#' caches. You can manually delete a broken cache via `clear_connect_cache()`.
+#'
+#' @details The `use_connect_cache()` function uses the following method for
+#' detecting whether or not to use the content and user caches for Connect:
+#'
+#' 1. If the `pins_connect_cache` option is set to `FALSE`, `FALSE` is returned.
+#' 2. If the `pins_connect_cache` option is set to `TRUE`, `TRUE` is returned.
+#' 3. If the `PINS_CONNECT_CACHE` environment variable is set to `"false"`,
+#' `"FALSE"`, or `"False"`, `FALSE` is returned.
+#' 3. If the `PINS_CONNECT_CACHE` environment variable is set to `"true"`,
+#' `"TRUE"`, or `"True"`, `TRUE` is returned.
+#' 3. When both this option _and_ environment variable are not set, empty, or
+#' `NULL`, `TRUE` is returned.
+#'
+#' For help deleting a broken cache, you can use the helper function
+#' `pins::clear_connect_cache(board, "content-cache.yml")` or
+#' `pins::clear_connect_cache(board, "user-cache.yml")` for your Connect `board`.
+#'
+#' @param board A pin board created by [board_rsconnect()].
+#' @param cache Filename for either the content or user cache.
+#' @return `use_connect_cache()` returns a logical, `TRUE` or `FALSE`.
+#' `clear_connect_cache()` returns the deleted path, invisibly.
+#' @export
+#' @seealso [board_rsconnect()]
+#' @examples
+#' use_connect_cache()
+#'
+use_connect_cache <- function() {
+  option <- "pins_connect_cache"
+  opt <- peek_option(option)
+  if (!is_null(opt)) {
+    if (!is_bool(opt)) {
+      abort(glue("The option `{option}` must be a logical (TRUE or FALSE)."))
+    }
+    return(opt)
+  }
+  env_var <- "PINS_CONNECT_CACHE"
+  env_var <- as.logical(Sys.getenv(env_var, ""))
+  if (!is_na(env_var)) {
+    return(isTRUE(env_var))
+  }
+  return(TRUE)
+}
+
 # helpers -----------------------------------------------------------------
 
 rsc_path <- function(board, path) {
@@ -578,10 +639,10 @@ rsc_GET <- function(board, path, query = NULL, ...) {
   auth <- rsc_auth(board, path, "GET", NULL)
 
   req <- httr::GET(board$url,
-    path = path,
-    query = query,
-    auth,
-    ...
+                   path = path,
+                   query = query,
+                   auth,
+                   ...
   )
   rsc_check_status(req)
   httr::content(req)
@@ -611,10 +672,10 @@ rsc_DELETE <- function(board, path, query = NULL, ...) {
   auth <- rsc_auth(board, path, "DELETE", NULL)
 
   req <- httr::DELETE(board$url,
-    path = path,
-    query = query,
-    auth,
-    ...
+                      path = path,
+                      query = query,
+                      auth,
+                      ...
   )
   rsc_check_status(req)
   invisible()
@@ -639,12 +700,12 @@ rsc_POST <- function(board, path, query = NULL, body, ..., .method = "POST") {
   auth <- rsc_auth(board, path, .method, body_path)
 
   req <- httr::VERB(.method,
-    url = board$url,
-    path = path,
-    query = query,
-    body = body,
-    auth,
-    ...
+                    url = board$url,
+                    path = path,
+                    query = query,
+                    body = body,
+                    auth,
+                    ...
   )
   rsc_check_status(req)
   httr::content(req)

tests/testthat/test-board_rsconnect.R

@@ -106,6 +106,30 @@ test_that("can find cached versions", {
   expect_message(expect_equal(rsc_content_version_cached(board, guid), cached_v))
 })
 
+test_that("can use or not use cache", {
+  withr::local_options(list(pins_connect_cache = NULL))
+  expect_equal(use_connect_cache(), TRUE)
+  withr::local_envvar(list(PINS_CONNECT_CACHE = "True"))
+  expect_equal(use_connect_cache(), TRUE)
+  withr::local_envvar(list(PINS_CONNECT_CACHE = "false"))
+  expect_equal(use_connect_cache(), FALSE)
+
+  withr::local_options(list(pins_connect_cache = TRUE))
+  expect_equal(use_connect_cache(), TRUE)
+  ## option takes precedence
+  withr::local_envvar(list(PINS_CONNECT_CACHE = "False"))
+  expect_equal(use_connect_cache(), TRUE)
+
+  withr::local_options(list(pins_connect_cache = FALSE))
+  expect_equal(use_connect_cache(), FALSE)
+  ## option takes precedence
+  withr::local_envvar(list(PINS_CONNECT_CACHE = "true"))
+  expect_equal(use_connect_cache(), FALSE)
+
+  withr::local_options(list(pins_connect_cache = "bloop"))
+  expect_error(use_connect_cache())
+})
+
 test_that("rsc_path() always includes leading /", {
   expect_equal(
     rsc_path(list(url = "https://example.com/"), "x"),