#' Serve a mock API from files
#'
#' In this context, HTTP requests attempt to load API response fixtures from
#' files. This allows test code to proceed evaluating code that expects
#' HTTP requests to return meaningful responses. Requests that do not have a
#' corresponding fixture file raise errors, like how [without_internet()]
#' does.
#'
#' Requests are translated to mock file paths according to several rules that
#' incorporate the request method, URL, query parameters, and body. See
#' [build_mock_url()] for details.
#'
#' File paths for API fixture files may be relative to the 'tests/testthat'
#' directory, i.e. relative to the .R test files themselves. This is the default
#' location for storing and retrieving mocks, but you can put them anywhere you
#' want as long as you set the appropriate location with [.mockPaths()].
#'
#' @param expr Code to run inside the fake context
#' @return The result of `expr`
#' @seealso [use_mock_api()] to enable mocking on its own (not in a context); [build_mock_url()]; [.mockPaths()]
#' @export
with_mock_api <- function(expr) {
use_mock_api()
on.exit(stop_mocking())
eval.parent(expr)
}
#' Turn on API mocking
#'
#' This function intercepts HTTP requests made through `httr` and serves mock
#' file responses instead. It is what [with_mock_api()] does, minus the
#' automatic disabling of mocking when the context finishes.
#'
#' Note that you in order to resume normal request behavior, you will need to
#' call [stop_mocking()] yourself---this function does not clean up after itself
#' as `with_mock_api` does.
#' @return Nothing; called for its side effects.
#' @seealso [with_mock_api()] [stop_mocking()] [block_requests()]
#' @export
use_mock_api <- function() mock_perform(mock_request)
mock_request <- function(req, handle, refresh) {
# If there's a query, then req$url has been through build_url(parse_url())
# and if it's a file and not URL, it has grown a ":///" prefix. Prune that.
req$url <- sub("^:///", "", req$url)
f <- build_mock_url(get_current_requester()(req))
mockfile <- find_mock_file(f)
if (!is.null(mockfile)) {
return(load_response(mockfile, req))
}
# Else: fail.
# For ease of debugging if a file isn't found, include it in the
# error that gets printed.
req$mockfile <- f
return(stop_request(req))
}
#' Convert a request to a mock file path
#'
#' Requests are translated to mock file paths according to several rules that
#' incorporate the request method, URL, query parameters, and body.
#'
#' First, the request protocol, such as "https://", is removed from the URL.
#' Second, if the request URL contains a query string, it will be popped off,
#' hashed by [digest::digest()], and the first six characters appended to the
#' file being read. Third, request bodies are similarly hashed and
#' appended. Finally, if a request method other than GET is used it will be
#' appended to the end of the end of the file name.
#'
#' Mock file paths also have a file extension appended, based on the
#' `Content-Type` of the response, though this function, which is only concerned
#' with the request, does not add the extension. In an
#' HTTP API, a "directory" itself is a resource,
#' so the extension allows distinguishing directories and files in the file
#' system. That is, a mocked `GET("http://example.com/api/")` may read a
#' "example.com/api.json" file, while
#' `GET("http://example.com/api/object1/")` reads "example.com/api/object1.json".
#'
#' Other examples:
#' * `GET("http://example.com/api/object1/?a=1")` may read
#' "example.com/api/object1-b64371.xml".
#' * `POST("http://example.com/api/object1/?a=1")` may read
#' "example.com/api/object1-b64371-POST.json".
#'
#' This function is exported so that other packages can construct similar mock
#' behaviors or override specific requests at a higher level than
#' `with_mock_api` mocks.
#'
#' Note that if you are trying to guess the mock file paths corresponding to a
#' test for which you intend to create a mock file manually,
#' instead of trying to build the URL, you should run the test
#' with `with_mock_api` as the error message will contain the mock file path.
#'
#' @param req A `request` object, or a character "URL" to convert
#' @param method character HTTP method. If `req` is a 'request' object,
#' its request method will override this argument
#' @return A file path and name, without an extension. The file, or a file with
#' some extension appended, may or may not
#' exist: existence is not a concern of this function.
#' @importFrom digest digest
#' @seealso [with_mock_api()] [capture_requests()]
#' @export
build_mock_url <- function(req, method = "GET") {
if (is.character(req)) {
# A URL/file download
url <- req
body <- NULL
} else {
url <- req$url
method <- req$method
body <- request_body(req)
}
# Remove protocol
url <- sub("^.*?://", "", url)
# Handle query params
parts <- unlist(strsplit(url, "?", fixed = TRUE))
# Remove trailing slash
f <- sub("\\/$", "", parts[1])
# Sanitize the path to be portable for all R platforms
f <- gsub(":", "-", f)
if (length(parts) > 1) {
# There's a query string. Append the digest as a suffix.
f <- paste0(f, "-", hash(parts[2]))
}
# Handle body and append its hash if present
if (!is.null(body)) {
f <- paste0(f, "-", hash(body))
}
if (method != "GET") {
# Append method to the file name for non GET requests
f <- paste0(f, "-", method)
}
return(f)
}
#' Go through mock paths to find the local mock file location
#'
#' @param file A file path, as generated by [build_mock_url()].
#' @return A path to a file that exists, or `NULL` if none found.
#' @keywords internal
#' @export
find_mock_file <- function(file) {
for (path in .mockPaths()) {
# Look for files of any .extension in the indicated directory,
# be they .R, .json, ...
mp <- file.path(path, file)
if (file.exists(mp) && !dir.exists(mp) && grepl("\\.", basename(mp))) {
# With write_disk() downloading, 'file' may reference a specific
# file and include the extension .R-FILE. So if that file exists,
# no need to search for it. Just return it.
return(mp)
}
# Turn the basename into a regular expression that will match it (and
# only it) with any .extension
mockbasename <- paste0("^\\Q", basename(mp), "\\E.[[:alnum:]]*$")
mockfiles <- dir(dirname(mp),
pattern = mockbasename, all.files = TRUE,
full.names = TRUE
)
# Remove directories
mockfiles <- setdiff(mockfiles, list.dirs(dirname(mp), full.names = TRUE))
if (length(mockfiles)) {
# TODO: check for length > 1
return(mockfiles[1])
}
}
return(NULL)
}
#' @importFrom utils tail
load_response <- function(file, req) {
ext <- tail(unlist(strsplit(file, ".", fixed = TRUE)), 1)
if (ext == "R") {
# It's a full "response". Source it.
return(source(file)$value)
} else if (ext %in% names(EXT_TO_CONTENT_TYPE)) {
return(fake_response(
req,
content = readBin(file, "raw", n = file.size(file)),
status_code = 200L,
headers = list(`Content-Type` = EXT_TO_CONTENT_TYPE[[ext]])
))
} else if (ext == "204") {
return(fake_response(req, status_code = 204L))
} else {
stop("Unsupported mock file extension: ", ext, call. = FALSE)
}
}
request_body <- function(req) {
# request_body returns a string if the request has a body, NULL otherwise
b <- request_postfields(req)
if (is.null(b)) {
b <- req$fields
if (!is.null(b)) {
# Get a readable string representation
# control "niceNames" was added in R 3.5
b <- deparse(b, control = "niceNames")
# Strip out unhelpful indentation that it may add, then collapse
# to single string, if broken into multiple lines
b <- paste(sub("^ +", "", b), collapse = "")
}
}
return(b)
}
request_postfields <- function(req) {
b <- req[["options"]][["postfields"]]
if (length(b) > 0) {
# Check length this way because b may be NULL or length 0 raw vector
return(rawToChar(b))
} else {
return(NULL)
}
}
hash <- function(string, n = 6) substr(digest(string), 1, n)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.