webmockr/0000755000175100001440000000000013107765670012115 5ustar hornikuserswebmockr/inst/0000755000175100001440000000000013107755370013066 5ustar hornikuserswebmockr/inst/ignore/0000755000175100001440000000000013107755370014351 5ustar hornikuserswebmockr/inst/ignore/sockets.R0000644000175100001440000000252212774057045016153 0ustar hornikuserswbenv <- new.env() bucket <- new.env() start_server <- function(x) { app <- list( call = function(req) { wsUrl = paste(sep = '', '"', "ws://", ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST), '"') tmp <- list( status = 200L, headers = list( 'Content-Type' = 'application/json' ), body = sprintf('{ "http_method": "%s", "url": "%s", "port": "%s", "query": "%s", "user_agent": "%s" }', req$REQUEST_METHOD, req$SERVER_NAME, req$SERVER_PORT, req$QUERY_STRING, req$HTTP_USER_AGENT) ) assign(basename(tempfile()), tmp, envir = bucket) tmp } ) wbenv$server <- startDaemonizedServer("0.0.0.0", 9200, app) #wbenv$server <- startDaemonizedServer("80", 9200, app) message("server started") } stop_server <- function(x = NULL) { stopDaemonizedServer(if (is.null(x)) wbenv$server else x) } bucket_list <- function(x) ls(envir = bucket) bucket_unique <- function(x) { hashes <- vapply(ls(envir = bucket), function(z) digest::digest(get(z, envir = bucket)), "") if (any(duplicated(hashes))) { torm <- names(hashes)[duplicated(hashes)] invisible(lapply(torm, function(z) rm(list = z, envir = bucket))) } } webmockr/inst/ignore/adapter-httr.R0000644000175100001440000000520713076516612017076 0ustar hornikusers#' httr library adapter #' #' @export #' @family http_lib_adapters #' @details This adapter modifies \pkg{httr} to allow mocking HTTP requests #' when one is using \pkg{httr} in their code HttrAdapter <- R6::R6Class( 'HttrAdapter', public = list( name = "httr_adapter", enable = function() { message("HttrAdapter enabled!") webmockr_lightswitch$httr <- TRUE }, disable = function() { message("HttrAdapter disabled!") webmockr_lightswitch$httr <- FALSE }, build_request_signature = function(x) { RequestSignature$new( method = x$method, uri = x$url, options = list( body = x$body %||% NULL, headers = x$headers %||% NULL ) ) }, handle_request = function() { "fadfas" } ) ) # httr methods to override ## request_perform -> changes: ## - look in cache for matching request (given user specified matchers) ## - if it's a match, return the response (body, headers, etc.) ## - if no match, proceed with http request as normal request_perform <- function(req, handle, refresh = TRUE) { stopifnot(httr:::is.request(req), inherits(handle, "curl_handle")) req <- httr:::request_prepare(req) curl::handle_setopt(handle, .list = req$options) if (!is.null(req$fields)) curl::handle_setform(handle, .list = req$fields) curl::handle_setheaders(handle, .list = req$headers) on.exit(curl::handle_reset(handle), add = TRUE) # put request in cache request_signature <- HttrAdapter$build_request_signature(req) webmockr_request_registry$register_request(request_signature) if (request_is_in_cache(req)) { StubRegistry$find_stubbed_request(req) } else { resp <- httr:::request_fetch(req$output, req$url, handle) # If return 401 and have auth token, refresh it and then try again needs_refresh <- refresh && resp$status_code == 401L && !is.null(req$auth_token) && req$auth_token$can_refresh() if (needs_refresh) { message("Auto-refreshing stale OAuth token.") req$auth_token$refresh() return(httr:::request_perform(req, handle, refresh = FALSE)) } all_headers <- httr:::parse_headers(resp$headers) headers <- httr:::last(all_headers)$headers if (!is.null(headers$date)) { date <- httr:::parse_http_date(headers$Date) } else { date <- Sys.time() } httr:::response( url = resp$url, status_code = resp$status_code, headers = headers, all_headers = all_headers, cookies = curl::handle_cookies(handle), content = resp$content, date = date, times = resp$times, request = req, handle = handle ) } } webmockr/tests/0000755000175100001440000000000013107755370013253 5ustar hornikuserswebmockr/tests/testthat/0000755000175100001440000000000013107755370015113 5ustar hornikuserswebmockr/tests/testthat/test-flipswitch.R0000644000175100001440000000125113077214064020362 0ustar hornikuserscontext("flipswitch (enable/disable)") test_that("flipswitch in default state", { expect_is(webmockr_lightswitch, "environment") expect_is(webmockr_lightswitch$crul, "logical") expect_false(webmockr_lightswitch$crul) }) test_that("flipswitch - turn on with 'enable'", { aa <- enable() expect_is(aa, "logical") expect_equal(length(aa), 1) expect_true(webmockr_lightswitch$crul) }) test_that("flipswitch - turn off with 'disable'", { aa <- disable() expect_null(aa) expect_false(webmockr_lightswitch$crul) }) test_that("enable and disable fail well", { expect_error(enable(a = 5), "unused argument") expect_error(disable(a = 5), "unused argument") }) webmockr/tests/testthat/crul_obj.rda0000644000175100001440000000036613107754664017414 0ustar hornikusersmPM 0 AyZ'_i7鶲)ujCJy/y^!p ]\=pal(n 3[L[E11Pt$i47We?1Ju:MBkF>XqGd(u8h3RWW*kVY x6>Yuviws") expect_is(aa$to_return, "function") expect_error(aa$to_return(), "argument \"headers\" is missing") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "get: https://httpbin.org/get") expect_is(aa$with, "function") expect_null(aa$with()) expect_is(aa$uri_parts, "list") }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(stub_request(), "one of uri or uri_regex is required") expect_error(stub_request(method = "stuff", "adf"), "'arg' should be one of") }) webmockr/tests/testthat/test-CrulAdapter.R0000644000175100001440000000274013107056601020413 0ustar hornikuserscontext("CrulAdapter") aa <- CrulAdapter$new() test_that("CrulAdapter bits are correct", { skip_on_cran() expect_is(CrulAdapter, "R6ClassGenerator") expect_is(aa, "CrulAdapter") expect_is(aa$build_crul_request, "function") expect_is(aa$build_crul_response, "function") expect_is(aa$disable, "function") expect_is(aa$enable, "function") expect_is(aa$handle_request, "function") expect_is(aa$remove_crul_stubs, "function") expect_is(aa$name, "character") expect_equal(aa$name, "crul_adapter") }) test_that("CrulAdapter behaves correctly", { skip_on_cran() expect_message(aa$enable(), "CrulAdapter enabled!") expect_message(aa$disable(), "CrulAdapter disabled!") }) test_that("CrulAdapter fails well", { skip_on_cran() expect_error(aa$build_crul_request(), "argument \"x\" is missing") expect_error(aa$build_crul_response(), "argument \"req\" is missing") }) context("CrulAdapter - with real data") test_that("CrulAdapter works", { skip_on_cran() load("crul_obj.rda") res <- CrulAdapter$new() expect_error( res$handle_request(crul_obj), "Real HTTP connections are disabled.\nUnregistered request: GET http://localhost:9000/get\n\nYou can stub this request with the following snippet" ) invisible(stub_request("get", "http://localhost:9000/get")) aa <- res$handle_request(crul_obj) expect_is(res, "CrulAdapter") expect_is(aa, "HttpResponse") expect_equal(aa$method, "get") expect_equal(aa$url, "http://localhost:9000/get") }) webmockr/tests/testthat/test-StubbedRequest.R0000644000175100001440000000454513107670361021160 0ustar hornikuserscontext("StubbedRequest") test_that("StubbedRequest: works", { expect_is(StubbedRequest, "R6ClassGenerator") aa <- StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get") expect_is(aa, "StubbedRequest") expect_null(aa$host) expect_null(aa$query) expect_null(aa$body) expect_null(aa$request_headers) expect_null(aa$response_headers) expect_null(aa$response) expect_null(aa$response_sequences) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https:/httpbin.org/get") expect_is(aa$uri_parts, "list") expect_equal(aa$uri_parts$domain, "https") expect_equal(aa$uri_parts$path, "httpbin.org/get") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "get: https:/httpbin.org/get") # with expect_is(aa$with, "function") expect_null(aa$query) aa$with(query = list(foo = "bar")) expect_is(aa$query, "list") expect_named(aa$query, "foo") # to_return expect_is(aa$to_return, "function") expect_null(aa$body) aa$to_return( status = 404, body = list(hello = "world"), headers = list(a = 5) ) expect_is(aa$responses_sequences, "list") expect_is(aa$responses_sequences$body, "list") expect_named(aa$responses_sequences$body, "hello") }) test_that("StubbedRequest: different methods work", { expect_equal( StubbedRequest$new(method = "any", uri = "https:/httpbin.org/get")$method, "any" ) expect_equal( StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get")$method, "get" ) expect_equal( StubbedRequest$new(method = "head", uri = "https:/httpbin.org/get")$method, "head" ) expect_equal( StubbedRequest$new(method = "post", uri = "https:/httpbin.org/get")$method, "post" ) expect_equal( StubbedRequest$new(method = "put", uri = "https:/httpbin.org/get")$method, "put" ) expect_equal( StubbedRequest$new(method = "patch", uri = "https:/httpbin.org/get")$method, "patch" ) expect_equal( StubbedRequest$new(method = "delete", uri = "https:/httpbin.org/get")$method, "delete" ) }) test_that("StubbedRequest fails well", { # requires uri or uri_regex expect_error(StubbedRequest$new(), "one of uri or uri_regex is required") # method not in acceptable set expect_error(StubbedRequest$new(method = "adf"), "'arg' should be one of") }) webmockr/tests/testthat/test-StubRegistry.R0000644000175100001440000000620313107210030020635 0ustar hornikuserscontext("StubRegistry") aa <- StubRegistry$new() test_that("StubRegistry: bits are correct prior to having data", { expect_is(StubRegistry, "R6ClassGenerator") expect_is(aa, "StubRegistry") expect_is(aa$global_stubs, "list") expect_equal(length(aa$global_stubs), 0) expect_is(aa$request_stubs, "list") expect_equal(length(aa$request_stubs), 0) expect_null(aa$stub) expect_is(aa$find_stubbed_request, "function") expect_is(aa$is_registered, "function") expect_is(aa$print, "function") expect_is(aa$register_stub, "function") expect_is(aa$remove_all_request_stubs, "function") expect_is(aa$remove_request_stub, "function") expect_is(aa$request_stub_for, "function") expect_is(aa$response_for_request, "function") }) test_that("StubRegistry: bits are correct after having data", { stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") stub1$with(headers = list('User-Agent' = 'R')) stub1$to_return(status = 200, body = "foobar", headers = list()) stub2 <- StubbedRequest$new(method = "get", uri = "https://httpbin.org") aa <- StubRegistry$new() expect_is(aa$register_stub(stub = stub1), "list") expect_is(aa$register_stub(stub = stub2), "list") expect_is(aa, "StubRegistry") # global stubs are still empty expect_is(aa$global_stubs, "list") expect_equal(length(aa$global_stubs), 0) # request stubs now length 2 expect_is(aa$request_stubs, "list") expect_equal(length(aa$request_stubs), 2) expect_null(aa$stub) # find_stubbed_request req1 <- RequestSignature$new( method = "get", uri = "http://api.crossref.org", options = list( headers = list('User-Agent' = 'R') ) ) res <- aa$find_stubbed_request(req = req1) expect_is(res, "list") expect_is(res[[1]], "StubbedRequest") expect_equal(res[[1]]$uri, "api.crossref.org") # is_registered expect_true(aa$is_registered(x = req1)) # request_stub_for matches <- aa$request_stub_for(request_signature = req1) expect_is(matches, "logical") expect_equal(matches, c(TRUE, FALSE)) # response_for_request ## FIXME!!!! - internal function not made yet expect_error(aa$response_for_request(request_signature = req1), "could not find function") # remove_request_stub res <- aa$remove_request_stub(stub = stub1) expect_is(res, "list") expect_equal(length(res), 1) # remove_all_request_stubs ## add another first aa$register_stub(stub = stub1) res <- aa$remove_all_request_stubs() expect_is(res, "list") expect_equal(length(res), 0) }) test_that("StubRegistry fails well", { # fill ins ome data first stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") aa <- StubRegistry$new() aa$register_stub(stub = stub1) expect_error(aa$find_stubbed_request(), "argument \"req\" is missing") expect_error(aa$is_registered(), "argument \"x\" is missing") expect_error(aa$register_stub(), "argument \"stub\" is missing") expect_error(aa$remove_request_stub(), "argument \"stub\" is missing") expect_error(aa$request_stub_for(), "argument \"request_signature\" is missing") expect_error(aa$response_for_request(), "argument \"request_signature\" is missing") }) webmockr/tests/testthat/test-RequestSignature.R0000644000175100001440000000233013077433000021510 0ustar hornikuserscontext("RequestSignature") test_that("RequestSignature: works", { expect_is(RequestSignature, "R6ClassGenerator") aa <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") expect_is(aa, "RequestSignature") expect_null(aa$auth) expect_null(aa$body) expect_null(aa$headers) expect_null(aa$proxies) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https:/httpbin.org/get") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "GET https:/httpbin.org/get") }) test_that("RequestSignature: different methods work", { aa <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") aa$headers <- list(Accept = "application/json") aa$body <- list(foo = "bar") expect_is(aa$method, "character") expect_is(aa$uri, "character") expect_is(aa$headers, "list") expect_is(aa$body, "list") }) test_that("RequestSignature fails well", { expect_error(RequestSignature$new(), "argument \"method\" is missing") expect_error(RequestSignature$new(method = "adf"), "'arg' should be one of") expect_error(RequestSignature$new(method = "get"), "argument \"uri\" is missing") }) webmockr/tests/testthat/test-wi_th.R0000644000175100001440000000206113107670405017317 0ustar hornikuserscontext("wi_th") test_that("wi_th: with just headers", { aa <- stub_request("get", "https://httpbin.org/get") %>% wi_th(headers = list('User-Agent' = 'R')) expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$query) expect_is(aa$request_headers, "list") expect_null(aa$response) expect_null(aa$response_headers) expect_null(aa$responses_sequences) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https://httpbin.org/get") expect_equal(aa$request_headers, list('User-Agent' = 'R')) }) test_that("wi_th: with headers and query", { aa <- stub_request("get", "https://httpbin.org/get") %>% wi_th( query = list(hello = "world"), headers = list('User-Agent' = 'R')) expect_is(aa$query, "list") expect_is(aa$request_headers, "list") expect_output(print(aa), "hello=world") expect_output(print(aa), "User-Agent=R") }) test_that("wi_th fails well", { expect_error(wi_th(), "argument \".data\" is missing") }) webmockr/tests/testthat/test-Response.R0000644000175100001440000000623713077234620020015 0ustar hornikuserscontext("Response") aa <- Response$new() test_that("Response: bits are correct prior to having data", { expect_is(Response, "R6ClassGenerator") expect_is(aa, "Response") expect_null(aa$body, "function") expect_null(aa$content, "function") expect_null(aa$exception, "function") expect_is(aa$get_body, "function") expect_is(aa$get_exception, "function") expect_is(aa$get_request_headers, "function") expect_is(aa$get_respone_headers, "function") expect_is(aa$get_status, "function") expect_is(aa$get_url, "function") expect_is(aa$print, "function") expect_is(aa$set_body, "function") expect_is(aa$set_exception, "function") expect_is(aa$set_request_headers, "function") expect_is(aa$set_response_headers, "function") expect_is(aa$set_status, "function") expect_is(aa$set_url, "function") expect_null(aa$should_timeout, "function") expect_null(aa$request_headers) expect_null(aa$response_headers) expect_equal(aa$status_code, 200) expect_null(aa$url) expect_null(aa$name) }) test_that("Response: bits are correct after having data", { aa <- Response$new() aa$set_url("https://httpbin.org/get") aa$set_request_headers(list('Content-Type' = "application/json")) aa$set_response_headers(list('Host' = "httpbin.org")) aa$set_status(404) aa$set_body("hello world") aa$set_exception("exception") expect_is(aa, "Response") expect_null(aa$should_timeout) expect_is(aa$request_headers, "list") expect_named(aa$request_headers, "Content-Type") expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "Host") expect_equal(aa$status_code, 404) expect_equal(aa$url, "https://httpbin.org/get") expect_null(aa$name) expect_equal(aa$body, "hello world") expect_null(aa$content) expect_equal(aa$exception, "exception") expect_equal(aa$get_body(), "hello world") expect_equal(aa$get_exception(), "exception") expect_equal(aa$get_request_headers()[[1]], "application/json") expect_equal(aa$get_respone_headers()[[1]], "httpbin.org") expect_equal(aa$get_status(), 404) expect_equal(aa$get_url(), "https://httpbin.org/get") expect_output(aa$print(), "") expect_output(aa$print(), "headers") expect_output(aa$print(), "request headers") aa$set_body(body = "stuff") expect_equal(aa$body, "stuff") aa$set_exception(exception = "stop, wait, listen") expect_equal(aa$exception, "stop, wait, listen") aa$set_request_headers(headers = list(a = "howdy")) expect_equal(aa$request_headers[[1]], "howdy") aa$set_response_headers(headers = list(b = 6)) expect_equal(aa$get_respone_headers()[[1]], "6") aa$set_status(status = 410) expect_equal(aa$status_code, 410) aa$set_url(url = "foobar.com") expect_equal(aa$url, "foobar.com") }) test_that("Response fails well", { expect_error(aa$set_body(), "argument \"body\" is missing") expect_error(aa$set_exception(), "argument \"exception\" is missing") expect_error(aa$set_request_headers(), "argument \"headers\" is missing") expect_error(aa$set_response_headers(), "argument \"headers\" is missing") expect_error(aa$set_status(), "argument \"status\" is missing") expect_error(aa$set_url(), "argument \"url\" is missing") }) webmockr/tests/testthat/test-RequestRegistry.R0000644000175100001440000000226313107067702021372 0ustar hornikuserscontext("RequestRegistry") test_that("RequestRegistry: structure", { expect_is(RequestRegistry, "R6ClassGenerator") aa <- RequestRegistry$new() expect_is(aa, "RequestRegistry") expect_is(aa$clone, "function") expect_is(aa$print, "function") expect_is(aa$register_request, "function") expect_null(aa$request) expect_is(aa$request_signatures, "HashCounter") expect_is(aa$reset, "function") }) test_that("RequestRegistry: behaves as expected", { aa <- RequestRegistry$new() aa$reset() expect_length(aa$request_signatures$hash, 0) aa$register_request(request = "GET https://scottchamberlain.info") aa$register_request(request = "GET https://scottchamberlain.info") expect_length(aa$request_signatures$hash, 1) expect_equal( aa$request_signatures$hash$`GET https://scottchamberlain.info`, 2 ) expect_output( print(aa), "Registered Requests" ) expect_output( print(aa), "GET https://scottchamberlain.info was made" ) # reset the request registry aa$reset() expect_length(aa$request_signatures$hash, 0) }) test_that("RequestRegistry fails well", { x <- RequestRegistry$new() expect_error(x$register_request(), "'key' required") }) webmockr/tests/testthat/test-RequestPattern.R0000644000175100001440000000431213107102552021165 0ustar hornikuserscontext("RequestPattern") test_that("RequestPattern: structure is correct", { expect_is(RequestPattern, "R6ClassGenerator") aa <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") expect_is(aa, "RequestPattern") expect_null(aa$body_pattern) expect_null(aa$headers_pattern) expect_is(aa$clone, "function") expect_is(aa$initialize, "function") expect_is(aa$matches, "function") expect_is(aa$method_pattern, "MethodPattern") expect_is(aa$to_s, "function") expect_is(aa$uri_pattern, "UriPattern") }) test_that("RequestPattern: behaves as expected", { aa <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") rs1 <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get") rs2 <- RequestSignature$new(method = "post", uri = "https://httpbin.org/get") expect_true(aa$matches(rs1)) expect_false(aa$matches(rs2)) expect_is(aa$to_s(), "character") expect_match(aa$to_s(), "GET") expect_match(aa$to_s(), "httpbin.org/get") }) test_that("RequestPattern fails well", { x <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") expect_error(x$matches(), "argument \"request_signature\" is missing") expect_error(x$matches("adfadf"), "request_signature must be of class RequestSignature") }) context("MethodPattern") test_that("MethodPattern: structure is correct", { expect_is(MethodPattern, "R6ClassGenerator") aa <- MethodPattern$new(pattern = "get") expect_is(aa, "MethodPattern") expect_is(aa$pattern, "character") expect_equal(aa$pattern, "get") expect_true(aa$matches(method = "get")) expect_false(aa$matches(method = "post")) expect_error( expect_is(aa$matches(), "function"), "argument \"method\" is missing" ) }) context("HeadersPattern") test_that("HeadersPattern: structure is correct", { expect_is(HeadersPattern, "R6ClassGenerator") aa <- HeadersPattern$new(pattern = list(a = 5)) expect_is(aa, "HeadersPattern") expect_is(aa$pattern, "list") expect_named(aa$pattern, "a") expect_true(aa$matches(headers = list(a = 5))) expect_false(aa$matches(headers = list(a = 6))) expect_error( expect_is(aa$matches(), "function"), "argument \"headers\" is missing" ) }) webmockr/tests/test-all.R0000644000175100001440000000005313077016675015125 0ustar hornikuserslibrary("testthat") test_check("webmockr") webmockr/NAMESPACE0000644000175100001440000000154213107433057013325 0ustar hornikusers# Generated by roxygen2: do not edit by hand export("%>%") export(BodyPattern) export(CrulAdapter) export(HashCounter) export(HeadersPattern) export(HttpLibAdapaterRegistry) export(MethodPattern) export(RequestPattern) export(RequestRegistry) export(RequestSignature) export(Response) export(StubRegistry) export(StubbedRequest) export(UriPattern) export(disable) export(enable) export(remove_request_stub) export(stub_registry) export(stub_registry_clear) export(stub_request) export(to_return) export(to_return_) export(webmockr_allow_net_connect) export(webmockr_configuration) export(webmockr_configure) export(webmockr_configure_reset) export(webmockr_disable) export(webmockr_disable_net_connect) export(webmockr_enable) export(webmockr_net_connect_allowed) export(wi_th) export(wi_th_) import(R6) import(lazyeval) import(magrittr) importFrom(magrittr,"%>%") webmockr/NEWS.md0000644000175100001440000000010513107751367013205 0ustar hornikuserswebmockr 0.1.0 ============== ### NEW FEATURES * Released to CRAN. webmockr/R/0000755000175100001440000000000013107432614012303 5ustar hornikuserswebmockr/R/stub_request.R0000644000175100001440000000342513107752421015160 0ustar hornikusers#' Stub an http request #' #' @export #' @param method (character) HTTP method, one of "get", "post", "put", "patch", #' "head", "delete", "options" - or the special "any" (for any method) #' @param uri (character) The request uri. Can be a full uri, partial, or a #' regular expression to match many incantations of a uri. required. #' @param uri_regex (character) A URI represented as regex. See examples #' @return an object of class `StubbedRequest`, with print method describing #' the stub. #' @details Internally, this calls [StubbedRequest] which handles the logic #' #' See [stub_registry()] for listing stubs, [stub_registry_clear()] #' for removing all stubs and [remove_request_stub()] for removing specific #' stubs #' @seealso [wi_th()], [to_return()] #' @examples \dontrun{ #' # basic stubbing #' stub_request("get", "https://httpbin.org/get") #' stub_request("post", "https://httpbin.org/post") #' #' # list stubs #' stub_registry() #' #' # add header #' stub_request("get", "https://httpbin.org/get") %>% #' wi_th(headers = list('User-Agent' = 'R')) #' #' # add expectation with to_return #' stub_request("get", "https://httpbin.org/get") %>% #' wi_th( #' query = list(hello = "world"), #' headers = list('User-Agent' = 'R')) %>% #' to_return(status = 200, body = "stuff", headers = list(a = 5)) #' #' # list stubs again #' stub_registry() #' #' # regex #' stub_request("get", uri_regex = ".+ample\\..") #' #' # clear all stubs #' stub_registry_clear() #' } stub_request <- function(method = "get", uri = NULL, uri_regex = NULL) { if (is.null(uri) && is.null(uri_regex)) { stop("one of uri or uri_regex is required", call. = FALSE) } tmp <- StubbedRequest$new(method = method, uri = uri, uri_regex = uri_regex) webmockr_stub_registry$register_stub(tmp) return(tmp) } webmockr/R/onload.R0000644000175100001440000000204513077211323013701 0ustar hornikusers#webmockr_stub_registry <- NULL http_lib_adapter_registry <- NULL .onLoad <- function(libname, pkgname) { webmockr_configure() x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) http_lib_adapter_registry <<- x # initialize empty stub registry on package load # webmockr_stub_registry <<- new.env() # webmockr_stub_registry <- webmockr::StubRegistry$new() } # .onAttach <- function(libname, pkgname) { # #base::unlockBinding("request_perform", as.environment("package:httr")) # utils::assignInNamespace("request_perform", request_perform, "httr") # #base::lockBinding("request_perform", as.environment("package:httr")) # } # .onAttach <- function(libname, pkgname) { # when_attached("httr", { # utils::assignInNamespace("request_perform", request_perform, "httr") # }) # } # # when_attached <- function(pkg, action) { # if (is_attached(pkg)) { # action # } else { # setHook(packageEvent(pkg, "attach"), function(...) action) # } # } # # is_attached <- function(pkg) paste0("package:", pkg) %in% search() webmockr/R/RequestPattern.R0000644000175100001440000003543413107660050015422 0ustar hornikusers#' RequestPattern class #' #' @export #' @param method the HTTP method (any, head, options, get, post, put, #' patch, trace, or delete). "any" matches any HTTP method. required. #' @param uri (character) request URI. required or uri_regex #' @param uri_regex (character) request URI as regex. required or uri #' @param query (list) query parameters, optional #' @param body (list) body request, optional #' @param headers (list) headers, optional #' @details #' **Methods** #' \describe{ #' \item{`matches(request_signature)`}{ #' Test if request_signature matches a pattern #' - request_signature: a request signature #' } #' \item{`to_s()`}{ #' Print pattern for easy human consumption #' } #' } #' @format NULL #' @usage NULL #' @seealso pattern classes for HTTP method [MethodPattern], headers #' [HeadersPattern], body [BodyPattern], and URI/URL [UriPattern] #' @examples \dontrun{ #' (x <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get")) #' x$body_pattern #' x$headers_pattern #' x$method_pattern #' x$uri_pattern #' x$to_s() #' #' # make a request signature #' rs <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get") #' #' # check if it matches #' x$matches(rs) #' #' # regex uri #' (x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org")) #' x$uri_pattern #' x$uri_pattern$to_s() #' x$to_s() #' #' # uri with query parameters #' (x <- RequestPattern$new( #' method = "get", uri = "https://httpbin.org/get", #' query = list(foo = "bar") #' )) #' x$to_s() #' } RequestPattern <- R6::R6Class( 'RequestPattern', public = list( method_pattern = NULL, uri_pattern = NULL, body_pattern = NULL, headers_pattern = NULL, initialize = function(method, uri = NULL, uri_regex = NULL, query = NULL, body = NULL, headers = NULL) { if (is.null(uri) && is.null(uri_regex)) { stop("one of uri or uri_regex is required", call. = FALSE) } self$method_pattern <- MethodPattern$new(pattern = method) self$uri_pattern <- if (!is.null(uri)) { UriPattern$new(pattern = uri) } else { UriPattern$new(regex_pattern = uri_regex) } self$uri_pattern$add_query_params(query) self$body_pattern <- if (!is.null(body)) BodyPattern$new(pattern = body) self$headers_pattern <- if (!is.null(headers)) HeadersPattern$new(pattern = headers) #if (length(options)) private$assign_options(options) }, matches = function(request_signature) { assert(request_signature, "RequestSignature") c_type <- if (!is.null(request_signature$headers)) request_signature$headers$`Content-Type` else NULL c_type <- if (!is.null(c_type)) strsplit(c_type, ';')[[1]][1] self$method_pattern$matches(request_signature$method) && self$uri_pattern$matches(request_signature$uri) && (is.null(self$body_pattern) || self$body_pattern$matches(request_signature$body, c_type %||% "")) && (is.null(self$headers_pattern) || self$headers_pattern$matches(request_signature$headers)) }, to_s = function() { gsub("^\\s+|\\s+$", "", paste( toupper(self$method_pattern$to_s()), self$uri_pattern$to_s(), if (!is.null(self$body_pattern)) paste0(" with body ", self$body_pattern$to_s()), if (!is.null(self$headers_pattern)) paste0(" with headers ", self$headers_pattern$to_s()) )) } ), private = list( # assign_options = function(options) { # #self$validate_keys(options, 'body', 'headers', 'query', 'basic_auth') # set_basic_auth_as_headers(options) # self$body_pattern <- if ('body' %in% names(options)) BodyPattern$new(options['body']) # self$headers_pattern <- if ('headers' %in% names(options)) HeadersPattern$new(options['headers']) # if ('query' %in% names(options)) self$uri_pattern$add_query_params(options['query']) # }, # validate_keys = function(x, ...) { # valid_keys <- unlist(list(...), recursive = FALSE) # for (i in seq_along(x)) { # if (!names(x)[i] %in% valid_keys) { # stop( # sprintf("Unknown key: %s. Valid keys are: %s", # names(x)[i], # paste0(valid_keys, collapse = ", "), # call. = FALSE # ) # ) # } # } # }, set_basic_auth_as_headers = function(options) { if ('basic_auth' %in% names(options)) { private$validate_basic_auth(options$basic_auth) options$headers <- list() options$headers$Authorization <- private$make_basic_auth(options$basic_auth[1], options$basic_auth[2]) } }, validate_basic_auth = function(x) { if (!inherits(x, "list") || length(unique(unname(unlist(x)))) == 1) { stop( "'basic_auth' option should be a list of length 2: username and password", call. = FALSE ) } }, make_basic_auth = function(x, y) { jsonlite::base64_enc(paste0(x, ":", y)) } ) ) #' MethodPattern #' #' @export #' @keywords internal #' @param pattern (character) a HTTP method, lowercase #' @details #' **Methods** #' \describe{ #' \item{`matches(method)`}{ #' An HTTP method #' - method (character) #' } #' } #' #' @details Matches regardless of case. e.g., POST will match to post #' @format NULL #' @usage NULL #' @examples #' (x <- MethodPattern$new(pattern = "post")) #' x$pattern #' x$matches(method = "post") #' x$matches(method = "POST") MethodPattern <- R6::R6Class( 'MethodPattern', public = list( pattern = NULL, initialize = function(pattern) { self$pattern <- tolower(pattern) }, matches = function(method) { self$pattern == tolower(method) || self$pattern == "any" }, to_s = function() self$pattern ) ) #' HeadersPattern #' #' @export #' @keywords internal #' @param pattern (list) a pattern, as a named list, must be named, #' e.g,. `list(a = 5, b = 6)` #' @details #' **Methods** #' \describe{ #' \item{`matches(headers)`}{ #' Match a list of headers against that stored #' - headers (list) named list of headers, e.g,. `list(a = 5, b = 6)` #' } #' } #' @details #' `webmockr` normalises headers and treats all forms of same headers as equal: #' i.e the following two sets of headers are equal: #' `list(Header1 = "value1", content_length = 123, X_CuStOm_hEAder = "foo")` #' and #' `list(header1 = "value1", "Content-Length" = 123, "x-cuSTOM-HeAder" = "foo")` #' @format NULL #' @usage NULL #' @examples #' (x <- HeadersPattern$new(pattern = list(a = 5))) #' x$pattern #' x$matches(list(a = 5)) #' #' # different cases #' (x <- HeadersPattern$new(pattern = list(Header1 = "value1"))) #' x$pattern #' x$matches(list(header1 = "value1")) #' x$matches(list(header1 = "value2")) #' #' # different symbols #' (x <- HeadersPattern$new(pattern = list(`Hello_World` = "yep"))) #' x$pattern #' x$matches(list(`hello-world` = "yep")) #' x$matches(list(`hello-worlds` = "yep")) HeadersPattern <- R6::R6Class( 'HeadersPattern', public = list( pattern = NULL, initialize = function(pattern) { stopifnot(is.list(pattern)) # # normalize names # names(pattern) <- tolower(names(pattern)) # # normalize symbols # ## underscores to single dash # names(pattern) <- gsub("_", "-", names(pattern)) pattern <- private$normalize_headers(pattern) self$pattern <- pattern }, matches = function(headers) { headers <- private$normalize_headers(headers) if (self$empty_headers(self$pattern)) { self$empty_headers(headers) } else { if (self$empty_headers(headers)) return(FALSE) out <- c() for (i in seq_along(self$pattern)) { out[i] <- names(self$pattern)[i] %in% names(headers) && self$pattern[[i]] == headers[names(self$pattern)[i]] } all(out) } }, empty_headers = function(headers) { is.null(headers) || length(headers) == 0 }, to_s = function() self$pattern ), private = list( normalize_headers = function(x) { # normalize names names(x) <- tolower(names(x)) # normalize symbols ## underscores to single dash names(x) <- gsub("_", "-", names(x)) return(x) } ) ) #' BodyPattern #' #' @export #' @keywords internal #' @param pattern (list) a body object #' @details #' **Methods** #' \describe{ #' \item{`matches(body, content_type = "")`}{ #' Match a body object against that given in `pattern` #' - body (list) the body #' - content_type (character) content type #' } #' } #' @format NULL #' @usage NULL #' @examples #' z <- BodyPattern$new(pattern = list(a = "foobar")) #' z$pattern BodyPattern <- R6::R6Class( 'BodyPattern', public = list( pattern = NULL, body = NULL, content_type = NULL, headers = NULL, string = NULL, initialize = function(pattern) { self$pattern <- pattern }, matches = function(body, content_type = "") { if (inherits(self$pattern, "list")) { if (length(self$pattern) == 0) return(TRUE) private$matching_hashes(self$body_as_hash(body, content_type), self$pattern) } else { private$empty_string(self$pattern) && private$empty_string(body) || self$pattern == body } }, to_s = function() self$pattern ), private = list( empty_headers = function(headers) { is.null(headers) || length(headers) == 0 }, empty_string = function(string) { is.null(string) || nchar(string) == 0 }, matching_hashes = function(query_parameters, pattern) { if (inherits(query_parameters, "list")) return(FALSE) if (sort(names(query_parameters)) == sort(names(self$pattern))) return(FALSE) for (i in seq_along(query_parameters)) { expected <- self$pattern[names(query_parameters)[i]] if (inherits(actual, "list") && inherits(expected, "list")) { if (private$matching_hashes(actual, expected)) return(FALSE) } else { if (identical(actual, expected)) return(FALSE) } } }, body_as_hash = function(body, content_type) { bctype <- BODY_FORMATS[[content_type]] if (bctype == 'json') { jsonlite::fromJSON(body, FALSE) } else if (bctype == 'xml') { xml2::read_xml(body) } else { stop('fix me') } } ) ) BODY_FORMATS <- list( 'text/xml' = 'xml', 'application/xml' = 'xml', 'application/json' = 'json', 'text/json' = 'json', 'application/javascript' = 'json', 'text/javascript' = 'json', 'text/html' = 'html', 'application/x-yaml' = 'yaml', 'text/yaml' = 'yaml', 'text/plain' = 'plain' ) #' UriPattern #' #' @export #' @keywords internal #' @param pattern (character) a uri, either plain character string or #' regex, see [base::regex]. if scheme is missing, it is added (we assume #' http) #' @details #' **Methods** #' \describe{ #' \item{`add_query_params`}{ #' Add query parameters to the URI #' - query_params #' } #' \item{`matches(uri)`}{ #' Match a uri against that given in `pattern` #' - uri (character) a uri, including scheme (i.e., http or https) #' } #' } #' @format NULL #' @usage NULL #' @examples #' # trailing slash #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://foobar.com") #' z$matches("http://foobar.com/") #' #' # default ports #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://foobar.com:80") #' z$matches("http://foobar.com:80/") #' z$matches("http://foobar.com:443") #' z$matches("http://foobar.com:443/") #' #' # user info #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://user:pass@foobar.com") #' #' # regex #' (z <- UriPattern$new(regex_pattern = ".+ample\\..")) #' z$matches("http://sample.org") #' z$matches("http://example.com") #' z$matches("http://tramples.net") #' #' # add query parameters #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) #' z$pattern #' #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$add_query_params(list(pizza = "deep dish", cheese = "cheddar")) #' z$pattern UriPattern <- R6::R6Class( 'UriPattern', public = list( pattern = NULL, query_params = NULL, regex = FALSE, initialize = function(pattern = NULL, regex_pattern = NULL) { stopifnot(xor(is.null(pattern), is.null(regex_pattern))) if (!is.null(regex_pattern)) self$regex <- TRUE pattern <- if (!is.null(pattern)) pattern else regex_pattern self$pattern <- normalize_uri(add_scheme(pattern)) }, matches = function(uri) { # normalize uri uri <- normalize_uri(uri) # FIXME, may need to match optionally to URI alone or URI + query # params, etc. if (!self$regex) return(uri == self$pattern) if (self$regex) return(grepl(self$pattern, uri)) }, add_query_params = function(query_params) { if ( inherits(query_params, "list") || inherits(query_params, "character") ) { pars <- paste0(unname(Map(function(x, y) paste(x, esc(y), sep = "="), names(query_params), query_params)), collapse = "&") self$pattern <- paste0(self$pattern, "?", pars) } }, to_s = function() self$pattern ) ) add_scheme <- function(x) { if (is.na(urltools::url_parse(x)$scheme)) { paste0('http://', x) } else { x } } esc <- function(x) curl::curl_escape(x) normalize_uri <- function(x) { x <- prune_trailing_slash(x) x <- prune_port(x) tmp <- urltools::url_parse(x) if (is.na(tmp$path)) return(x) tmp$path <- esc(tmp$path) urltools::url_compose(tmp) } prune_trailing_slash <- function(x) sub("/$", "", x) prune_port <- function(x) gsub("(:80)|(:443)", "", x) prune_user_pwd <- function(x) # matcher helpers -------------------------- get_method <- function(x) { x <- as.character(x) tmp <- grep( "(get)$|(post)$|(put)$|(delete)$|(options)$|(patch)$|(head)$", tolower(x), value = TRUE) tmp <- sub("httr::", "", tmp) if (length(tmp) == 0) NULL else tmp } is_url <- function(x) { grepl("https?://", x, ignore.case = TRUE) || grepl("localhost:[0-9]{4}", x, ignore.case = TRUE) } get_uri <- function(x) { x <- as.character(x) #tmp <- grep("(https?|ftp|file)?:?(//)?[-A-Za-z0-9]+\\.[A-Za-z0-9]+", x, value = TRUE) tmp <- x[vapply(x, is_url, logical(1))] if (length(tmp) == 0) NULL else tmp } get_host <- function(x) { eval(parse(text = vcr_c$uri_parser))(x)$hostname } get_path <- function(x) { eval(parse(text = vcr_c$uri_parser))(x)$path } get_query <- function(x) { if ("query" %in% names(x)) { x[["query"]] } else { NULL } } get_body <- function(x) { if ("body" %in% names(x)) { x[["body"]] } else { NULL } } webmockr/R/stub_registry_clear.R0000644000175100001440000000030513107432713016477 0ustar hornikusers#' Clear the stub registry #' #' Clear all stubs #' #' @export #' @return nothing #' @family stub-registry stub_registry_clear <- function() { webmockr_stub_registry$remove_all_request_stubs() } webmockr/R/Response.R0000644000175100001440000001700313077430023014223 0ustar hornikusers#' Response class #' #' @export #' @param options (list) a list of options #' @details #' **Methods** #' \describe{ #' \item{`set_request_headers(headers)`}{ #' set request headers #' - headers: a list of key-value pair headers #' } #' \item{`get_request_headers()`}{ #' get request headers #' } #' \item{`set_response_headers(headers)`}{ #' set response headers #' - headers: a list of key-value pair headers #' } #' \item{`get_response_headers()`}{ #' get response headers #' } #' \item{`set_body(body)`}{ #' - body: must be a string #' } #' \item{`get_body()`}{ #' get body #' } #' \item{`set_status()`}{ #' - body: must be an integer status code #' } #' \item{`get_status()`}{ #' get status code #' } #' \item{`set_exception()`}{ #' set exception #' } #' \item{`get_exception()`}{ #' get exception #' } #' } #' @format NULL #' @usage NULL #' @examples \dontrun{ #' (x <- Response$new()) #' #' x$set_url("https://httpbin.org/get") #' x #' #' x$set_request_headers(list('Content-Type' = "application/json")) #' x #' x$request_headers #' #' x$set_response_headers(list('Host' = "httpbin.org")) #' x #' x$response_headers #' #' x$set_status(404) #' x #' x$get_status() #' #' x$set_body("hello world") #' x #' x$get_body() #' #' x$set_exception("exception") #' x #' x$get_exception() #' } Response <- R6::R6Class( 'Response', public = list( url = NULL, body = NULL, content = NULL, request_headers = NULL, response_headers = NULL, options = NULL, status_code = 200, exception = NULL, should_timeout = NULL, initialize = function(options = list()) { if (inherits(options, "file") || inherits(options, "character")) { self$options <- read_raw_response(options) } else { self$options <- options } }, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" url: ", self$url), sep = "\n") cat(paste0(" status: ", self$status_code), sep = "\n") cat(" headers: ", sep = "\n") for (i in seq_along(self$request_headers)) { cat(" request headers: ", sep = "\n") cat(paste0(" ", paste(names(self$request_headers)[i], self$request_headers[[i]], sep = ": ")), sep = "\n") } for (i in seq_along(self$response_headers)) { cat(" response headers: ", sep = "\n") cat(paste0(" ", paste(names(self$response_headers)[i], self$response_headers[[i]], sep = ": ")), sep = "\n") } cat(paste0(" exception: ", self$exception), sep = "\n") cat(paste0(" body: ", self$body), sep = "\n") }, set_url = function(url) { self$url <- url }, get_url = function() self$url, set_request_headers = function(headers) { self$request_headers <- private$normalize_headers(headers) }, get_request_headers = function() self$request_headers, set_response_headers = function(headers) { self$response_headers <- private$normalize_headers(headers) }, get_respone_headers = function() self$response_headers, set_body = function(body) { self$body <- body }, get_body = function() self$body %||% '', set_status = function(status) { self$status_code <- status }, get_status = function() self$status_code %||% 200, set_exception = function(exception) { self$exception <- exception }, get_exception = function() self$exception ), private = list( normalize_headers = function(x) normalize_headers(x) ) ) # class ResponseFactory # def self.response_for(options) # if options.respond_to?(:call) # WebMock::DynamicResponse.new(options) # else # WebMock::Response.new(options) # end # end # end # class Response # def initialize(options = {}) # if options.is_a?(IO) || options.is_a?(String) # self.options = read_raw_response(options) # else # self.options = options # end # end # def headers # @headers # end # def headers=(headers) # @headers = headers # if @headers && !@headers.is_a?(Proc) # @headers = Util::Headers.normalize_headers(@headers) # end # end # def body # @body || '' # end # def body=(body) # @body = body # assert_valid_body! # stringify_body! # end # def status # @status || [200, ""] # end # def status=(status) # @status = status.is_a?(Integer) ? [status, ""] : status # end # def exception # @exception # end # def exception=(exception) # @exception = case exception # when String then StandardError.new(exception) # when Class then exception.new('Exception from WebMock') # when Exception then exception # end # end # def raise_error_if_any # raise @exception if @exception # end # def should_timeout # @should_timeout == true # end # def options=(options) # options = WebMock::Util::HashKeysStringifier.stringify_keys!(options) # HashValidator.new(options).validate_keys('headers', 'status', 'body', 'exception', 'should_timeout') # self.headers = options['headers'] # self.status = options['status'] # self.body = options['body'] # self.exception = options['exception'] # @should_timeout = options['should_timeout'] # end # def evaluate(request_signature) # self.body = @body.call(request_signature) if @body.is_a?(Proc) # self.headers = @headers.call(request_signature) if @headers.is_a?(Proc) # self.status = @status.call(request_signature) if @status.is_a?(Proc) # @should_timeout = @should_timeout.call(request_signature) if @should_timeout.is_a?(Proc) # @exception = @exception.call(request_signature) if @exception.is_a?(Proc) # self # end # def ==(other) # self.body == other.body && # self.headers === other.headers && # self.status == other.status && # self.exception == other.exception && # self.should_timeout == other.should_timeout # end # private # def stringify_body! # if @body.is_a?(IO) || @body.is_a?(Pathname) # io = @body # @body = io.read # io.close if io.respond_to?(:close) # end # end # def assert_valid_body! # valid_types = [Proc, IO, Pathname, String, Array] # return if @body.nil? # return if valid_types.any? { |c| @body.is_a?(c) } # raise InvalidBody, "must be one of: #{valid_types}. '#{@body.class}' given" # end # def read_raw_response(raw_response) # if raw_response.is_a?(IO) # string = raw_response.read # raw_response.close # raw_response = string # end # socket = ::Net::BufferedIO.new(raw_response) # response = ::Net::HTTPResponse.read_new(socket) # transfer_encoding = response.delete('transfer-encoding') #chunks were already read by curl # response.reading_body(socket, true) {} # options = {} # options[:headers] = {} # response.each_header {|name, value| options[:headers][name] = value} # options[:headers]['transfer-encoding'] = transfer_encoding if transfer_encoding # options[:body] = response.read_body # options[:status] = [response.code.to_i, response.message] # options # end # InvalidBody = Class.new(StandardError) # end # class DynamicResponse < Response # attr_accessor :responder # def initialize(responder) # @responder = responder # end # def evaluate(request_signature) # options = @responder.call(request_signature) # Response.new(options) # end # end webmockr/R/pipe.R0000644000175100001440000000021313040740114013350 0ustar hornikusers#' Pipe operator #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs NULL webmockr/R/request_is_in_cache.R0000644000175100001440000000022013076516661016426 0ustar hornikusers# Check if request is in cache request_is_in_cache <- function(request_signature) { webmockr_stub_registry$is_registered(request_signature) } webmockr/R/globals.R0000644000175100001440000000011613076511074014052 0ustar hornikusersif (base::getRversion() >= "2.15.1") { utils::globalVariables(c("vcr_c")) } webmockr/R/flipswitch.R0000644000175100001440000000075713077213552014617 0ustar hornikuserswebmockr_lightswitch <- new.env() #webmockr_lightswitch$httr <- FALSE webmockr_lightswitch$crul <- FALSE #' Enable or disable webmockr #' #' @export #' @param options list of options - ignored for now. enable <- function(options = list()) { vapply(http_lib_adapter_registry$adapters, function(z) { z$enable() }, logical(1)) } #' @export #' @rdname enable disable <- function(options = list()) { unlist(lapply(http_lib_adapter_registry$adapters, function(z) { z$disable() })) } webmockr/R/to_return.R0000644000175100001440000000173113107752330014451 0ustar hornikusers#' Expectation for what's returned from a stubbed request #' #' Set response status code, response body, and/or response headers #' #' @export #' @param .data input. Anything that can be coerced to a `StubbedRequest` class #' object #' @param ... Comma separated list of variable names, passed on #' to [lazyeval::lazy_dots()]. accepts the following: status, body, #' headers #' @param .dots Used to work around non-standard evaluation #' @return an object of class `StubbedRequest`, with print method describing #' the stub #' @note see examples in [stub_request()] to_return <- function(.data, ...) { to_return_(.data, .dots = lazyeval::lazy_dots(...)) } #' @export #' @rdname to_return to_return_ <- function(.data, ..., .dots) { tmp <- lazyeval::all_dots(.dots, ...) if (length(tmp) == 0) { z <- NULL } else { z <- lapply(tmp, function(x) eval(x$expr)) } .data$to_return( status = z$status, body = z$body, headers = z$headers ) return(.data) } webmockr/R/remove_request_stub.R0000644000175100001440000000071713107670715016543 0ustar hornikusers#' Remove a request stub #' #' @export #' @param stub a request stub, of class `StubbedRequest` #' @return logical, `TRUE` if removed, `FALSE` if not removed #' @family stub-registry #' @examples #' (x <- stub_request("get", "https://httpbin.org/get")) #' stub_registry() #' remove_request_stub(x) #' stub_registry() remove_request_stub <- function(stub) { stopifnot(inherits(stub, "StubbedRequest")) webmockr_stub_registry$remove_request_stub(stub = stub) } webmockr/R/adapter-crul.R0000644000175100001440000001202513107724442015014 0ustar hornikusers#' crul library adapter #' #' @export #' @family http_lib_adapters #' @details #' **Methods** #' \describe{ #' \item{`enable()`}{ #' Enable the adapter #' } #' \item{`disable()`}{ #' Disable the adapter #' } #' \item{`build_crul_request(x)`}{ #' Build a crul [RequestSignature] #' x: crul request parts (list) #' } #' \item{`build_crul_response(req, resp)`}{ #' Build a crul response #' req: a crul request (list) #' resp: a crul response () #' } #' \item{`handle_request()`}{ #' All logic for handling a request #' req: a crul request (list) #' } #' \item{`remove_crul_stubs()`}{ #' Remove all crul stubs #' } #' } #' #' This adapter modifies \pkg{crul} to allow mocking HTTP requests #' #' @format NULL #' @usage NULL CrulAdapter <- R6::R6Class( 'CrulAdapter', public = list( name = "crul_adapter", enable = function() { message("CrulAdapter enabled!") webmockr_lightswitch$crul <- TRUE }, disable = function() { message("CrulAdapter disabled!") webmockr_lightswitch$crul <- FALSE self$remove_crul_stubs() }, build_crul_request = function(x) { RequestSignature$new( method = x$method, uri = x$url$url, options = list( body = x$body %||% NULL, headers = x$headers %||% NULL, proxies = x$proxies %||% NULL, auth = x$auth %||% NULL ) ) }, build_crul_response = function(req, resp) { crul::HttpResponse$new( method = req$method, url = req$url$url, status_code = resp$status_code, request_headers = c(useragent = req$options$useragent, req$headers), #response_headers = list(), response_headers = { if (grepl("^ftp://", resp$url)) { list() } else { hh <- rawToChar(resp$response_headers %||% raw(0)) if (is.null(hh) || nchar(hh) == 0) { list() } else { crul_headers_parse(curl::parse_headers(hh)) } } }, modified = resp$modified, times = resp$times, content = resp$content, handle = req$url$handle, request = req ) }, handle_request = function(req) { # put request in request registry request_signature <- self$build_crul_request(req) webmockr_request_registry$register_request( request = request_signature$to_s() ) if (request_is_in_cache(request_signature)) { # if real requests NOT allowed # even if net connects allowed, we check if stubbed found first # if user wants to return a partial object # get stub with response and return that ss <- webmockr_stub_registry$find_stubbed_request(request_signature)[[1]] resp <- Response$new() resp$set_url(ss$uri) resp$set_body(ss$body) resp$set_request_headers(ss$request_headers) resp$set_response_headers(ss$response_headers) # generate crul response crul_resp <- self$build_crul_response(req, resp) # add to_return() elements if given if (length(cc(ss$responses_sequences)) != 0) { # remove NULLs toadd <- cc(ss$responses_sequences) # modify responses for (i in seq_along(toadd)) { if (names(toadd)[i] == "status") crul_resp$status_code <- toadd[[i]] if (names(toadd)[i] == "body") crul_resp$content <- toadd[[i]] if (names(toadd)[i] == "headers") crul_resp$response_headers <- toadd[[i]] } } } else if (webmockr_net_connect_allowed()) { # if real requests ARE allowed && nothing found above tmp <- crul::HttpClient$new(url = req$url$url) tmp2 <- webmockr_crul_fetch(req) crul_resp <- self$build_crul_response(req, tmp2) } else { # no stubs found and net connect not allowed x <- "Real HTTP connections are disabled.\nUnregistered request:" y <- "\n\nYou can stub this request with the following snippet:\n\n " z <- "\n\nregistered request stubs:\n\n" msgx <- paste(x, request_signature$to_s()) msgy <- paste( y, #make_stub_request_code(request_signature) private$make_stub_request_code(request_signature) ) if (length(webmockr_stub_registry$request_stubs)) { msgz <- paste( z, paste0(vapply(webmockr_stub_registry$request_stubs, function(z) z$to_s(), ""), collapse = "\n ") ) } else { msgz <- "" } stop(paste0(msgx, msgy, msgz), call. = FALSE) } return(crul_resp) }, remove_crul_stubs = function() { webmockr_stub_registry$remove_all_request_stubs() } ), private = list( make_stub_request_code = function(x) { sprintf( "stub_request('%s', url = '%s')", x$method, x$uri ) } ) ) webmockr/R/HttpLibAdapterRegistry.R0000644000175100001440000000212613107151233017022 0ustar hornikusers#' http lib adapter registry #' #' @export #' @details #' **Methods** #' \describe{ #' \item{`register(x)`}{ #' Register an http library adapter #' x: an http lib adapter, e.g., [CrulAdapter] #' return: nothing, registers the library adapter #' } #' } #' @format NULL #' @usage NULL #' @examples #' x <- HttpLibAdapaterRegistry$new() #' x$register(CrulAdapter$new()) #' x #' x$adapters #' x$adapters[[1]]$name HttpLibAdapaterRegistry <- R6::R6Class( 'HttpLibAdapaterRegistry', public = list( adapters = NULL, print = function(x, ...) { cat(" ", sep = "\n") for (i in seq_along(self$adapters)) { cat(sprintf(" %s: webmockr:::%s", self$adapters[[i]]$name, class(self$adapters[[i]])[1]), sep = "\n") } }, register = function(x) { # FIXME: when other adapters supported, change this inherits test if (!inherits(x, "CrulAdapter")) { stop("'x' must be an adapter, such as CrulAdapter", call. = FALSE) } self$adapters <- cc(list(self$adapters, x)) } ) ) webmockr/R/wi_th.R0000644000175100001440000000177513107752333013555 0ustar hornikusers#' Set additional parts of a stubbed request #' #' Set query params, request body, and/or request headers #' #' @export #' @param .data input. Anything that can be coerced to a `StubbedRequest` class #' object #' @param ... Comma separated list of variable names, passed on #' to [lazyeval::lazy_dots()]. accepts the following: query, body, #' headers #' @param .dots Used to work around non-standard evaluation #' @details `with` is a function in the `base` package, so we went with #' `wi_th` #' @return an object of class `StubbedRequest`, with print method describing #' the stub #' @note see examples in [stub_request()] wi_th <- function(.data, ...) { wi_th_(.data, .dots = lazyeval::lazy_dots(...)) } #' @export #' @rdname wi_th wi_th_ <- function(.data, ..., .dots) { tmp <- lazyeval::all_dots(.dots, ...) if (length(tmp) == 0) { z <- NULL } else { z <- lapply(tmp, function(x) eval(x$expr)) } .data$with( query = z$query, body = z$body, headers = z$headers ) return(.data) } webmockr/R/StubRegistry.R0000644000175100001440000001001213107657764015105 0ustar hornikusers#' Stub registry #' #' @export #' @details #' **Methods** #' \describe{ #' \item{`register_stub(stub)`}{ #' Register a stub #' - stub: an object of class [StubbedRequest] #' } #' \item{`find_stubbed_request(req)`}{ #' Find a stubbed request #' - req: an object of class [RequestSignature] #' } #' \item{`response_for_request(request_signature)`}{ #' Find a stubbed request #' - request_signature: an object of class [RequestSignature] #' } #' \item{`request_stub_for(request_signature)`}{ #' Find a stubbed request #' - request_signature: an object of class [RequestSignature] #' } #' \item{`remove_request_stub(stub)`}{ #' Remove a stubbed request by matching request signature #' - stub: an object of class [StubbedRequest] #' } #' \item{`remove_all_request_stubs()`}{ #' Remove all request stubs #' } #' \item{`is_registered(x)`}{ #' Find a stubbed request #' - x: an object of class [RequestSignature] #' } #' } #' @format NULL #' @usage NULL #' @family stub-registry #' @examples \dontrun{ #' # Make a stub #' stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' stub1$with(request_headers = list('User-Agent' = 'R')) #' stub1$to_return(status = 200, body = "foobar", response_headers = list()) #' stub1 #' #' # Make another stub #' stub2 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' stub2 #' #' # Put both stubs in the stub registry #' reg <- StubRegistry$new() #' reg$register_stub(stub = stub1) #' reg$register_stub(stub = stub2) #' reg #' reg$request_stubs #' } StubRegistry <- R6::R6Class( 'StubRegistry', public = list( stub = NULL, request_stubs = list(), global_stubs = list(), print = function(x, ...) { cat(" ", sep = "\n") cat(" Registered Stubs", sep = "\n") for (i in seq_along(self$request_stubs)) { cat(" ", self$request_stubs[[i]]$to_s(), "\n") } invisible(self$request_stubs) }, register_stub = function(stub) { self$request_stubs <- Filter(length, c(self$request_stubs, stub)) }, find_stubbed_request = function(req) { stubs <- c(self$global_stubs, self$request_stubs) stubs[self$request_stub_for(req)] }, response_for_request = function(request_signature) { stub <- self$request_stub_for(request_signature) evaluate_response_for_request(stub$response, request_signature) %||% NULL }, request_stub_for = function(request_signature) { stubs <- c(self$global_stubs, self$request_stubs) vapply(stubs, function(z) { tmp <- RequestPattern$new(method = z$method, uri = z$uri, uri_regex = z$uri_regex, query = z$query, body = z$body, headers = z$request_headers) tmp$matches(request_signature) }, logical(1)) }, remove_request_stub = function(stub) { xx <- vapply(self$request_stubs, function(x) x$to_s(), "") if (stub$to_s() %in% xx) { self$request_stubs <- self$request_stubs[-which(stub$to_s() %in% xx)] } else { stop( "Request stub \n\n ", stub$to_s(), "\n\n is not registered.", call. = FALSE ) } }, remove_all_request_stubs = function() { self$request_stubs <- list() }, is_registered = function(x) any(self$request_stub_for(x)) ) ) # initialize empty stub registry on package load webmockr_stub_registry <- new.env() webmockr_stub_registry <- StubRegistry$new() # madke body info for print method make_body <- function(x) { if (is.null(x)) return("") paste0(" with body ", jsonlite::toJSON(x, auto_unbox = TRUE)) } # madke headers info for print method make_headers <- function(x) { if (is.null(x)) return("") paste0(" with headers ", jsonlite::toJSON(x, auto_unbox = TRUE)) } # madke body info for print method make_status <- function(x) { if (is.null(x)) return("") paste0(" with status ", as.character(x)) } webmockr/R/RequestRegistry.R0000644000175100001440000000530213107060337015606 0ustar hornikusers#' hash with counter, to store requests, and count each time it is used #' #' @export #' @details #' **Methods** #' \describe{ #' \item{`put(key)`}{ #' Register a request by it's key #' - key: a character string of the request, serialized from #' [CrulAdapter] or other adapter #' } #' \item{`get(key)`}{ #' Get a request by key #' - key: a character string of the request, serialized from #' [CrulAdapter] or other adapter #' } #' } #' @format NULL #' @usage NULL #' @examples #' x <- HashCounter$new() #' x$put("foo bar") #' x$put("foo bar") #' x$put("hello world") #' x$put("hello world") #' x$put("hello world") #' x$hash HashCounter <- R6::R6Class( 'HashCounter', public = list( hash = list(), put = function(key) { if (missing(key)) stop("'key' required") self$hash[key] <- (self$hash[[key]] %||% 0) + 1 }, get = function(key) { if (missing(key)) stop("'key' required") self$hash[[key]] %||% 0 } ) ) #' Request registry #' #' @export #' @details #' **Methods** #' \describe{ #' \item{`register_request(request)`}{ #' Register a request #' - request: a character string of the request, serialized from #' [CrulAdapter] or other adapter #' } #' \item{`reset()`}{ #' Reset the registry to no registered requests #' } #' } #' @format NULL #' @usage NULL #' @examples #' x <- RequestRegistry$new() #' x$register_request(request = "GET http://scottchamberlain.info") #' x$register_request(request = "GET http://scottchamberlain.info") #' x$register_request(request = "POST https://httpbin.org/post") #' # print method to list requests #' x #' #' # hashes, and number of times each requested #' x$request_signatures$hash #' #' # reset the request registry #' x$reset() RequestRegistry <- R6::R6Class( 'RequestRegistry', public = list( request = NULL, request_signatures = HashCounter$new(), print = function(x, ...) { cat(" ", sep = "\n") cat(" Registered Requests", sep = "\n") for (i in seq_along(self$request_signatures$hash)) { cat( sprintf( " %s was made %s times\n", names(self$request_signatures$hash)[i], self$request_signatures$hash[[i]] ), sep = "\n" ) } invisible(self$request_signatures$hash) }, reset = function() { self$request_signatures <- HashCounter$new() }, register_request = function(request) { self$request_signatures$put(request) } ) ) # initialize empty request registry on package load webmockr_request_registry <- new.env() webmockr_request_registry <- RequestRegistry$new() webmockr/R/StubbedRequest.R0000644000175100001440000000775513107653370015411 0ustar hornikusers#' StubbedRequest class #' #' @export #' @param method the HTTP method (any, head, get, post, put, #' patch, or delete). "any" matches any HTTP method. required. #' @param uri (character) request URI. either this or `uri_regex` #' required #' @param uri_regex (character) request URI as regex. either this or `uri` #' required #' @details #' **Methods** #' \describe{ #' \item{`with(query, body, headers)`}{ #' Set expectations for what's given in HTTP request #' \itemize{ #' \item query (list) request query params, as a named list. optional #' \item body (list) request body, as a named list. optional #' \item headers (list) request headers as a named list. optional. #' } #' } #' \item{`to_return(status, body, headers)`}{ #' Set expectations for what's returned in HTTP resonse #' \itemize{ #' \item status (numeric) an HTTP status code #' \item body (list) response body, as a list. optional #' \item headers (list) named list, response headers. optional. #' } #' } #' \item{`to_s()`}{ #' Response as a string #' } #' } #' @format NULL #' @usage NULL #' @seealso [stub_request()] #' @examples \dontrun{ #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$method #' x$uri #' x$with(headers = list('User-Agent' = 'R')) #' x$to_return(status = 200, body = "foobar", headers = list(a = 5)) #' x #' x$to_s() #' #' # uri_regex #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$method #' x$uri #' x$to_s() #' } StubbedRequest <- R6::R6Class( 'StubbedRequest', public = list( method = NULL, uri = NULL, uri_regex = NULL, uri_parts = NULL, host = NULL, query = NULL, body = NULL, request_headers = NULL, response_headers = NULL, response = NULL, responses_sequences = NULL, initialize = function(method, uri = NULL, uri_regex = NULL) { if (!missing(method)) { verb <- match.arg(tolower(method), http_verbs) self$method <- verb } if (is.null(uri) && is.null(uri_regex)) { stop("one of uri or uri_regex is required", call. = FALSE) } self$uri <- if (!is.null(uri)) uri else uri_regex self$uri_parts <- parseurl(self$uri) }, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" method: ", self$method), sep = "\n") cat(paste0(" uri: ", self$uri), sep = "\n") cat(" with: ", sep = "\n") cat(paste0(" query: ", hdl_lst(self$query)), sep = "\n") cat(paste0(" body: ", hdl_lst(self$body)), sep = "\n") cat(paste0(" request_headers: ", hdl_lst(self$request_headers)), sep = "\n") cat(" to_return: ", sep = "\n") cat(paste0(" status: ", hdl_lst(self$responses_sequences$status)), sep = "\n") cat(paste0(" body: ", hdl_lst(self$responses_sequences$body)), sep = "\n") cat(paste0(" response_headers: ", hdl_lst(self$responses_sequences$headers)), sep = "\n") }, with = function(query = NULL, body = NULL, headers = NULL) { self$query <- query self$body <- body self$request_headers <- headers }, to_return = function(status, body, headers) { self$response_headers <- headers self$responses_sequences <- list( status = status, body = body, headers = headers ) }, to_s = function() { toret <- c( make_body(self$responses_sequences$body), make_status(self$responses_sequences$status), make_headers(self$responses_sequences$headers) ) gsub("^\\s+|\\s+$", "", sprintf( " %s: %s %s %s %s", self$method, url_builder(self$uri, self$query), make_body(self$body), make_headers(self$request_headers), # response data if (any(nchar(toret) > 0)) { sprintf("| to_return: %s %s %s", toret[1], toret[2], toret[3]) } else { "" } )) } ) ) webmockr/R/webmockr.R0000644000175100001440000000141513107752211014236 0ustar hornikusers#' Stubbing and setting expectations on HTTP requests #' #' @import magrittr lazyeval R6 #' @name webmockr-package #' @aliases webmockr #' @docType package #' @keywords package #' @author Scott Chamberlain \email{myrmecocystus+r@@gmail.com} #' #' @section Features: #' \itemize{ #' \item Stubbing HTTP requests at low http client lib level #' \item Setting and verifying expectations on HTTP requests #' \item Matching requests based on method, URI, headers and body #' \item Can support many HTTP libraries, though only \pkg{crul} for now #' \item Integration with testing libraries (coming soon) via `vcr` #' } #' #' @examples #' library(webmockr) #' stub_request("get", "https://httpbin.org/get") #' stub_request("post", "https://httpbin.org/post") #' stub_registry() NULL webmockr/R/stub_registry.R0000644000175100001440000000033313107432702015330 0ustar hornikusers#' List stubs in the stub registry #' #' @export #' @return an object of class `StubRegistry`, print method gives the #' stubs in the registry #' @family stub-registry stub_registry <- function() webmockr_stub_registry webmockr/R/headers.R0000644000175100001440000000273713040754262014054 0ustar hornikusers# headers <- list(`Content-type` = 'application/json', Stuff = "things") # normalize_headers(x = headers) normalize_headers <- function(x = NULL) { if (is.null(x) || length(x) == 0) return(x) res <- Map(function(name, value) { name <- paste0( vapply(strsplit(as.character(name), '_|-')[[1]], function(w) simple_cap(w), ""), collapse = "-" ) value <- switch( class(value), #when Regexp then value list = if (length(value) == 1) value[[1]] else sort(vapply(value, function(z) as.character(z), "")), as.character(value) ) list(name, value) }, names(x), unlist(unname(x))) vapply(res, function(z) stats::setNames(z[2], z[1]), list(1)) } simple_cap <- function(x) { s <- strsplit(x, " ")[[1]] paste(toupper(substring(s, 1, 1)), substring(s, 2), sep = "", collapse = " ") } # class Headers # def self.sorted_headers_string(headers) # headers = WebMock::Util::Headers.normalize_headers(headers) # str = '{' # str << headers.map do |k,v| # v = case v # when Regexp then v.inspect # when Array then "["+v.map{|w| "'#{w.to_s}'"}.join(", ")+"]" # else "'#{v.to_s}'" # end # "'#{k}'=>#{v}" # end.sort.join(", ") # str << '}' # end # def self.decode_userinfo_from_header(header) # header.sub(/^Basic /, "").unpack("m").first # end # def self.basic_auth_header(*credentials) # "Basic #{Base64.strict_encode64(credentials.join(':')).chomp}" # end # end webmockr/R/zzz.R0000644000175100001440000000321213107700172013256 0ustar hornikusershttp_verbs <- c("any", "get","post","put","patch","head","delete") cc <- function(x) Filter(Negate(is.null), x) hdl_lst <- function(x) { if (is.null(x) || length(x) == 0) return("") if (inherits(x, "list")) { return(paste(names(x), unname(x), sep = "=", collapse = ", ")) } else { x } } parseurl <- function(x) { tmp <- urltools::url_parse(x) tmp <- as.list(tmp) if (!is.na(tmp$parameter)) { tmp$parameter <- sapply(strsplit(tmp$parameter, "&")[[1]], function(z) { zz <- strsplit(z, split = "=")[[1]] as.list(stats::setNames(zz[2], zz[1])) }, USE.NAMES = FALSE) } tmp } url_builder <- function(uri, args = NULL) { if (is.null(args)) return(uri) paste0(uri, "?", paste(names(args), args, sep = "=", collapse = ",")) } `%||%` <- function(x, y) if (is.null(x)) y else x assert <- function(x, y) { if (!is.null(x)) { if (!class(x)[1] %in% y) { stop(deparse(substitute(x)), " must be of class ", paste0(y, collapse = ", "), call. = FALSE) } } } crul_head_parse <- function(z) { if (grepl("HTTP\\/", z)) { list(status = z) } else { ff <- regexec("^([^:]*):\\s*(.*)$", z) xx <- regmatches(z, ff)[[1]] as.list(stats::setNames(xx[[3]], tolower(xx[[2]]))) } } crul_headers_parse <- function(x) do.call("c", lapply(x, crul_head_parse)) webmockr_crul_fetch <- function(x) { if (is.null(x$disk) && is.null(x$stream)) { curl::curl_fetch_memory(x$url$url, handle = x$url$handle) } else if (!is.null(x$disk)) { curl::curl_fetch_disk(x$url$url, x$disk, handle = x$url$handle) } else { curl::curl_fetch_stream(x$url$url, x$stream, handle = x$url$handle) } } webmockr/R/webmockr-opts.R0000644000175100001440000000647013077247214015237 0ustar hornikusers#' webmockr configuration #' #' @export #' @param turn_on (logical) Default: `FALSE` #' @param allow_net_connect (logical) Default: `TRUE` #' @param allow_localhost (logical) Default: `TRUE` #' @param allow (logical) Default: `TRUE` #' @param net_http_connect_on_start (logical) Default: `TRUE` #' @param show_stubbing_instructions (logical) Default: `TRUE` #' @param query_values_notation (logical) Default: `TRUE` #' @param show_body_diff (logical) Default: `TRUE` #' #' @examples \dontrun{ #' webmockr_configure() #' webmockr_configure( #' allow_localhost = TRUE #' ) #' webmockr_configuration() #' webmockr_configure_reset() #' #' webmockr_allow_net_connect() #' webmockr_net_connect_allowed() #' webmockr_disable_net_connect() #' webmockr_net_connect_allowed() #' } webmockr_configure <- function( turn_on = FALSE, allow_net_connect = FALSE, allow_localhost = FALSE, allow = FALSE, net_http_connect_on_start = FALSE, show_stubbing_instructions = FALSE, query_values_notation = FALSE, show_body_diff = FALSE) { opts <- list( turn_on = turn_on, allow_net_connect = allow_net_connect, allow_localhost = allow_localhost, allow = allow, net_http_connect_on_start = net_http_connect_on_start, show_stubbing_instructions = show_stubbing_instructions, query_values_notation = query_values_notation, show_body_diff = show_body_diff ) for (i in seq_along(opts)) { assign(names(opts)[i], opts[[i]], envir = webmockr_conf_env) } webmockr_configuration() } #' @export #' @rdname webmockr_configure webmockr_configure_reset <- function() webmockr_configure() #' @export #' @rdname webmockr_configure webmockr_configuration <- function() { structure(as.list(webmockr_conf_env), class = "webmockr_config") } #' @export #' @rdname webmockr_configure webmockr_enable <- function() { message("webmockr enabled") assign('turn_on', TRUE, envir = webmockr_conf_env) } #' @export #' @rdname webmockr_configure webmockr_disable <- function() { message("webmockr disabled") assign('turn_on', FALSE, envir = webmockr_conf_env) } #' @export #' @rdname webmockr_configure webmockr_allow_net_connect <- function() { message("net connect allowed") assign('allow_net_connect', TRUE, envir = webmockr_conf_env) } #' @export #' @rdname webmockr_configure webmockr_disable_net_connect <- function() { message("net connect disabled") assign('allow_net_connect', FALSE, envir = webmockr_conf_env) } #' @export #' @rdname webmockr_configure webmockr_net_connect_allowed <- function() { #webmockr_conf_env$allow_net_connect webmockr_conf_env$allow_net_connect #get('allow_net_connect', envir = webmockr_conf_env) } print.webmockr_config <- function(x, ...) { cat("", sep = "\n") cat(paste0(" enabled?: ", x$turn_on), sep = "\n") cat(paste0(" allow_net_collect?: ", x$allow_net_collect), sep = "\n") cat(paste0(" allow_localhost?: ", x$allow_localhost), sep = "\n") cat(paste0(" allow: ", x$allow), sep = "\n") cat(paste0(" net_http_connect_on_start: ", x$net_http_connect_on_start), sep = "\n") cat(paste0(" show_stubbing_instructions: ", x$show_stubbing_instructions), sep = "\n") cat(paste0(" query_values_notation: ", x$query_values_notation), sep = "\n") cat(paste0(" show_body_diff: ", x$show_body_diff), sep = "\n") } webmockr_conf_env <- new.env() webmockr/R/RequestSignature.R0000644000175100001440000001031413107147665015750 0ustar hornikusers#' General purpose request signature builder #' #' @export #' @param method the HTTP method (any, head, options, get, post, put, #' patch, trace, or delete). "any" matches any HTTP method. required. #' @param uri (character) request URI. required. #' @param options (list) options. optional. See Details. #' @details #' **Methods** #' \describe{ #' \item{`to_s()`}{ #' Request signature to a string #' return: a character string representation of the request signature #' } #' } #' #' @section options: #' \itemize{ #' \item body - body as a named list #' \item headers - headers as a named list #' \item proxies - proxies as a named list #' \item auth - authentication details, as a named list #' } #' #' @format NULL #' @usage NULL #' @examples #' # make request signature #' x <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") #' # method #' x$method #' # uri #' x$uri #' # request signature to string #' x$to_s() #' #' # headers #' z <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) #' ) #' z #' z$headers #' z$to_s() #' #' # headers and body #' z <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list( #' headers = list(`User-Agent` = "foobar", stuff = "things"), #' body = list(a = "tables") #' ) #' ) #' z #' z$headers #' z$body #' z$to_s() RequestSignature <- R6::R6Class( 'RequestSignature', public = list( method = NULL, uri = NULL, body = NULL, headers = NULL, proxies = NULL, auth = NULL, initialize = function(method, uri, options = list()) { verb <- match.arg(tolower(method), http_verbs) self$method <- verb self$uri <- uri if (length(options)) private$assign_options(options) }, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" method: ", toupper(self$method)), sep = "\n") cat(paste0(" uri: ", self$uri), sep = "\n") if (!is.null(self$body)) { cat(" body: ", sep = "\n") cat_foo(z$body) } if (!is.null(self$headers)) { cat(" headers: ", sep = "\n") cat_foo(z$headers) } if (!is.null(self$proxies)) { cat(" proxies: ", sep = "\n") cat_foo(z$proxies) } if (!is.null(self$auth)) { cat(" auth: ", sep = "\n") cat_foo(z$auth) } }, to_s = function() { gsub("^\\s+|\\s+$", "", paste( toupper(self$method), self$uri, if (!is.null(self$body) && length(self$body)) { paste0(" with body ", to_string(self$body)) }, if (!is.null(self$headers) && length(self$headers)) { paste0( " with headers ", sprintf("{%s}", paste(names(self$headers), unlist(unname(self$headers)), sep = ": ", collapse = ", ")) ) } )) } ), private = list( assign_options = function(options) { if ('body' %in% names(options)) { if (!is.null(options$body) && length(options)) { self$body <- options$body } } if ('headers' %in% names(options)) { if (!is.null(options$headers) && length(options)) { self$headers <- options$headers } } if ('proxies' %in% names(options)) { if (!is.null(options$proxies) && length(options)) { self$proxies <- options$proxies } } if ('auth' %in% names(options)) { if (!is.null(options$auth) && length(options)) { self$auth <- options$auth } } } ) ) cat_foo <- function(x) { cat(paste0(" ", paste0(paste(names(x), x, sep = ": "), collapse = "\n ")), sep = "\n") } to_string <- function(x) { if (inherits(x, "list") && all(nchar(names(x)) > 0)) { tmp <- paste0(paste(names(x), x, sep = ": "), collapse = ", ") } else if (inherits(x, "list") && any(nchar(names(x)) == 0)) { tmp <- paste0(paste(names(x), x, sep = ": "), collapse = ", ") } else { tmp <- paste0(x, collapse = ", ") } return(sprintf("{%s}", tmp)) } webmockr/README.md0000644000175100001440000001051613107752517013373 0ustar hornikuserswebmockr ======== [![Build Status](https://travis-ci.org/ropensci/webmockr.svg?branch=master)](https://travis-ci.org/ropensci/webmockr) [![codecov](https://codecov.io/gh/ropensci/webmockr/branch/master/graph/badge.svg)](https://codecov.io/gh/ropensci/webmockr) R library for stubbing and setting expectations on HTTP requests. Port of the Ruby gem [webmock](https://github.com/bblimke/webmock) ## Features * Stubbing HTTP requests at low http client lib level * Setting and verifying expectations on HTTP requests * Matching requests based on method, URI, headers and body * Support for `testthat` coming soon via [vcr](https://github.com/ropenscilabs/vcr) ## Supported HTTP libraries * [crul](https://github.com/ropensci/crul) > more to come ## Install from cran ```r install.packages("webmockr") ``` Dev version ```r devtools::install_github("ropensci/webmockr") ``` ```r library(webmockr) ``` ## Turn on webmockr ```r webmockr::enable() #> CrulAdapter enabled! #> [1] TRUE crul::mock() ``` ## Outside a test framework ```r library(crul) ``` ### Stubbed request based on uri only and with the default response ```r stub_request("any", "https://httpbin.org/get") #> #> method: any #> uri: https://httpbin.org/get #> with: #> query: #> body: #> request_headers: #> to_return: #> status: #> body: #> response_headers: ``` ```r x <- HttpClient$new(url = "https://httpbin.org") x$get('get') #> $url #> $url$url #> [1] "https://httpbin.org/get" #> #> $url$handle #> (empty) #> #> #> $method #> [1] "get" #> #> $options #> $options$httpget #> [1] TRUE #> #> #> $headers #> $headers$`User-Agent` #> [1] "libcurl/7.51.0 r-curl/2.6 crul/0.3.5.9313" #> #> $headers$`Accept-Encoding` #> [1] "gzip, deflate" ``` set return objects ```r stub_request("get", "https://httpbin.org/get") %>% wi_th( query = list(hello = "world")) %>% to_return(status = 418) #> #> method: get #> uri: https://httpbin.org/get #> with: #> query: hello=world #> body: #> request_headers: #> to_return: #> status: 418 #> body: #> response_headers: ``` ```r x$get('get', query = list(hello = "world")) #> $url #> $url$url #> [1] "https://httpbin.org/get?hello=world" #> #> $url$handle #> (empty) #> #> #> $method #> [1] "get" #> #> $options #> $options$httpget #> [1] TRUE #> #> #> $headers #> $headers$`User-Agent` #> [1] "libcurl/7.51.0 r-curl/2.6 crul/0.3.5.9313" #> #> $headers$`Accept-Encoding` #> [1] "gzip, deflate" ``` ### Stubbing requests based on method, uri and query params ```r stub_request("get", "https://httpbin.org/get") %>% wi_th(query = list(hello = "world"), headers = list('User-Agent' = 'libcurl/7.51.0 r-curl/2.6 crul/0.3.6', 'Accept-Encoding' = "gzip, deflate")) #> #> method: get #> uri: https://httpbin.org/get #> with: #> query: hello=world #> body: #> request_headers: User-Agent=libcurl/7.51.0 r-curl/2.6 crul/0.3.6, Accept-Encoding=gzip, deflate #> to_return: #> status: #> body: #> response_headers: ``` ```r stub_registry() #> #> Registered Stubs #> any: https://httpbin.org/get #> get: https://httpbin.org/get?hello=world | to_return: with status 418 #> get: https://httpbin.org/get?hello=world with headers {"User-Agent":"libcurl/7.51.0 r-curl/2.6 crul/0.3.6","Accept-Encoding":"gzip, deflate"} ``` ```r x <- HttpClient$new(url = "https://httpbin.org") x$get('get', query = list(hello = "world")) #> $url #> $url$url #> [1] "https://httpbin.org/get?hello=world" #> #> $url$handle #> (empty) #> #> #> $method #> [1] "get" #> #> $options #> $options$httpget #> [1] TRUE #> #> #> $headers #> $headers$`User-Agent` #> [1] "libcurl/7.51.0 r-curl/2.6 crul/0.3.5.9313" #> #> $headers$`Accept-Encoding` #> [1] "gzip, deflate" ``` ## Meta * Please [report any issues or bugs](https://github.com/ropensci/webmockr/issues). * License: MIT * Get citation information for `webmockr` in R doing `citation(package = 'webmockr')` * Please note that this project is released with a [Contributor Code of Conduct](CONDUCT.md). By participating in this project you agree to abide by its terms. [![ropensci_footer](https://ropensci.org/public_images/github_footer.png)](https://ropensci.org) webmockr/MD50000644000175100001440000000717213107765670012434 0ustar hornikusers8a9fdf4fb7d208f13d63d4a71a0c38b9 *DESCRIPTION c5af52351472a750055a760a8924ce71 *LICENSE 4d82566602f57ce11096b45ea7047b2c *NAMESPACE 31541443fa75794380be7190164750ef *NEWS.md 1d57690083903f22a871f90f00f9bf26 *R/HttpLibAdapterRegistry.R e4d7dca4621121f3180f5857f2305892 *R/RequestPattern.R f75c830437037280b72da6cf1b95f7be *R/RequestRegistry.R 66a6621108dfe2ce28395c9bea3bd43a *R/RequestSignature.R a453297dffb5440ae814e4e91d8ce0af *R/Response.R b17e26dfe4baa9fdec82061215bd3400 *R/StubRegistry.R 5bd4e0ad42cad41d647bab55dba8b6f2 *R/StubbedRequest.R 948a2c3ac917929f5c5e4b60a4661bce *R/adapter-crul.R 1c0cea5e0e135547036b1e9acbf40d46 *R/flipswitch.R d64d3ea6fde479b3e3a7c4114d7abb63 *R/globals.R df2d78c4834ed882b32d776442e710f5 *R/headers.R 556ac20c5e37419f278c25765eed55cf *R/onload.R f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/pipe.R 56db156253368fd808bb2fa279befede *R/remove_request_stub.R 1591fbffccf0e3dccd11091bf116ab35 *R/request_is_in_cache.R e460927529aa8f3aaca29cef83cc24ae *R/stub_registry.R c3180404daf6a2b77f6246a63297186f *R/stub_registry_clear.R e7a4dd7bc0e8b4262401df2342ad3ae2 *R/stub_request.R ef99a00e9a80e6c6bf268411ae44fa1e *R/to_return.R cdb9c16bb481bb80e785a968a973eb1f *R/webmockr-opts.R a692851f46491e37495832dccc780f75 *R/webmockr.R dc9d767586f7371a0505ffcd264a1813 *R/wi_th.R 745b2ffdc96b547e670b9f4663e8c110 *R/zzz.R b841b6cc58e204b76d3e297e312a2bd3 *README.md bfab6207f448fab82e6cd42ebc3abbf2 *inst/ignore/adapter-httr.R c2dad18498a5fbbfa1ad2b9618072bcb *inst/ignore/sockets.R 0ca5e4a771c53cd06f879d58d9a54344 *man/BodyPattern.Rd ec3e39c68a0f980c103331690d8a0089 *man/CrulAdapter.Rd c196bbf87e855d877094af15e23158e2 *man/HashCounter.Rd 33b63c8fcb5423a346ef4d1b05f793ef *man/HeadersPattern.Rd ec627b3023a5aa6ca42c387da32ca891 *man/HttpLibAdapaterRegistry.Rd 23390726ada577071131c6c6d51ef326 *man/MethodPattern.Rd 21019e30ebb880c264ca2dcb22af3fe3 *man/RequestPattern.Rd 1bfb8622d4bddff89f1be01750f21ce5 *man/RequestRegistry.Rd 2ca0204d1aa26bd1f12e0112fb61faa3 *man/RequestSignature.Rd 21da09d6388b0b36036538d9456b9db8 *man/Response.Rd c38decc88ddd406fc9ad8c85bb104403 *man/StubRegistry.Rd dde266ea76b68f6d57008ce899396a6f *man/StubbedRequest.Rd 8e5ca8cd0233bfeae442c68beaf09ad8 *man/UriPattern.Rd 3a11756aab1f70b465ec7e66ddbac3f9 *man/enable.Rd e17f41e959fd90a1736ad0fc8ee7ff81 *man/pipe.Rd 70facf022a7b546d73af0d26dc25f4fe *man/remove_request_stub.Rd 3c7e64a1b8550341ee65cfab6c0b171c *man/stub_registry.Rd 3789fa757a2435e10813b1590b6d173d *man/stub_registry_clear.Rd c0e96ff8246a5068c8eece205fe0a177 *man/stub_request.Rd 38a07bd49e9e0417e786553b2b7eb80d *man/to_return.Rd e9497f1fe828584fb7dd69af69642eb9 *man/webmockr-package.Rd dac7f4d84513f91977a843c3ce8c8ecf *man/webmockr_configure.Rd fefa06266cd5551701c9f707f8d3951a *man/wi_th.Rd 6695b4e11699caab8ba7c936ff9d0778 *tests/test-all.R 43e9a3a2f19d982c0919de0490556d0c *tests/testthat/crul_obj.rda 6710e630fe560f076a9e963bf257642d *tests/testthat/test-CrulAdapter.R 3b3c8f9cc9dc4b35609a0153d59aeca4 *tests/testthat/test-HashCounter.R 670c4badc6762df39b94577d3c8d4750 *tests/testthat/test-HttpLibAdapaterRegistry.R 48de2fd421e5cb753835a6862a08d406 *tests/testthat/test-RequestPattern.R 322d4850b93f50b34970c60341d7f804 *tests/testthat/test-RequestRegistry.R 7bda6e128575f52027f7d72c9e258981 *tests/testthat/test-RequestSignature.R c0387cc7350e4f67596d4e89ac4b91be *tests/testthat/test-Response.R 33d39acaf9c54f6d75d45731fa06dd94 *tests/testthat/test-StubRegistry.R a31ea3b57342682c03ce55142837dc84 *tests/testthat/test-StubbedRequest.R 685261001875b99f85a6491f1921ee2b *tests/testthat/test-flipswitch.R 1c3d075244ad19058481a86bdec90c3c *tests/testthat/test-stub_request.R 3bce8c753f28141f43504dbb44eb263a *tests/testthat/test-wi_th.R webmockr/DESCRIPTION0000644000175100001440000000175713107765670013635 0ustar hornikusersPackage: webmockr Title: Stubbing and Setting Expectations on 'HTTP' Requests Description: Stubbing and setting expectations on 'HTTP' requests. Includes tools for stubbing 'HTTP' requests, including expected request conditions and response conditions. Match on 'HTTP' method, query parameters, request body, headers and more. Version: 0.1.0 Authors@R: person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus+r@gmail.com") License: MIT + file LICENSE URL: https://github.com/ropensci/webmockr BugReports: https://github.com/ropensci/webmockr/issues LazyData: true Imports: curl, jsonlite, magrittr (>= 1.5), lazyeval (>= 0.2.0), R6 (>= 2.1.3), urltools (>= 1.6.0) Suggests: roxygen2 (>= 6.0.1), testthat, crul (>= 0.3.4) RoxygenNote: 6.0.1 NeedsCompilation: no Packaged: 2017-05-20 05:58:16 UTC; sacmac Author: Scott Chamberlain [aut, cre] Maintainer: Scott Chamberlain Repository: CRAN Date/Publication: 2017-05-20 07:09:44 UTC webmockr/man/0000755000175100001440000000000013107433057012657 5ustar hornikuserswebmockr/man/wi_th.Rd0000644000175100001440000000157013107752340014262 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wi_th.R \name{wi_th} \alias{wi_th} \alias{wi_th_} \title{Set additional parts of a stubbed request} \usage{ wi_th(.data, ...) wi_th_(.data, ..., .dots) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} \item{...}{Comma separated list of variable names, passed on to \code{\link[lazyeval:lazy_dots]{lazyeval::lazy_dots()}}. accepts the following: query, body, headers} \item{.dots}{Used to work around non-standard evaluation} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set query params, request body, and/or request headers } \details{ \code{with} is a function in the \code{base} package, so we went with \code{wi_th} } \note{ see examples in \code{\link[=stub_request]{stub_request()}} } webmockr/man/pipe.Rd0000644000175100001440000000031713107235041014075 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pipe.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} \usage{ lhs \%>\% rhs } \description{ Pipe operator } \keyword{internal} webmockr/man/stub_request.Rd0000644000175100001440000000340113107752430015670 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_request.R \name{stub_request} \alias{stub_request} \title{Stub an http request} \usage{ stub_request(method = "get", uri = NULL, uri_regex = NULL) } \arguments{ \item{method}{(character) HTTP method, one of "get", "post", "put", "patch", "head", "delete", "options" - or the special "any" (for any method)} \item{uri}{(character) The request uri. Can be a full uri, partial, or a regular expression to match many incantations of a uri. required.} \item{uri_regex}{(character) A URI represented as regex. See examples} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub. } \description{ Stub an http request } \details{ Internally, this calls \link{StubbedRequest} which handles the logic See \code{\link[=stub_registry]{stub_registry()}} for listing stubs, \code{\link[=stub_registry_clear]{stub_registry_clear()}} for removing all stubs and \code{\link[=remove_request_stub]{remove_request_stub()}} for removing specific stubs } \examples{ \dontrun{ # basic stubbing stub_request("get", "https://httpbin.org/get") stub_request("post", "https://httpbin.org/post") # list stubs stub_registry() # add header stub_request("get", "https://httpbin.org/get") \%>\% wi_th(headers = list('User-Agent' = 'R')) # add expectation with to_return stub_request("get", "https://httpbin.org/get") \%>\% wi_th( query = list(hello = "world"), headers = list('User-Agent' = 'R')) \%>\% to_return(status = 200, body = "stuff", headers = list(a = 5)) # list stubs again stub_registry() # regex stub_request("get", uri_regex = ".+ample\\\\..") # clear all stubs stub_registry_clear() } } \seealso{ \code{\link[=wi_th]{wi_th()}}, \code{\link[=to_return]{to_return()}} } webmockr/man/CrulAdapter.Rd0000644000175100001440000000145313107235041015350 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \docType{data} \name{CrulAdapter} \alias{CrulAdapter} \title{crul library adapter} \description{ crul library adapter } \details{ \strong{Methods} \describe{ \item{\code{enable()}}{ Enable the adapter } \item{\code{disable()}}{ Disable the adapter } \item{\code{build_crul_request(x)}}{ Build a crul \link{RequestSignature} x: crul request parts (list) } \item{\code{build_crul_response(req, resp)}}{ Build a crul response req: a crul request (list) resp: a crul response () } \item{\code{handle_request()}}{ All logic for handling a request req: a crul request (list) } \item{\code{remove_crul_stubs()}}{ Remove all crul stubs } } This adapter modifies \pkg{crul} to allow mocking HTTP requests } \keyword{datasets} webmockr/man/StubRegistry.Rd0000644000175100001440000000326013107433057015615 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubRegistry.R \docType{data} \name{StubRegistry} \alias{StubRegistry} \title{Stub registry} \description{ Stub registry } \details{ \strong{Methods} \describe{ \item{\code{register_stub(stub)}}{ Register a stub - stub: an object of class \link{StubbedRequest} } \item{\code{find_stubbed_request(req)}}{ Find a stubbed request - req: an object of class \link{RequestSignature} } \item{\code{response_for_request(request_signature)}}{ Find a stubbed request - request_signature: an object of class \link{RequestSignature} } \item{\code{request_stub_for(request_signature)}}{ Find a stubbed request - request_signature: an object of class \link{RequestSignature} } \item{\code{remove_request_stub(stub)}}{ Remove a stubbed request by matching request signature - stub: an object of class \link{StubbedRequest} } \item{\code{remove_all_request_stubs()}}{ Remove all request stubs } \item{\code{is_registered(x)}}{ Find a stubbed request - x: an object of class \link{RequestSignature} } } } \examples{ \dontrun{ # Make a stub stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") stub1$with(request_headers = list('User-Agent' = 'R')) stub1$to_return(status = 200, body = "foobar", response_headers = list()) stub1 # Make another stub stub2 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") stub2 # Put both stubs in the stub registry reg <- StubRegistry$new() reg$register_stub(stub = stub1) reg$register_stub(stub = stub2) reg reg$request_stubs } } \seealso{ Other stub-registry: \code{\link{remove_request_stub}}, \code{\link{stub_registry_clear}}, \code{\link{stub_registry}} } \keyword{datasets} webmockr/man/Response.Rd0000644000175100001440000000246013107235041014737 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Response.R \docType{data} \name{Response} \alias{Response} \title{Response class} \arguments{ \item{options}{(list) a list of options} } \description{ Response class } \details{ \strong{Methods} \describe{ \item{\code{set_request_headers(headers)}}{ set request headers - headers: a list of key-value pair headers } \item{\code{get_request_headers()}}{ get request headers } \item{\code{set_response_headers(headers)}}{ set response headers - headers: a list of key-value pair headers } \item{\code{get_response_headers()}}{ get response headers } \item{\code{set_body(body)}}{ - body: must be a string } \item{\code{get_body()}}{ get body } \item{\code{set_status()}}{ - body: must be an integer status code } \item{\code{get_status()}}{ get status code } \item{\code{set_exception()}}{ set exception } \item{\code{get_exception()}}{ get exception } } } \examples{ \dontrun{ (x <- Response$new()) x$set_url("https://httpbin.org/get") x x$set_request_headers(list('Content-Type' = "application/json")) x x$request_headers x$set_response_headers(list('Host' = "httpbin.org")) x x$response_headers x$set_status(404) x x$get_status() x$set_body("hello world") x x$get_body() x$set_exception("exception") x x$get_exception() } } \keyword{datasets} webmockr/man/remove_request_stub.Rd0000644000175100001440000000121613107671135017251 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/remove_request_stub.R \name{remove_request_stub} \alias{remove_request_stub} \title{Remove a request stub} \usage{ remove_request_stub(stub) } \arguments{ \item{stub}{a request stub, of class \code{StubbedRequest}} } \value{ logical, \code{TRUE} if removed, \code{FALSE} if not removed } \description{ Remove a request stub } \examples{ (x <- stub_request("get", "https://httpbin.org/get")) stub_registry() remove_request_stub(x) stub_registry() } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{stub_registry_clear}}, \code{\link{stub_registry}} } webmockr/man/RequestRegistry.Rd0000644000175100001440000000156513107235041016327 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \docType{data} \name{RequestRegistry} \alias{RequestRegistry} \title{Request registry} \description{ Request registry } \details{ \strong{Methods} \describe{ \item{\code{register_request(request)}}{ Register a request - request: a character string of the request, serialized from \link{CrulAdapter} or other adapter } \item{\code{reset()}}{ Reset the registry to no registered requests } } } \examples{ x <- RequestRegistry$new() x$register_request(request = "GET http://scottchamberlain.info") x$register_request(request = "GET http://scottchamberlain.info") x$register_request(request = "POST https://httpbin.org/post") # print method to list requests x # hashes, and number of times each requested x$request_signatures$hash # reset the request registry x$reset() } \keyword{datasets} webmockr/man/stub_registry_clear.Rd0000644000175100001440000000061513107433057017223 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_registry_clear.R \name{stub_registry_clear} \alias{stub_registry_clear} \title{Clear the stub registry} \usage{ stub_registry_clear() } \value{ nothing } \description{ Clear all stubs } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}}, \code{\link{stub_registry}} } webmockr/man/HeadersPattern.Rd0000644000175100001440000000235713107647246016075 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \docType{data} \name{HeadersPattern} \alias{HeadersPattern} \title{HeadersPattern} \arguments{ \item{pattern}{(list) a pattern, as a named list, must be named, e.g,. \code{list(a = 5, b = 6)}} } \description{ HeadersPattern } \details{ \strong{Methods} \describe{ \item{\code{matches(headers)}}{ Match a list of headers against that stored - headers (list) named list of headers, e.g,. \code{list(a = 5, b = 6)} } } \code{webmockr} normalises headers and treats all forms of same headers as equal: i.e the following two sets of headers are equal: \code{list(Header1 = "value1", content_length = 123, X_CuStOm_hEAder = "foo")} and \code{list(header1 = "value1", "Content-Length" = 123, "x-cuSTOM-HeAder" = "foo")} } \examples{ (x <- HeadersPattern$new(pattern = list(a = 5))) x$pattern x$matches(list(a = 5)) # different cases (x <- HeadersPattern$new(pattern = list(Header1 = "value1"))) x$pattern x$matches(list(header1 = "value1")) x$matches(list(header1 = "value2")) # different symbols (x <- HeadersPattern$new(pattern = list(`Hello_World` = "yep"))) x$pattern x$matches(list(`hello-world` = "yep")) x$matches(list(`hello-worlds` = "yep")) } \keyword{internal} webmockr/man/HttpLibAdapaterRegistry.Rd0000644000175100001440000000111413107235041017675 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/HttpLibAdapterRegistry.R \docType{data} \name{HttpLibAdapaterRegistry} \alias{HttpLibAdapaterRegistry} \title{http lib adapter registry} \description{ http lib adapter registry } \details{ \strong{Methods} \describe{ \item{\code{register(x)}}{ Register an http library adapter x: an http lib adapter, e.g., \link{CrulAdapter} return: nothing, registers the library adapter } } } \examples{ x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) x x$adapters x$adapters[[1]]$name } \keyword{datasets} webmockr/man/BodyPattern.Rd0000644000175100001440000000105113107235041015367 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \docType{data} \name{BodyPattern} \alias{BodyPattern} \title{BodyPattern} \arguments{ \item{pattern}{(list) a body object} } \description{ BodyPattern } \details{ \strong{Methods} \describe{ \item{\code{matches(body, content_type = "")}}{ Match a body object against that given in \code{pattern} - body (list) the body - content_type (character) content type } } } \examples{ z <- BodyPattern$new(pattern = list(a = "foobar")) z$pattern } \keyword{internal} webmockr/man/to_return.Rd0000644000175100001440000000151113107752340015164 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/to_return.R \name{to_return} \alias{to_return} \alias{to_return_} \title{Expectation for what's returned from a stubbed request} \usage{ to_return(.data, ...) to_return_(.data, ..., .dots) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} \item{...}{Comma separated list of variable names, passed on to \code{\link[lazyeval:lazy_dots]{lazyeval::lazy_dots()}}. accepts the following: status, body, headers} \item{.dots}{Used to work around non-standard evaluation} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set response status code, response body, and/or response headers } \note{ see examples in \code{\link[=stub_request]{stub_request()}} } webmockr/man/webmockr_configure.Rd0000644000175100001440000000311213107235041017006 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr-opts.R \name{webmockr_configure} \alias{webmockr_configure} \alias{webmockr_configure_reset} \alias{webmockr_configuration} \alias{webmockr_enable} \alias{webmockr_disable} \alias{webmockr_allow_net_connect} \alias{webmockr_disable_net_connect} \alias{webmockr_net_connect_allowed} \title{webmockr configuration} \usage{ webmockr_configure(turn_on = FALSE, allow_net_connect = FALSE, allow_localhost = FALSE, allow = FALSE, net_http_connect_on_start = FALSE, show_stubbing_instructions = FALSE, query_values_notation = FALSE, show_body_diff = FALSE) webmockr_configure_reset() webmockr_configuration() webmockr_enable() webmockr_disable() webmockr_allow_net_connect() webmockr_disable_net_connect() webmockr_net_connect_allowed() } \arguments{ \item{turn_on}{(logical) Default: \code{FALSE}} \item{allow_net_connect}{(logical) Default: \code{TRUE}} \item{allow_localhost}{(logical) Default: \code{TRUE}} \item{allow}{(logical) Default: \code{TRUE}} \item{net_http_connect_on_start}{(logical) Default: \code{TRUE}} \item{show_stubbing_instructions}{(logical) Default: \code{TRUE}} \item{query_values_notation}{(logical) Default: \code{TRUE}} \item{show_body_diff}{(logical) Default: \code{TRUE}} } \description{ webmockr configuration } \examples{ \dontrun{ webmockr_configure() webmockr_configure( allow_localhost = TRUE ) webmockr_configuration() webmockr_configure_reset() webmockr_allow_net_connect() webmockr_net_connect_allowed() webmockr_disable_net_connect() webmockr_net_connect_allowed() } } webmockr/man/HashCounter.Rd0000644000175100001440000000144513107235041015366 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \docType{data} \name{HashCounter} \alias{HashCounter} \title{hash with counter, to store requests, and count each time it is used} \description{ hash with counter, to store requests, and count each time it is used } \details{ \strong{Methods} \describe{ \item{\code{put(key)}}{ Register a request by it's key - key: a character string of the request, serialized from \link{CrulAdapter} or other adapter } \item{\code{get(key)}}{ Get a request by key - key: a character string of the request, serialized from \link{CrulAdapter} or other adapter } } } \examples{ x <- HashCounter$new() x$put("foo bar") x$put("foo bar") x$put("hello world") x$put("hello world") x$put("hello world") x$hash } \keyword{datasets} webmockr/man/stub_registry.Rd0000644000175100001440000000074013107433057016054 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_registry.R \name{stub_registry} \alias{stub_registry} \title{List stubs in the stub registry} \usage{ stub_registry() } \value{ an object of class \code{StubRegistry}, print method gives the stubs in the registry } \description{ List stubs in the stub registry } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}}, \code{\link{stub_registry_clear}} } webmockr/man/StubbedRequest.Rd0000644000175100001440000000305713107647246016123 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubbedRequest.R \docType{data} \name{StubbedRequest} \alias{StubbedRequest} \title{StubbedRequest class} \arguments{ \item{method}{the HTTP method (any, head, get, post, put, patch, or delete). "any" matches any HTTP method. required.} \item{uri}{(character) request URI. either this or \code{uri_regex} required} \item{uri_regex}{(character) request URI as regex. either this or \code{uri} required} } \description{ StubbedRequest class } \details{ \strong{Methods} \describe{ \item{\code{with(query, body, headers)}}{ Set expectations for what's given in HTTP request \itemize{ \item query (list) request query params, as a named list. optional \item body (list) request body, as a named list. optional \item headers (list) request headers as a named list. optional. } } \item{\code{to_return(status, body, headers)}}{ Set expectations for what's returned in HTTP resonse \itemize{ \item status (numeric) an HTTP status code \item body (list) response body, as a list. optional \item headers (list) named list, response headers. optional. } } \item{\code{to_s()}}{ Response as a string } } } \examples{ \dontrun{ x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$method x$uri x$with(headers = list('User-Agent' = 'R')) x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x x$to_s() # uri_regex (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$method x$uri x$to_s() } } \seealso{ \code{\link[=stub_request]{stub_request()}} } \keyword{datasets} webmockr/man/UriPattern.Rd0000644000175100001440000000302513107660150015237 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \docType{data} \name{UriPattern} \alias{UriPattern} \title{UriPattern} \arguments{ \item{pattern}{(character) a uri, either plain character string or regex, see \link[base:regex]{base::regex}. if scheme is missing, it is added (we assume http)} } \description{ UriPattern } \details{ \strong{Methods} \describe{ \item{\code{add_query_params}}{ Add query parameters to the URI - query_params } \item{\code{matches(uri)}}{ Match a uri against that given in \code{pattern} - uri (character) a uri, including scheme (i.e., http or https) } } } \examples{ # trailing slash (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://foobar.com") z$matches("http://foobar.com/") # default ports (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://foobar.com:80") z$matches("http://foobar.com:80/") z$matches("http://foobar.com:443") z$matches("http://foobar.com:443/") # user info (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://user:pass@foobar.com") # regex (z <- UriPattern$new(regex_pattern = ".+ample\\\\..")) z$matches("http://sample.org") z$matches("http://example.com") z$matches("http://tramples.net") # add query parameters (z <- UriPattern$new(pattern = "http://foobar.com")) z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) z$pattern (z <- UriPattern$new(pattern = "http://foobar.com")) z$add_query_params(list(pizza = "deep dish", cheese = "cheddar")) z$pattern } \keyword{internal} webmockr/man/MethodPattern.Rd0000644000175100001440000000110513107632226015720 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \docType{data} \name{MethodPattern} \alias{MethodPattern} \title{MethodPattern} \arguments{ \item{pattern}{(character) a HTTP method, lowercase} } \description{ MethodPattern } \details{ \strong{Methods} \describe{ \item{\code{matches(method)}}{ An HTTP method - method (character) } } Matches regardless of case. e.g., POST will match to post } \examples{ (x <- MethodPattern$new(pattern = "post")) x$pattern x$matches(method = "post") x$matches(method = "POST") } \keyword{internal} webmockr/man/webmockr-package.Rd0000644000175100001440000000155613107752221016354 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr.R \docType{package} \name{webmockr-package} \alias{webmockr-package} \alias{webmockr} \title{Stubbing and setting expectations on HTTP requests} \description{ Stubbing and setting expectations on HTTP requests } \section{Features}{ \itemize{ \item Stubbing HTTP requests at low http client lib level \item Setting and verifying expectations on HTTP requests \item Matching requests based on method, URI, headers and body \item Can support many HTTP libraries, though only \pkg{crul} for now \item Integration with testing libraries (coming soon) via \code{vcr} } } \examples{ library(webmockr) stub_request("get", "https://httpbin.org/get") stub_request("post", "https://httpbin.org/post") stub_registry() } \author{ Scott Chamberlain \email{myrmecocystus+r@gmail.com} } \keyword{package} webmockr/man/RequestSignature.Rd0000644000175100001440000000276013107235041016456 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestSignature.R \docType{data} \name{RequestSignature} \alias{RequestSignature} \title{General purpose request signature builder} \arguments{ \item{method}{the HTTP method (any, head, options, get, post, put, patch, trace, or delete). "any" matches any HTTP method. required.} \item{uri}{(character) request URI. required.} \item{options}{(list) options. optional. See Details.} } \description{ General purpose request signature builder } \details{ \strong{Methods} \describe{ \item{\code{to_s()}}{ Request signature to a string return: a character string representation of the request signature } } } \section{options}{ \itemize{ \item body - body as a named list \item headers - headers as a named list \item proxies - proxies as a named list \item auth - authentication details, as a named list } } \examples{ # make request signature x <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") # method x$method # uri x$uri # request signature to string x$to_s() # headers z <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) z z$headers z$to_s() # headers and body z <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( headers = list(`User-Agent` = "foobar", stuff = "things"), body = list(a = "tables") ) ) z z$headers z$body z$to_s() } \keyword{datasets} webmockr/man/RequestPattern.Rd0000644000175100001440000000314013107660150016126 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \docType{data} \name{RequestPattern} \alias{RequestPattern} \title{RequestPattern class} \arguments{ \item{method}{the HTTP method (any, head, options, get, post, put, patch, trace, or delete). "any" matches any HTTP method. required.} \item{uri}{(character) request URI. required or uri_regex} \item{uri_regex}{(character) request URI as regex. required or uri} \item{query}{(list) query parameters, optional} \item{body}{(list) body request, optional} \item{headers}{(list) headers, optional} } \description{ RequestPattern class } \details{ \strong{Methods} \describe{ \item{\code{matches(request_signature)}}{ Test if request_signature matches a pattern - request_signature: a request signature } \item{\code{to_s()}}{ Print pattern for easy human consumption } } } \examples{ \dontrun{ (x <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get")) x$body_pattern x$headers_pattern x$method_pattern x$uri_pattern x$to_s() # make a request signature rs <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get") # check if it matches x$matches(rs) # regex uri (x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org")) x$uri_pattern x$uri_pattern$to_s() x$to_s() # uri with query parameters (x <- RequestPattern$new( method = "get", uri = "https://httpbin.org/get", query = list(foo = "bar") )) x$to_s() } } \seealso{ pattern classes for HTTP method \link{MethodPattern}, headers \link{HeadersPattern}, body \link{BodyPattern}, and URI/URL \link{UriPattern} } \keyword{datasets} webmockr/man/enable.Rd0000644000175100001440000000052513107235041014367 0ustar hornikusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flipswitch.R \name{enable} \alias{enable} \alias{disable} \title{Enable or disable webmockr} \usage{ enable(options = list()) disable(options = list()) } \arguments{ \item{options}{list of options - ignored for now.} } \description{ Enable or disable webmockr } webmockr/LICENSE0000644000175100001440000000005713076510764013121 0ustar hornikusersYEAR: 2017 COPYRIGHT HOLDER: Scott Chamberlain