tests/testthat/setup-mock.R

In atrrr: Wrapper for the 'AT' Protocol Behind 'Bluesky'

# this function records replies from the API in an RDS file and loads the
# response from disk the next time a request is made to the same endpoint.
mocked_record <- function(req) {
  req <<- req
  # to identify requests, we use a combination of endpoint and request data
  endpoint <- sub("\\?.*", "", basename(req$url))
  dat <- req$body$data
  if (is.null(dat)) {
    # when data is sent as URL parameters
    dat <- sub(endpoint, "", basename(req$url))
  }
  # create unique file names from data; use raw UTF-8 bytes rather than saveRDS
  # because RDS binary format varies across R versions, causing hash mismatches
  data_hash <- local({
    tmp <- tempfile()
    on.exit(unlink(tmp))
    writeBin(charToRaw(paste(dat, collapse = "\n")), tmp)
    unname(tools::md5sum(tmp))
  }) |>
    substr(1, 5) # check complains about long file names
  f <- file.path("recorded_responses", paste0(endpoint, "_", data_hash, ".rds"))

  if (endpoint == "com.atproto.server.createSession") {
    # needs password
    resp <- httr2::response(
      status_code = 200,
      method = "POST",
      headers = "Content-Type: application/json"
    )
    # for everything but session, see if req has been made
  } else if (file.exists(f)) {
    resp <- readRDS(f)
    # if not, make request, record response
  } else if (dir.exists(tools::R_user_dir("atrrr", "cache"))) {
    resp <- httr2::req_perform(req, mock = NULL)
    saveRDS(resp, f)
  } else {
    cli::cli_abort("file {f} does not exist and no token exists")
  }
  return(resp)
}

# setting this option makes sure all requests are mocked from here on.
options("httr2_mock" = mocked_record)

# set the package to perform actions quietly during tests.
options("ATR_VERBOSE" = FALSE)

# clean up afterwards
if (!dir.exists(tools::R_user_dir("atrrr", "cache"))) {
  on.exit(unlink(tools::R_user_dir("atrrr", "cache"), recursive = TRUE))
}