├── .gitignore ├── tests ├── testthat │ ├── httrmock │ │ ├── config │ │ │ └── mangle_key │ │ ├── keys │ │ │ └── GET:httpbin-org-recorded │ │ │ │ └── 3afbf8cbdd8222617bc9ddf642adaf4d │ │ └── data │ │ │ └── 894cb53bf383a32cbb7f448c3521ae28.rds │ ├── helper.R │ └── test-current-test.R └── testthat.R ├── LICENSE ├── NEWS.md ├── R ├── msg.R ├── choose.R ├── assertions.R ├── package.R ├── init.R ├── utils.R ├── match.R ├── testthat.R ├── recordings.R ├── callbacks.R ├── current-test.R └── store.R ├── .Rbuildignore ├── Makefile ├── .travis.yml ├── man ├── ct_into_block.Rd ├── ct_into_file.Rd ├── transform_request_for_recording.Rd ├── pwt.Rd ├── clear_recordings.Rd ├── httrmock.Rd ├── list_recordings.Rd ├── ct_get_mode.Rd ├── current_test.Rd └── ct.Rd ├── appveyor.yml ├── DESCRIPTION ├── NAMESPACE ├── README.md └── README.Rmd /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | -------------------------------------------------------------------------------- /tests/testthat/httrmock/config/mangle_key: -------------------------------------------------------------------------------- 1 | FALSE 2 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2016 2 | COPYRIGHT HOLDER: Gábor Csárdi 3 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | 2 | # 1.0.0 3 | 4 | First public release. 5 | -------------------------------------------------------------------------------- /R/msg.R: -------------------------------------------------------------------------------- 1 | 2 | msg <- function(...) { 3 | cat(..., "\n", sep = "") 4 | } 5 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(httrmock) 3 | 4 | test_check("httrmock") 5 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^Makefile$ 4 | ^README.Rmd$ 5 | ^.travis.yml$ 6 | ^appveyor.yml$ 7 | -------------------------------------------------------------------------------- /tests/testthat/httrmock/keys/GET:httpbin-org-recorded/3afbf8cbdd8222617bc9ddf642adaf4d: -------------------------------------------------------------------------------- 1 | 894cb53bf383a32cbb7f448c3521ae28 2 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | 2 | all: README.md 3 | 4 | README.md: README.Rmd 5 | Rscript -e "library(knitr); knit('$<', output = '$@', quiet = TRUE)" 6 | -------------------------------------------------------------------------------- /tests/testthat/httrmock/data/894cb53bf383a32cbb7f448c3521ae28.rds: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-lib/httrmock/HEAD/tests/testthat/httrmock/data/894cb53bf383a32cbb7f448c3521ae28.rds -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | sudo: false 3 | cache: packages 4 | 5 | r: 6 | - release 7 | - devel 8 | - oldrel 9 | 10 | after_success: 11 | - Rscript -e 'covr::codecov()' 12 | -------------------------------------------------------------------------------- /R/choose.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom utils menu 3 | 4 | choose <- function(partial = "", answers) { 5 | good_answers <- answers[startsWith(answers, partial)] 6 | sel <- menu(good_answers, title = "Choose current test") 7 | if (sel == 0) stop("No test selected") 8 | good_answers[sel] 9 | } 10 | -------------------------------------------------------------------------------- /R/assertions.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom assertthat assert_that on_failure<- 3 | 4 | is_string <- function(x) { 5 | is.character(x) && length(x) == 1 && !is.na(x) 6 | } 7 | 8 | on_failure(is_string) <- function(call, env) { 9 | paste0(deparse(call$x), " is not a string (length 1 character)") 10 | } 11 | -------------------------------------------------------------------------------- /man/ct_into_block.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/current-test.R 3 | \name{ct_into_block} 4 | \alias{ct_into_block} 5 | \title{Step into a test block} 6 | \usage{ 7 | ct_into_block(current, block) 8 | } 9 | \arguments{ 10 | \item{current}{Current test.} 11 | 12 | \item{block}{Block name or beginning of the name 13 | (possible empty string).} 14 | } 15 | \description{ 16 | Step into a test block 17 | } 18 | \keyword{internal} 19 | -------------------------------------------------------------------------------- /man/ct_into_file.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/current-test.R 3 | \name{ct_into_file} 4 | \alias{ct_into_file} 5 | \title{Step into a test file} 6 | \usage{ 7 | ct_into_file(current, file) 8 | } 9 | \arguments{ 10 | \item{current}{Current test.} 11 | 12 | \item{file}{File name or beginning of the name (without the \code{test[-_]?} 13 | prefix), possibly empty string.} 14 | } 15 | \description{ 16 | Step into a test file 17 | } 18 | -------------------------------------------------------------------------------- /tests/testthat/helper.R: -------------------------------------------------------------------------------- 1 | 2 | ## Clean up recorded requests. They are not meant to be used 3 | ## for the tests in this package, at least not for now. 4 | 5 | if (basename(getwd()) == "testthat") unlink("httrmock") 6 | 7 | is_online <- function(host = "httpbin.org", port = 80) { 8 | 9 | res <- tryCatch( 10 | pingr::ping_port(host, count = 1L, port = port), 11 | error = function(e) NA 12 | ) 13 | 14 | !is.na(res) 15 | } 16 | 17 | skip_if_offline <- function() { 18 | if (!is_online()) skip("offline") 19 | } 20 | -------------------------------------------------------------------------------- /R/package.R: -------------------------------------------------------------------------------- 1 | 2 | #' Mock HTTP Requests for API Testing 3 | #' 4 | #' @section Introduction: 5 | #' 6 | #' TODO 7 | #' 8 | #' `httrmock` was inspired by https://github.com/assaf/node-replay 9 | #' 10 | #' @section Usage in packages: 11 | #' 12 | #' TODO 13 | #' 14 | #' @section The database: 15 | #' 16 | #' TODO 17 | #' 18 | #' @section Debugging: 19 | #' 20 | #' `httrmock` uses `debugme` for easy debugging of what is recorded and 21 | #' replayed, see [debugme::debugme()] for details. 22 | #' 23 | #' @docType package 24 | #' @name httrmock 25 | #' @family HTTP mocking 26 | NULL 27 | -------------------------------------------------------------------------------- /R/init.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom httr get_callback set_callback 3 | 4 | .onLoad <- function(libname, pkgname) { 5 | debugme() 6 | 7 | if (!is.null(get_callback("request"))) { 8 | warning("httrmock removing another request callback") 9 | } 10 | set_callback("request", request_callback) 11 | 12 | if (!is.null(get_callback("response"))) { 13 | warning("httrmock removing another response callback") 14 | } 15 | set_callback("response", response_callback) 16 | } 17 | 18 | .onUnload <- function(libpath) { 19 | set_callback("request", NULL) 20 | set_callback("response", NULL) 21 | } 22 | -------------------------------------------------------------------------------- /tests/testthat/test-current-test.R: -------------------------------------------------------------------------------- 1 | 2 | context("current test") 3 | 4 | test_that("mocking without recorded test", { 5 | 6 | skip_if_offline() 7 | skip_on_cran() 8 | 9 | expect_output( 10 | with_ct( 11 | mode = "mock", 12 | path = "/test-current-test.R", 13 | httr::GET("httpbin.org/?not_recorded") 14 | ), 15 | "Cannot find .*httpbin.org" 16 | ) 17 | }) 18 | 19 | test_that("mocking with recorded test", { 20 | 21 | res <- with_ct( 22 | mode = "mock", 23 | path = "/test-current-test.R", 24 | httr::GET("httpbin.org/?recorded") 25 | ) 26 | expect_equal(res$date, as.Date("2017-05-22")) 27 | }) 28 | -------------------------------------------------------------------------------- /man/transform_request_for_recording.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/store.R 3 | \name{transform_request_for_recording} 4 | \alias{transform_request_for_recording} 5 | \title{Transform a Request for Recording} 6 | \usage{ 7 | transform_request_for_recording(request) 8 | } 9 | \arguments{ 10 | \item{request}{The httr request object.} 11 | } 12 | \value{ 13 | The transformed request, that can be written to a file easily. 14 | } 15 | \description{ 16 | We will not use the result to (re)create the request, we only use it 17 | for matching, so the transformation does not have to be lossless. 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/pwt.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/current-test.R 3 | \name{pwt} 4 | \alias{pwt} 5 | \alias{getwt} 6 | \alias{pct} 7 | \title{Get the current working test} 8 | \usage{ 9 | pwt() 10 | 11 | getwt() 12 | 13 | pct() 14 | } 15 | \value{ 16 | Path to a test direcory, test file, or path and name of the 17 | test block. 18 | } 19 | \description{ 20 | See \code{\link[=ct]{ct()}} for a better description of current working tests. 21 | } 22 | \details{ 23 | \code{getwt} (get working test) and \code{pct} (print current test) are synonyms 24 | of \code{pwt} (print working test). 25 | } 26 | \examples{ 27 | TODO 28 | } 29 | \seealso{ 30 | Other test selection functions: \code{\link{ct}} 31 | } 32 | -------------------------------------------------------------------------------- /man/clear_recordings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recordings.R 3 | \name{clear_recordings} 4 | \alias{clear_recordings} 5 | \alias{del_recording} 6 | \title{Delete one or all HTTP request recordings} 7 | \usage{ 8 | clear_recordings() 9 | 10 | del_recording(id) 11 | } 12 | \arguments{ 13 | \item{id}{Id of the recording to delete.} 14 | } 15 | \description{ 16 | \code{del_recording} deletes a single recording. \code{clear_recordings} deletes 17 | all of them in the current data store. 18 | } 19 | \details{ 20 | They both use the data store in the \code{HTTRMOCK_STORE} environment 21 | variable, or the default one if it is not set. 22 | } 23 | \seealso{ 24 | Other HTTP mocking: \code{\link{httrmock}}, 25 | \code{\link{list_recordings}} 26 | } 27 | -------------------------------------------------------------------------------- /man/httrmock.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/package.R 3 | \docType{package} 4 | \name{httrmock} 5 | \alias{httrmock} 6 | \alias{httrmock-package} 7 | \title{Mock HTTP Requests for API Testing} 8 | \description{ 9 | Mock HTTP Requests for API Testing 10 | } 11 | \section{Introduction}{ 12 | 13 | 14 | TODO 15 | 16 | \code{httrmock} was inspired by https://github.com/assaf/node-replay 17 | } 18 | 19 | \section{Usage in packages}{ 20 | 21 | 22 | TODO 23 | } 24 | 25 | \section{The database}{ 26 | 27 | 28 | TODO 29 | } 30 | 31 | \section{Debugging}{ 32 | 33 | 34 | \code{httrmock} uses \code{debugme} for easy debugging of what is recorded and 35 | replayed, see \code{\link[debugme:debugme]{debugme::debugme()}} for details. 36 | } 37 | 38 | \seealso{ 39 | Other HTTP mocking: \code{\link{clear_recordings}}, 40 | \code{\link{list_recordings}} 41 | } 42 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | # DO NOT CHANGE the "init" and "install" sections below 2 | 3 | # Download script file from GitHub 4 | init: 5 | ps: | 6 | $ErrorActionPreference = "Stop" 7 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 8 | Import-Module '..\appveyor-tool.ps1' 9 | 10 | install: 11 | ps: Bootstrap 12 | 13 | # Adapt as necessary starting from here 14 | 15 | build_script: 16 | - travis-tool.sh install_deps 17 | 18 | test_script: 19 | - travis-tool.sh run_tests 20 | 21 | on_failure: 22 | - travis-tool.sh dump_logs 23 | 24 | artifacts: 25 | - path: '*.Rcheck\**\*.log' 26 | name: Logs 27 | 28 | - path: '*.Rcheck\**\*.out' 29 | name: Logs 30 | 31 | - path: '*.Rcheck\**\*.fail' 32 | name: Logs 33 | 34 | - path: '*.Rcheck\**\*.Rout' 35 | name: Logs 36 | 37 | - path: '\*_*.tar.gz' 38 | name: Bits 39 | 40 | - path: '\*_*.zip' 41 | name: Bits 42 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | 2 | `%||%` <- function(l, r) if (is.null(l)) r else l 3 | 4 | random_string <- function(length = 7) { 5 | paste( 6 | sample(c(letters, 0:9), length, replace = TRUE), 7 | collapse = "" 8 | ) 9 | } 10 | 11 | named_lapply <- function(X, FUN, ...) { 12 | result <- lapply(X, FUN, ...) 13 | 14 | if (!is.null(names(X))) { 15 | names(result) <- names(X) 16 | 17 | } else if (is.character(X)) { 18 | names(result) <- X 19 | } 20 | 21 | result 22 | } 23 | 24 | read_until_blank_line <- function(path) { 25 | 26 | con <- file(path, open = "r") 27 | on.exit(close(con), add = TRUE) 28 | 29 | l <- readLines(con, n = 20) 30 | while (all(l != "")) { 31 | nl <- readLines(con, n = 20) 32 | if (!length(nl)) { 33 | stop("Internal error reading, no blank line found in ", 34 | sQuote(path)) 35 | } 36 | l <- c(l, nl) 37 | } 38 | 39 | head(l, which(l == "")[1] - 1) 40 | } 41 | 42 | elt_or_na <- function(x, i) { 43 | x[[i]] %||% NA_character_ 44 | } 45 | -------------------------------------------------------------------------------- /man/list_recordings.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/recordings.R 3 | \name{list_recordings} 4 | \alias{list_recordings} 5 | \title{List all HTTP request and response recordings} 6 | \usage{ 7 | list_recordings() 8 | } 9 | \value{ 10 | A data frame with columns: 11 | \itemize{ 12 | \item \code{id} The id of the recording. You can use this to delete it with 13 | \code{\link[=del_recording]{del_recording()}}. 14 | \item \code{method} The HTTP method. 15 | \item \code{url} The URL used in the request. Note that the URL in the response 16 | might be different. 17 | \item \code{user} The local username of the user that recorded the request, 18 | as obtained via \code{\link[whoami:username]{whoami::username()}}. 19 | \item \code{timestamp} The exact date and time when the request was recorded. 20 | } 21 | } 22 | \description{ 23 | List all HTTP request and response recordings 24 | } 25 | \seealso{ 26 | Other HTTP mocking: \code{\link{clear_recordings}}, 27 | \code{\link{httrmock}} 28 | } 29 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: httrmock 2 | Title: Mock HTTP Requests for API Testing 3 | Version: 1.0.0.9000 4 | Author: Gábor Csárdi 5 | Maintainer: Gábor Csárdi 6 | Description: Help make web API tests fast and reliable. The package operates 7 | in two modes: in record mode, it performs HTTP requests and records 8 | the responses in a database. In replay mode, it uses the recorded 9 | responses to perform the tests without calling making HTTP requests. 10 | License: MIT + file LICENSE 11 | LazyData: true 12 | URL: https://github.com/r-lib/httrmock 13 | BugReports: https://github.com/r-lib/httrmock/issues 14 | RoxygenNote: 6.0.1.9000 15 | Roxygen: list(markdown = TRUE) 16 | Suggests: 17 | jsonlite, 18 | pingr, 19 | testthat 20 | Encoding: UTF-8 21 | Imports: 22 | assertthat, 23 | base64enc, 24 | debugme, 25 | digest, 26 | glue, 27 | httr, 28 | lintr, 29 | R6, 30 | rprojroot, 31 | utils, 32 | whoami 33 | Remotes: 34 | hadley/httr, 35 | tidyverse/glue 36 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(clear_recordings) 4 | export(ct) 5 | export(ct_get_mode) 6 | export(del_recording) 7 | export(getwt) 8 | export(list_recordings) 9 | export(pct) 10 | export(pwt) 11 | export(setwt) 12 | importFrom(R6,R6Class) 13 | importFrom(assertthat,"on_failure<-") 14 | importFrom(assertthat,assert_that) 15 | importFrom(base64enc,base64decode) 16 | importFrom(base64enc,base64encode) 17 | importFrom(debugme,debugme) 18 | importFrom(glue,glue) 19 | importFrom(httr,content) 20 | importFrom(httr,get_callback) 21 | importFrom(httr,set_callback) 22 | importFrom(lintr,get_source_expressions) 23 | importFrom(rprojroot,find_root) 24 | importFrom(rprojroot,is_r_package) 25 | importFrom(rprojroot,is_testthat) 26 | importFrom(tools,file_path_sans_ext) 27 | importFrom(utils,getParseData) 28 | importFrom(utils,getSrcFilename) 29 | importFrom(utils,head) 30 | importFrom(utils,menu) 31 | importFrom(utils,tail) 32 | importFrom(whoami,username) 33 | importFrom(yaml,as.yaml) 34 | importFrom(yaml,yaml.load) 35 | -------------------------------------------------------------------------------- /R/match.R: -------------------------------------------------------------------------------- 1 | 2 | is_matching_request <- function(req, rec) { 3 | is_matching_method(req$method, rec$method) && 4 | is_matching_url(req$url, rec$url) && 5 | is_matching_headers(req$headers, rec$headers) 6 | } 7 | 8 | is_matching_method <- function(req_method, rec_method) { 9 | is.null(rec_method) || grepl(rec_method, req_method, perl = TRUE) 10 | } 11 | 12 | is_matching_url <- function(req_url, rec_url) { 13 | is.null(rec_url) || req_url == rec_url || 14 | is_matching_regex(req_url, rec_url) 15 | } 16 | 17 | is_matching_headers <- function(req_headers, rec_headers) { 18 | for (h in names(rec_headers)) { 19 | if (! h %in% names(req_headers)) return(FALSE) 20 | if (req_headers[[h]] != rec_headers[[h]] && 21 | ! is_matching_headers(req_headers[[h]], rec_headers[[h]])) { 22 | return(FALSE) 23 | } 24 | } 25 | TRUE 26 | } 27 | 28 | is_matching_regex <- function(req_x, rec_x) { 29 | l <- nchar(rec_x) 30 | substr(rec_x, 1, 1) == "/" && substr(rec_x, l, l) == "/" && 31 | grepl(substr(rec_x, 2, l - 1), req_x, perl = TRUE) 32 | } 33 | -------------------------------------------------------------------------------- /man/ct_get_mode.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/current-test.R 3 | \name{ct_get_mode} 4 | \alias{ct_get_mode} 5 | \title{Set or query the mocking status of the current test} 6 | \usage{ 7 | ct_get_mode() 8 | } 9 | \value{ 10 | \code{ct_get_mode} returns \code{"mock"}, \code{"nomock"} or \code{"record"}. 11 | } 12 | \description{ 13 | Note that these settings only apply to the \emph{current test}. Other 14 | test cases are always mocked. 15 | } 16 | \details{ 17 | \code{ct_get_mode} queries the current mode. 18 | 19 | \code{ct_set_mode} sets the current mode. 20 | 21 | Modes: 22 | \itemize{ 23 | \item \code{nomock} turns off mocking. for the current test. You typically want 24 | this while you are writing or extending the test cases. \code{httrmock} goes 25 | completely out of the way, when this mode is selected. 26 | \item record` turns on recording mode. All HTTP responses are recorded 27 | in this mode. 28 | \item \code{mock} turns on mocking mode. HTTP requests are not performed, 29 | the recorded responses are replayed. This is the default state after 30 | you have changed the current test. 31 | } 32 | } 33 | -------------------------------------------------------------------------------- /man/current_test.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/current-test.R 3 | \name{current_test} 4 | \alias{current_test} 5 | \title{About the current tests} 6 | \description{ 7 | See \code{\link[=ct]{ct()}} before you read this. This documentation is for \code{httrmock} 8 | developers. 9 | } 10 | \details{ 11 | The state of the current tests are stored in environment variables: 12 | \itemize{ 13 | \item \code{HTTRMOCK_CURRENT_TEST} contains the current test. Possible values: 14 | \itemize{ 15 | \item \code{/}: the test directory is selected. This is the default value 16 | when the environment variable is not set. 17 | \item Name of the test file that is selected, e.g. \code{/test-filename.R}. 18 | \item Name of the test file and test block that is selected, e.g. 19 | \code{/test-filename.R/test-block-name}. 20 | } 21 | \item \code{HTTRMOCK_CURRENT_TEST_MODE} contains the current test mode. Possible 22 | values: \code{nomock}, \code{record} and \code{mock}. \code{mock} is the default value 23 | after you have changed the current test, and/or the environment 24 | variable is not set. 25 | } 26 | } 27 | \keyword{internal} 28 | -------------------------------------------------------------------------------- /R/testthat.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom rprojroot find_root is_testthat is_r_package 3 | 4 | get_test_root <- function() { 5 | find_root(is_testthat, find_root(is_r_package)) 6 | } 7 | 8 | list_test_files <- function() { 9 | root <- get_test_root() 10 | dir(root, pattern = "^test") 11 | } 12 | 13 | #' @importFrom utils getParseData 14 | #' @importFrom lintr get_source_expressions 15 | 16 | list_test_blocks <- function(test_file) { 17 | test_path <- file.path(get_test_root(), test_file) 18 | 19 | ## This is not a mistake, but a workaround for a macOS bug 20 | exprs <- get_source_expressions(test_path) 21 | exprs <- get_source_expressions(test_path)$expressions 22 | 23 | ## test_that calls 24 | ttc <- Filter( 25 | function(x) parse(text = x$content)[[1]][[1]] == quote(test_that), 26 | exprs 27 | ) 28 | 29 | ## eval them 30 | names <- unlist(lapply( 31 | ttc, 32 | function(x) { 33 | eval( 34 | parse(text = x$content), 35 | list(test_that = function(n, c) n) 36 | ) 37 | } 38 | )) 39 | 40 | lines <- vapply(ttc, function(x) x$line, integer(1)) 41 | data.frame( 42 | stringsAsFactors = FALSE, 43 | name = names, 44 | line = lines 45 | ) 46 | } 47 | -------------------------------------------------------------------------------- /R/recordings.R: -------------------------------------------------------------------------------- 1 | 2 | #' List all HTTP request and response recordings 3 | #' 4 | #' @return A data frame with columns: 5 | #' * `id` The id of the recording. You can use this to delete it with 6 | #' [del_recording()]. 7 | #' * `method` The HTTP method. 8 | #' * `url` The URL used in the request. Note that the URL in the response 9 | #' might be different. 10 | #' * `user` The local username of the user that recorded the request, 11 | #' as obtained via [whoami::username()]. 12 | #' * `timestamp` The exact date and time when the request was recorded. 13 | #' 14 | #' @export 15 | #' @family HTTP mocking 16 | 17 | list_recordings <- function() { 18 | "!DEBUG List recordings" 19 | get_store()$list() 20 | } 21 | 22 | #' Delete one or all HTTP request recordings 23 | #' 24 | #' `del_recording` deletes a single recording. `clear_recordings` deletes 25 | #' all of them in the current data store. 26 | #' 27 | #' They both use the data store in the `HTTRMOCK_STORE` environment 28 | #' variable, or the default one if it is not set. 29 | #' 30 | #' 31 | #' @export 32 | #' @family HTTP mocking 33 | 34 | clear_recordings <- function() { 35 | "!DEBUG Clear recordings" 36 | get_store()$clear() 37 | invisible() 38 | } 39 | 40 | #' @rdname clear_recordings 41 | #' @param id Id of the recording to delete. 42 | #' @export 43 | 44 | del_recording <- function(id) { 45 | "!DEBUG Delete recording `id`" 46 | get_store()$delete(id) 47 | } 48 | -------------------------------------------------------------------------------- /man/ct.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/current-test.R 3 | \name{ct} 4 | \alias{ct} 5 | \alias{setwt} 6 | \title{Change the current working test} 7 | \usage{ 8 | ct(x = "") 9 | 10 | setwt(x = "") 11 | } 12 | \arguments{ 13 | \item{x}{Sub-test to step into. It might be 14 | \itemize{ 15 | \item \code{"/"}, to select the test directory including all tests. 16 | \item the absolute "path" to a test file or test block. 17 | \item the (unique) beginning of the name of a test file, or, if the 18 | current test is a test file, the (unique) beginning of a test block 19 | name. 20 | \item \code{".."}, in which case we step \emph{out}, i.e. from a test block to the 21 | test file, from a test file to the test directory including all 22 | tests. 23 | }} 24 | } 25 | \description{ 26 | The current working test can be: 27 | \itemize{ 28 | \item all tests in the test directory, 29 | \item all tests in a test file, 30 | \item all expectation in a single test block. 31 | } 32 | } 33 | \details{ 34 | If \code{x} does not uniquely specify the test file or test block, and the 35 | R session is interactive, then the user needs to select between them 36 | manually. For non-interactive R sessions and error is thrown in this 37 | case. 38 | 39 | \code{setwt} (set working test) is a synomym of \code{ct} (change test). 40 | } 41 | \examples{ 42 | TODO 43 | } 44 | \seealso{ 45 | Other test selection functions: \code{\link{pwt}} 46 | } 47 | -------------------------------------------------------------------------------- /R/callbacks.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom whoami username 3 | 4 | response_callback <- function(req, res) { 5 | current <- within_current_test() 6 | 7 | ## if this is not the current test, then we do not record 8 | if (!current) return(NULL) 9 | 10 | ## for the current test, in 'record' mode we record 11 | if (ct_get_mode() != "record") return(NULL) 12 | 13 | msg("Recording request to ", sQuote(req$url)) 14 | 15 | get_store()$set( 16 | req, res, 17 | user = username(fallback = "") 18 | ) 19 | NULL 20 | } 21 | 22 | request_callback <- function(req) { 23 | current <- within_current_test() 24 | mode <- ct_get_mode() 25 | 26 | ## For the current test we only replay if we are in mock mode 27 | if (current) { 28 | if (mode == "record" || mode == "nomock") { 29 | msg("Not playing ", sQuote(req$url), " in ", sQuote(mode), " mode") 30 | return(NULL) 31 | } 32 | } 33 | 34 | ## TODO: we should not re-create the store every time, 35 | ## because it takes a long time load all responses 36 | store <- get_store() 37 | recording <- store$match(req) 38 | if (! is.null(recording)) { 39 | if (current) msg("Playing ", sQuote(recording$id)) 40 | "!DEBUG Replay '`recording$id`' a request to '`req$url`'" 41 | recording$response 42 | } else { 43 | if (current) msg("Cannot find recording to ", sQuote(req$url)) 44 | "!DEBUG Request not found to '`req$url`', performing it" 45 | NULL 46 | } 47 | } 48 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # httrmock 5 | 6 | > Mock HTTP Requests for API Testing 7 | 8 | [![Linux Build Status](https://travis-ci.org/r-lib/httrmock.svg?branch=master)](https://travis-ci.org/r-lib/httrmock) 9 | [![Windows Build status](https://ci.appveyor.com/api/projects/status/github/r-lib/httrmock?svg=true)](https://ci.appveyor.com/project/gaborcsardi/httrmock) 10 | [![](http://www.r-pkg.org/badges/version/httrmock)](http://www.r-pkg.org/pkg/httrmock) 11 | [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/httrmock)](http://www.r-pkg.org/pkg/httrmock) 12 | 13 | 14 | Mock HTTP Requests for API Testing 15 | 16 | ## Installation 17 | 18 | Once on CRAN, install the package as usual: 19 | 20 | 21 | ```r 22 | install.packages("r-lib/httrmock") 23 | ``` 24 | 25 | ## Introduction 26 | 27 | TODO 28 | 29 | `httrmock` was inspired by https://github.com/assaf/node-replay 30 | 31 | ## Usage in packages: 32 | 33 | TODO 34 | 35 | ## The database: 36 | 37 | `httrmock` uses the `storr` package to store the requests and responses 38 | in RDS files, see `storr::storr()`. By default the database is in the 39 | `tests/testthat` directory, which is appropriate for `testthat` tests. 40 | For an alternative directory, set the `HTTRMOCK_STORE` environment 41 | variable and point it to the directory you wish to use. The directory 42 | will be created if it does not exist. 43 | 44 | ## Debugging: 45 | 46 | `httrmock` uses `debugme` for easy debugging of what is recorded and 47 | replayed, see `debugme::debugme()` for details. 48 | 49 | ## License 50 | 51 | MIT © Gábor Csárdi, RStudio 52 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | 2 | ```{r, setup, echo = FALSE, message = FALSE} 3 | knitr::opts_chunk$set( 4 | comment = "#>", 5 | tidy = FALSE, 6 | error = FALSE, 7 | fig.width = 8, 8 | fig.height = 8) 9 | ``` 10 | 11 | # httrmock 12 | 13 | > Mock HTTP Requests for API Testing 14 | 15 | [![Linux Build Status](https://travis-ci.org/r-lib/httrmock.svg?branch=master)](https://travis-ci.org/r-lib/httrmock) 16 | [![Windows Build status](https://ci.appveyor.com/api/projects/status/github/r-lib/httrmock?svg=true)](https://ci.appveyor.com/project/gaborcsardi/httrmock) 17 | [![](http://www.r-pkg.org/badges/version/httrmock)](http://www.r-pkg.org/pkg/httrmock) 18 | [![CRAN RStudio mirror downloads](http://cranlogs.r-pkg.org/badges/httrmock)](http://www.r-pkg.org/pkg/httrmock) 19 | 20 | 21 | Mock HTTP Requests for API Testing 22 | 23 | ## Installation 24 | 25 | Once on CRAN, install the package as usual: 26 | 27 | ```{r eval = FALSE} 28 | install.packages("r-lib/httrmock") 29 | ``` 30 | 31 | ## Introduction 32 | 33 | TODO 34 | 35 | `httrmock` was inspired by https://github.com/assaf/node-replay 36 | 37 | ## Usage in packages: 38 | 39 | TODO 40 | 41 | ## The database: 42 | 43 | `httrmock` uses the `storr` package to store the requests and responses 44 | in RDS files, see `storr::storr()`. By default the database is in the 45 | `tests/testthat` directory, which is appropriate for `testthat` tests. 46 | For an alternative directory, set the `HTTRMOCK_STORE` environment 47 | variable and point it to the directory you wish to use. The directory 48 | will be created if it does not exist. 49 | 50 | ## Debugging: 51 | 52 | `httrmock` uses `debugme` for easy debugging of what is recorded and 53 | replayed, see `debugme::debugme()` for details. 54 | 55 | ## License 56 | 57 | MIT © Gábor Csárdi, RStudio 58 | -------------------------------------------------------------------------------- /R/current-test.R: -------------------------------------------------------------------------------- 1 | 2 | #' About the current tests 3 | #' 4 | #' See [ct()] before you read this. This documentation is for `httrmock` 5 | #' developers. 6 | #' 7 | #' The state of the current tests are stored in environment variables: 8 | #' * `HTTRMOCK_CURRENT_TEST` contains the current test. Possible values: 9 | #' * `/`: the test directory is selected. This is the default value 10 | #' when the environment variable is not set. 11 | #' * Name of the test file that is selected, e.g. `/test-filename.R`. 12 | #' * Name of the test file and test block that is selected, e.g. 13 | #' `/test-filename.R/test-block-name`. 14 | #' * `HTTRMOCK_CURRENT_TEST_MODE` contains the current test mode. Possible 15 | #' values: `nomock`, `record` and `mock`. `mock` is the default value 16 | #' after you have changed the current test, and/or the environment 17 | #' variable is not set. 18 | #' 19 | #' @name current_test 20 | #' @keywords internal 21 | NULL 22 | 23 | #' Change the current working test 24 | #' 25 | #' The current working test can be: 26 | #' * all tests in the test directory, 27 | #' * all tests in a test file, 28 | #' * all expectation in a single test block. 29 | #' 30 | #' If `x` does not uniquely specify the test file or test block, and the 31 | #' R session is interactive, then the user needs to select between them 32 | #' manually. For non-interactive R sessions and error is thrown in this 33 | #' case. 34 | #' 35 | #' `setwt` (set working test) is a synomym of `ct` (change test). 36 | #' 37 | #' @param x Sub-test to step into. It might be 38 | #' * `"/"`, to select the test directory including all tests. 39 | #' * the absolute "path" to a test file or test block. 40 | #' * the (unique) beginning of the name of a test file, or, if the 41 | #' current test is a test file, the (unique) beginning of a test block 42 | #' name. 43 | #' * `".."`, in which case we step *out*, i.e. from a test block to the 44 | #' test file, from a test file to the test directory including all 45 | #' tests. 46 | #' 47 | #' @export 48 | #' @family test selection functions 49 | #' @examples 50 | #' TODO 51 | 52 | ct <- function(x = "") { 53 | wt <- pwt() 54 | 55 | ## Absolute or relative path 56 | newct <- if (substr(x, 1, 1) == "/") { 57 | x 58 | 59 | } else if (x == "..") { 60 | ct_up(wt) 61 | 62 | } else{ 63 | ct_relative(wt, x) 64 | } 65 | 66 | ## Check that it is valid 67 | ct_check_ct(newct) 68 | 69 | Sys.setenv("HTTRMOCK_CURRENT_TEST" = newct) 70 | invisible(pwt()) 71 | } 72 | 73 | ct_up <- function(current) { 74 | dirname(current) 75 | } 76 | 77 | ct_relative <- function(current, new) { 78 | if (current == "/") { 79 | ct_into_file(current, new) 80 | 81 | } else { 82 | ct_into_block(current, new) 83 | } 84 | } 85 | 86 | #' Step into a test file 87 | #' 88 | #' @param current Current test. 89 | #' @param file File name or beginning of the name (without the `test[-_]?` 90 | #' prefix), possibly empty string. 91 | 92 | ct_into_file <- function(current, file) { 93 | files <- list_test_files() 94 | trimmed_files <- sub("^test[-_]?", "", files) 95 | pm <- pmatch(file, trimmed_files) 96 | 97 | newfile <- if (!is.na(pm)) { 98 | files[pm] 99 | 100 | } else if (length(files) == 1 && file == "") { 101 | files 102 | 103 | } else if (interactive()) { 104 | choose(file, files) 105 | 106 | } else { 107 | stop("Cannot set current test file, ", sQuote(file), " is ambigouos") 108 | } 109 | 110 | paste0("/", newfile) 111 | } 112 | 113 | #' Step into a test block 114 | #' 115 | #' @param current Current test. 116 | #' @param block Block name or beginning of the name 117 | #' (possible empty string). 118 | #' 119 | #' @keywords internal 120 | 121 | ct_into_block <- function(current, block) { 122 | 123 | test_file <- ct_get_test_file(current) 124 | 125 | blocks <- list_test_blocks(test_file)$name 126 | pm <- pmatch(block, blocks) 127 | 128 | newblock <- if (!is.na(pm)) { 129 | blocks[pm] 130 | 131 | } else if (length(blocks) == 1 && block == "") { 132 | blocks 133 | 134 | } else if (interactive()) { 135 | choose(block, blocks) 136 | 137 | } else { 138 | stop("Cannot set current test block, ", sQuote(block), " is ambigouos") 139 | } 140 | 141 | paste0(current, "/", newblock) 142 | } 143 | 144 | ct_check_ct <- function(x) { 145 | if (substr(x, 1, 1) != "/") { 146 | stop("Invalid path: ", sQuote(x), " should start with ", sQuote("/")) 147 | } 148 | if (x == "/") return() 149 | 150 | test_root <- get_test_root() 151 | test_file <- ct_get_test_file(x) 152 | test_block <- ct_get_test_block(x) 153 | 154 | if (!file.exists(file.path(test_root, test_file))) { 155 | stop("Test file does not exist: ", sQuote(test_file)) 156 | } 157 | 158 | if (test_block == "") return() 159 | 160 | blocks <- list_test_blocks(test_file) 161 | if (! test_block %in% blocks$name) { 162 | stop("Test block ", sQuote(test_block), " does not exist in file ", 163 | sQuote(test_file)) 164 | } 165 | } 166 | 167 | ct_get_test_file <- function(x) { 168 | if (x == "/") { 169 | "" 170 | } else if (dirname(x) == "/") { 171 | ## /file 172 | basename(x) 173 | 174 | } else { 175 | ## /file/block 176 | basename(dirname(x)) 177 | } 178 | } 179 | 180 | ct_get_test_block <- function(x) { 181 | if (x == "/") { 182 | "" 183 | 184 | } else if (dirname(x) == "/") { 185 | "" 186 | 187 | } else { 188 | basename(x) 189 | } 190 | } 191 | 192 | #' Get the current working test 193 | #' 194 | #' See [ct()] for a better description of current working tests. 195 | #' 196 | #' `getwt` (get working test) and `pct` (print current test) are synonyms 197 | #' of `pwt` (print working test). 198 | #' 199 | #' @return Path to a test direcory, test file, or path and name of the 200 | #' test block. 201 | #' 202 | #' @export 203 | #' @family test selection functions 204 | #' @examples 205 | #' TODO 206 | 207 | pwt <- function() { 208 | Sys.getenv("HTTRMOCK_CURRENT_TEST", "/") 209 | ## TODO: check that value makes sense 210 | } 211 | 212 | #' @export 213 | #' @rdname pwt 214 | 215 | getwt <- pwt 216 | 217 | #' @export 218 | #' @rdname pwt 219 | 220 | pct <- pwt 221 | 222 | #' @export 223 | #' @rdname ct 224 | 225 | setwt <- ct 226 | 227 | #' Set or query the mocking status of the current test 228 | #' 229 | #' Note that these settings only apply to the *current test*. Other 230 | #' test cases are always mocked. 231 | #' 232 | #' `ct_get_mode` queries the current mode. 233 | #' 234 | #' `ct_set_mode` sets the current mode. 235 | #' 236 | #' Modes: 237 | #' * `nomock` turns off mocking. for the current test. You typically want 238 | #' this while you are writing or extending the test cases. `httrmock` goes 239 | #' completely out of the way, when this mode is selected. 240 | #' * record` turns on recording mode. All HTTP responses are recorded 241 | #' in this mode. 242 | #' * `mock` turns on mocking mode. HTTP requests are not performed, 243 | #' the recorded responses are replayed. This is the default state after 244 | #' you have changed the current test. 245 | #' 246 | #' @return `ct_get_mode` returns `"mock"`, `"nomock"` or `"record"`. 247 | #' 248 | #' @export 249 | 250 | ct_get_mode <- function() { 251 | Sys.getenv("HTTRMOCK_CURRENT_TEST_MODE", "mock") 252 | } 253 | 254 | ct_set_mode <- function(mode) { 255 | mode <- match.arg(mode, c("nomock", "record", "mock")) 256 | Sys.setenv("HTTRMOCK_CURRENT_TEST_MODE" = mode) 257 | } 258 | 259 | #' @importFrom utils getSrcFilename tail 260 | 261 | within_current_test <- function() { 262 | calls <- sys.calls() 263 | frames <- sys.frames() 264 | test_that_calls <- Filter( 265 | function(x) identical(calls[[x]][[1]], quote(test_that)), 266 | seq_along(calls) 267 | ) 268 | last <- tail(test_that_calls, 1) 269 | 270 | if (!length(last)) return(FALSE) 271 | 272 | current <- pwt() 273 | if (current == "/") { 274 | TRUE 275 | 276 | } else { 277 | filename <- getSrcFilename(calls[[last]]) 278 | blockname <- get("desc", frames[[last]]) 279 | if (grepl("/.*/", current)) { 280 | paste0("/", filename, "/", blockname) == current 281 | } else { 282 | paste0("/", filename) == current 283 | } 284 | } 285 | } 286 | 287 | ct_stack <- new.env(parent = emptyenv()) 288 | 289 | ct_push <- function() { 290 | ct_stack$mode <- c(ct_stack$mode, ct_get_mode()) 291 | ct_stack$path <- c(ct_stack$path, pct()) 292 | } 293 | 294 | #' @importFrom utils head 295 | 296 | ct_pop <- function() { 297 | mode <- tail(ct_stack$mode, 1) 298 | path <- tail(ct_stack$path, 1) 299 | ct_stack$mode <- head(ct_stack$mode, -1) 300 | ct_stack$path <- head(ct_stack$path, -1) 301 | if (length(mode)) ct_set_mode(mode) 302 | if (length(path)) ct(path) 303 | } 304 | 305 | with_ct <- function(mode, expr, path = "/") { 306 | ct_push() 307 | on.exit(ct_pop()) 308 | ct_set_mode(mode) 309 | ct(path) 310 | expr 311 | } 312 | -------------------------------------------------------------------------------- /R/store.R: -------------------------------------------------------------------------------- 1 | 2 | #' @importFrom debugme debugme 3 | 4 | get_store <- function() { 5 | storepath <- Sys.getenv("HTTRMOCK_STORE", "") 6 | if (storepath == "") { 7 | storepath <- file.path(get_test_root(), "httrmock") 8 | } 9 | "!DEBUG Getting HTTP data from '`storepath`'" 10 | httr_store$new(storepath) 11 | } 12 | 13 | #' @importFrom R6 R6Class 14 | 15 | httr_store <- R6Class( 16 | "httr_store", 17 | public = list( 18 | initialize = function(path) hstore_init(self, private, path), 19 | match = function(request) hstore_match(self, private, request), 20 | exists = function(request) hstore_exists(self, private, request), 21 | set = function(request, response, user) 22 | hstore_set(self, private, request, response, user), 23 | list = function() hstore_list(self, private), 24 | clear = function(force = FALSE) hstore_clear(self, private, force), 25 | delete = function(ids) store_delete(self, private, ids), 26 | refresh_index = function() hstore_refresh_index(self, private) 27 | ), 28 | private = list( 29 | path = NULL, 30 | index = NULL, 31 | recording_name = function(request) 32 | hstore__recording_name(self, private, request), 33 | new_filename = function(request, response, user) 34 | hstore__new_filename(self, private, request, response, user), 35 | list_filenames = function() 36 | hstore__list_filenames(self, private), 37 | write_recording = function(file, request, response, user) 38 | hstore__write_recording(self, private, file, request, response, user) 39 | ) 40 | ) 41 | 42 | hstore_init <- function(self, private, path) { 43 | private$path <- path 44 | self$refresh_index() 45 | invisible(self) 46 | } 47 | 48 | hstore_get <- function(self, private, id) { 49 | m <- grepl(id, names(private$index)) 50 | if (any(m)) { 51 | private$index[m][[1]] 52 | } else { 53 | NULL 54 | } 55 | } 56 | 57 | hstore_match <- function(self, private, request) { 58 | for (recname in names(private$index)) { 59 | if (is_matching_request(request, private$index[[recname]])) { 60 | return(hstore__load_recording(recname)) 61 | } 62 | } 63 | NULL 64 | } 65 | 66 | hstore_exists <- function(self, private, request) { 67 | for (rec in private$index) { 68 | if (is_matching_request(request, rec)) return(TRUE) 69 | } 70 | FALSE 71 | } 72 | 73 | hstore_set <- function(self, private, request, response, user) { 74 | ## TODO: check for matching recording first, to overwrite 75 | file <- private$new_filename(request, response, user) 76 | private$write_recording(file, request, response, user) 77 | ## TODO: refresh index? 78 | invisible(self) 79 | } 80 | 81 | hstore_list <- function(self, private) { 82 | ids <- names(private$index) 83 | df <- data.frame( 84 | stringsAsFactors = FALSE, 85 | id = hstore__id_from_filename(ids), 86 | verb = vapply(private$index, elt_or_na, character(1), "method"), 87 | url = vapply(private$index, elt_or_na, character(1), "url") 88 | ) 89 | rownames(df) <- NULL 90 | df 91 | } 92 | 93 | hstore_clear <- function(self, private, force) { 94 | ## TODO 95 | stop("clear method is not implemented yet (just delete the files)") 96 | } 97 | 98 | hstore_delete <- function(self, private, ids) { 99 | ## TODO 100 | stop("delete method is not implemented yet (just delete the file)") 101 | } 102 | 103 | hstore_refresh_index <- function(self, private) { 104 | recfiles <- private$list_filenames() 105 | private$index <- named_lapply(recfiles, hstore__get_recording_header) 106 | invisible(self) 107 | } 108 | 109 | ## ------------------------------------------------------------------- 110 | 111 | hstore__recording_name <- function(self, private, request) { 112 | urlname <- gsub("[^a-zA-Z0-9]+", "-", request$url) 113 | paste0(request$method, "-", urlname) 114 | } 115 | 116 | hstore__new_filename <- function(self, private, request, response, user) { 117 | file.path( 118 | private$path, 119 | paste0( 120 | private$recording_name(request), 121 | "-", 122 | random_string(), 123 | ".rec" 124 | ) 125 | ) 126 | } 127 | 128 | hstore__list_filenames <- function(self, private) { 129 | dir( 130 | path = private$path, 131 | pattern = "\\.rec$", 132 | recursive = TRUE, 133 | full.names = TRUE 134 | ) 135 | } 136 | 137 | #' @importFrom glue glue 138 | #' @importFrom yaml as.yaml 139 | 140 | hstore__write_recording <- function(self, private, file, request, 141 | response, user) { 142 | 143 | request <- make_request_safe(request) 144 | response <- make_response_safe(response) 145 | 146 | on.exit(close(con), add = TRUE) 147 | con <- file(file, open = "w") 148 | 149 | treq <- transform_request_for_recording(request) 150 | tresp <- transform_response_for_recording(response) 151 | 152 | cat(file = con, glue(" 153 | # Request parameters, these are used for request matching 154 | { as.yaml(treq) } 155 | 156 | # Response headers, extracted for readability 157 | { as.yaml(tresp$header) } 158 | 159 | # The rest of the response object 160 | BASE64 encoded response: 161 | { tresp$rest } 162 | 163 | # Finally, the content 164 | { tresp$content } 165 | ")) 166 | } 167 | 168 | make_request_safe <- function(request) { 169 | ## TODO 170 | request 171 | } 172 | 173 | make_response_safe <- function(response) { 174 | response$request <- make_request_safe(response$request) 175 | response 176 | } 177 | 178 | #' Transform a Request for Recording 179 | #' 180 | #' We will not use the result to (re)create the request, we only use it 181 | #' for matching, so the transformation does not have to be lossless. 182 | #' 183 | #' @param request The httr request object. 184 | #' @return The transformed request, that can be written to a file easily. 185 | #' 186 | #' @keywords internal 187 | 188 | transform_request_for_recording <- function(request) { 189 | list( 190 | method = request$method, 191 | url = request$url, 192 | headers = as.list(request$headers) 193 | ) 194 | } 195 | 196 | #' @importFrom base64enc base64encode 197 | 198 | transform_response_for_recording <- function(response) { 199 | 200 | show_elements <- c("url", "headers", "all_headers", "status_code", 201 | "content", "cookies", "date") 202 | rest_elements <- setdiff(names(response), show_elements) 203 | 204 | list( 205 | header = list( 206 | url = response$url, 207 | headers = response$all_headers, 208 | cookies = response$cookies 209 | ), 210 | content = transform_response_content_for_recording(response), 211 | rest = base64encode( 212 | serialize(response[rest_elements], connection = NULL), 213 | linewidth = 60, 214 | newline = "\n" 215 | ) 216 | ) 217 | } 218 | 219 | #' @importFrom httr content 220 | 221 | transform_response_content_for_recording <- function(response) { 222 | 223 | if ("content-type" %in% names(response$headers) && 224 | is_plain_content_type(response$headers[["content-type"]])) { 225 | paste0("Content:\n", content(response, as = "text")) 226 | 227 | } else { 228 | paste0( 229 | "BASE64 encoded content:\n", 230 | base64encode(response$content, linewidth = 70, newline = "\n") 231 | ) 232 | } 233 | } 234 | 235 | is_plain_content_type <- function(type) { 236 | 237 | plain <- c( 238 | "application/javascript", 239 | "application/json", 240 | "application/xml", 241 | "text/css", 242 | "text/html", 243 | "text/plain") 244 | 245 | type %in% plain || grepl(paste0(plain, "\\s*;"), type) 246 | } 247 | 248 | #' @importFrom yaml yaml.load 249 | 250 | hstore__get_recording_header <- function(path) { 251 | lines <- read_until_blank_line(path) 252 | str <- paste(lines, collapse = "\n") 253 | yaml.load(str) 254 | } 255 | 256 | #' @importFrom tools file_path_sans_ext 257 | 258 | hstore__id_from_filename <- function(files) { 259 | names <- file_path_sans_ext(basename(files)) 260 | vapply(strsplit(names, "-"), tail, character(1), 1) 261 | } 262 | 263 | #' @importFrom base64enc base64decode 264 | 265 | hstore__load_recording <- function(path) { 266 | lines <- readLines(path, warn = FALSE) 267 | i <- 1 268 | 269 | ## Find the first empty line, the end of the header 270 | while (lines[i] != "") i <- i + 1 271 | req <- yaml.load(paste(lines[1:i], collapse = "\n")) 272 | 273 | ## Skip empty lines, beginning of response override 274 | while (lines[i] == "") i <- i + 1 275 | j <- i 276 | 277 | ## Find next empty line, end of response override 278 | while (lines[i] != "") i <- i + 1 279 | resp_override <- yaml.load(paste(lines[j:i], collapse = "\n")) 280 | 281 | ## Skip empty lines, beginning of response 282 | while (lines[i] == "") i <- i + 1 283 | j <- i 284 | 285 | ## Find next empty line, end of response 286 | while (lines[i] != "") i <- i + 1 287 | resp_lines <- grep("^#", lines[(j+1):i], invert = TRUE, value = TRUE) 288 | resp <- unserialize(base64decode(paste(resp_lines[-1], collapse = "\n"))) 289 | 290 | ## Skip empty lines 291 | while (lines[i] == "") i <- i + 1 292 | content_lines <- grep("^#", lines[i:length(lines)], 293 | invert = TRUE, value = TRUE) 294 | base64 <- grepl("BASE64 encoded content:", content_lines[1]) 295 | content <- if (base64) { 296 | base64decode(content_lines[-1]) 297 | } else { 298 | charToRaw(paste(content_lines[-1], collapse = "\n")) 299 | } 300 | 301 | resp$url <- resp_override$url 302 | resp$status_code <- tail(resp_override$headers, 1)[[1]]$status 303 | resp$headers <- tail(resp_override$headers, 1)[[1]]$headers 304 | resp$all_headers <- resp_override$headers 305 | resp$cookies <- cookies_as_df(resp_override$cookies) 306 | resp$content <- content 307 | resp$date <- resp_override$date %||% Sys.Date() 308 | 309 | list( 310 | path = path, 311 | id = hstore__id_from_filename(path), 312 | response = structure(resp, class = "response"), 313 | request_matching = req, 314 | response_override = resp_override 315 | ) 316 | } 317 | 318 | cookies_as_df <- function(cookies) { 319 | ## TODO 320 | cookies 321 | } 322 | --------------------------------------------------------------------------------