webmockr/0000755000176200001440000000000014752731512012072 5ustar liggesuserswebmockr/tests/0000755000176200001440000000000014752725763013247 5ustar liggesuserswebmockr/tests/testthat/0000755000176200001440000000000014752707074015102 5ustar liggesuserswebmockr/tests/testthat/test-Response.R0000644000176200001440000000754114752052374020003 0ustar liggesuserscontext("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_null(aa$response_headers_all) 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(hb("/get")) aa$set_request_headers(list("Content-Type" = "application/json")) aa$set_response_headers(list("Host" = "hb.opencpu.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") # response_headers_all doesn't exist in Response, it's specific to crul expect_null(aa$response_headers_all) expect_equal(aa$status_code, 404) expect_equal(aa$url, hb("/get")) expect_null(aa$name) expect_equal(aa$body, charToRaw("hello world")) expect_is(aa$content, "raw") expect_equal(aa$exception, "exception") expect_equal(rawToChar(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]], "hb.opencpu.org") expect_equal(aa$get_status(), 404) expect_equal(aa$get_url(), hb("/get")) expect_output(aa$print(), "") expect_output(aa$print(), "headers") expect_output(aa$print(), "request headers") # set_body: char gets converted to raw in $content aa$set_body(body = "stuff") expect_is(aa$body, "raw") expect_is(aa$content, "raw") expect_length(aa$body, 5) expect_length(aa$content, 5) # set_body: raw remains as raw in $content aa$set_body(body = charToRaw("stuff")) expect_is(aa$body, "raw") expect_is(aa$content, "raw") expect_length(aa$content, 5) # set_body: other types return raw(0) in $content aa$set_body(body = NULL) expect_equal(aa$body, raw()) expect_is(aa$content, "raw") expect_length(aa$content, 0) 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") # body must be length 1 expect_error(aa$set_body(letters), "is not TRUE") 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/httr2_obj_auth.rda0000644000176200001440000000040514715656454020513 0ustar liggesusersQN0&@%?ڡ  &$rl6JrvsK4{wO~y\-ƫ1d,m Ω^bۚwA-h]aMe]YjVvst۲ވYDm\?Dks% wi_th( body = list(y = crul::upload(system.file("CITATION"))) ) expect_equal(length(stub_registry()$request_stubs), 2) expect_match( stub_registry()$request_stubs[[2]]$to_s(), sprintf("POST: %s", hb("/post")) ) expect_match( stub_registry()$request_stubs[[2]]$to_s(), "CITATION" ) expect_match( stub_registry()$request_stubs[[2]]$to_s(), "text/plain" ) stub_registry_clear() # stub with > 1 to_return() s <- stub_request("get", hb("/get")) to_return(s, status = 200, body = "foobar", headers = list(a = 5)) to_return(s, status = 200, body = "bears", headers = list(b = 6)) expect_equal(length(stub_registry()$request_stubs), 1) expect_equal(length(stub_registry()$request_stubs[[1]]$to_s()), 1) expect_match(stub_registry()$request_stubs[[1]]$to_s(), "foobar") expect_match(stub_registry()$request_stubs[[1]]$to_s(), "bears") }) test_that("stub_registry fails well", { expect_error(stub_registry(4), "unused argument") }) webmockr/tests/testthat/test-to_timeout.R0000644000176200001440000000205614752052374020371 0ustar liggesuserscontext("to_timeout") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) aa <- stub_request("get", hb("/get")) %>% to_timeout() test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_null(aa$response_headers) expect_is(aa$responses_sequences, "list") expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, hb("/get")) # to_timeout expected stuff expect_true(aa$responses_sequences[[1]]$timeout) }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(to_timeout(), "argument \".data\" is missing") expect_error(to_timeout(5), "must be of class StubbedRequest") }) # cleanup stub_registry_clear() webmockr/tests/testthat/test-writing-to-disk.R0000644000176200001440000001067714752052374021244 0ustar liggesuserscontext("mock writing to disk") enable() test_that("Write to a file before mocked request: crul", { skip_on_cran() library(crul) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) expect_is(readLines(f), "character") expect_match(readLines(f), "world") ## make the stub stub_request("get", hb("/get")) %>% to_return(body = file(f)) ## make a request out <- HttpClient$new(hb("/get"))$get(disk = f) expect_is(out$content, "character") expect_equal(attr(out$content, "type"), "file") expect_is(readLines(out$content), "character") expect_match(readLines(out$content), "hello") # cleanup unlink(f) stub_registry_clear() }) test_that("Write to a file before mocked request: httr", { skip_on_cran() library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) expect_is(readLines(f), "character") expect_match(readLines(f), "world") ## make the stub stub_request("get", hb("/get")) %>% to_return( body = file(f), headers = list("content-type" = "application/json") ) ## make a request ## with httr, you must set overwrite=TRUE or you'll get an errror out <- GET(hb("/get"), write_disk(f, overwrite = TRUE)) content(out) expect_is(out$content, "path") expect_equal(attr(out$content, "class"), "path") expect_is(readLines(out$content), "character") expect_match(readLines(out$content), "hello") # cleanup unlink(f) stub_registry_clear() }) test_that("Write to a file before mocked request: httr", { skip_on_cran() skip_if_not_installed("httr2") library(httr2) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) expect_is(readLines(f), "character") expect_match(readLines(f), "world") ## make the stub stub_request("get", hb("/get")) %>% to_return( body = file(f), headers = list("content-type" = "application/json") ) ## make a request req <- request(hb("/get")) out <- req_perform(req, path = f) expect_is(out$body, "httr2_path") expect_equal(attr(out$body, "class"), "httr2_path") expect_is(readLines(out$body), "character") expect_match(readLines(out$body), "hello") # cleanup unlink(f) stub_registry_clear() }) test_that("Use mock_file to have webmockr handle file and contents: crul", { skip_on_cran() library(crul) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", hb("/get")) %>% to_return(body = mock_file(f, "{\"hello\":\"mars\"}\n")) ## make a request out <- crul::HttpClient$new(hb("/get"))$get(disk = f) out$content expect_is(out$content, "character") expect_match(out$content, "json") expect_is(readLines(out$content), "character") expect_true(any(grepl("hello", readLines(out$content)))) # cleanup unlink(f) stub_registry_clear() }) test_that("Use mock_file to have webmockr handle file and contents: httr", { skip_on_cran() library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", hb("/get")) %>% to_return( body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), headers = list("content-type" = "application/json") ) ## make a request out <- GET(hb("/get"), write_disk(f)) ## view stubbed file content expect_is(out$content, "path") expect_match(out$content, "json") expect_is(readLines(out$content), "character") expect_true(any(grepl("foo", readLines(out$content)))) # cleanup unlink(f) stub_registry_clear() }) test_that("Use mock_file to have webmockr handle file and contents: httr", { skip_on_cran() skip_if_not_installed("httr2") library(httr2) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", hb("/get")) %>% to_return( body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), headers = list("content-type" = "application/json") ) ## make a request req <- request(hb("/get")) # req <- request("https://hb.opencpu.org/get") out <- req_perform(req, path = f) # out <- GET(hb("/get"), write_disk(f)) ## view stubbed file content expect_is(out$body, "httr2_path") expect_match(out$body, "json") expect_is(readLines(out$body), "character") expect_true(any(grepl("foo", readLines(out$body)))) # cleanup unlink(f) stub_registry_clear() }) webmockr/tests/testthat/test-StubbedRequest.R0000644000176200001440000001441214752052374021141 0ustar liggesuserscontext("StubbedRequest") test_that("StubbedRequest: works", { expect_is(StubbedRequest, "R6ClassGenerator") aa <- StubbedRequest$new(method = "get", uri = "https://hb.opencpu.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://hb.opencpu.org/get") expect_is(aa$uri_parts, "list") expect_equal(aa$uri_parts$domain, "hb.opencpu.org") expect_equal(aa$uri_parts$path, "get") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "GET: https://hb.opencpu.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") expect_equal(aa$to_s(), "GET: https://hb.opencpu.org/get with query params foo=bar") ## >1 query param gets combined with "&" and not "," aa$with(query = list(foo = "bar", stuff = 567)) expect_equal(sort(names(aa$query)), c("foo", "stuff")) expect_equal(aa$to_s(), "GET: https://hb.opencpu.org/get with query params foo=bar, stuff=567") # 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[[1]]$body, "list") expect_named(aa$responses_sequences[[1]]$body, "hello") }) test_that("StubbedRequest: to_timeout", { x <- StubbedRequest$new(method = "get", uri = "https:/hb.opencpu.org/get") expect_false(grepl("should_timeout: TRUE", x$to_s())) x$to_timeout() expect_true(grepl("should_timeout: TRUE", x$to_s())) }) library("fauxpas") test_that("StubbedRequest: to_raise", { x <- StubbedRequest$new(method = "get", uri = "https:/hb.opencpu.org/get") expect_false(grepl("to_raise: HTTPBadGateway", x$to_s())) x$to_raise(HTTPBadGateway) expect_true(grepl("to_raise: HTTPBadGateway", x$to_s())) ## many exceptions x$to_raise(list(HTTPBadGateway, HTTPForbidden, HTTPInsufficientStorage)) expect_true( grepl( "to_raise: HTTPBadGateway, HTTPForbidden, HTTPInsufficientStorage", x$to_s() ) ) }) test_that("StubbedRequest: different methods work", { expect_equal( StubbedRequest$new( method = "any", uri = "https:/hb.opencpu.org/get" )$method, "any" ) expect_equal( StubbedRequest$new( method = "get", uri = "https:/hb.opencpu.org/get" )$method, "get" ) expect_equal( StubbedRequest$new( method = "head", uri = "https:/hb.opencpu.org/get" )$method, "head" ) expect_equal( StubbedRequest$new( method = "post", uri = "https:/hb.opencpu.org/get" )$method, "post" ) expect_equal( StubbedRequest$new( method = "put", uri = "https:/hb.opencpu.org/get" )$method, "put" ) expect_equal( StubbedRequest$new( method = "patch", uri = "https:/hb.opencpu.org/get" )$method, "patch" ) expect_equal( StubbedRequest$new( method = "delete", uri = "https:/hb.opencpu.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" ) }) test_that("StubbedRequest long string handling", { x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") # with x$with( query = list( foo = "Bar", a = 5, b = 8, user = paste0( "asdfa asldfj asdfljas dflajsd fasldjf", " asldfja sdfljas dflajs fdlasjf aslfa fdfdsf" ) ), body = list( a = 5, b = 8, user = "asdfa asldfj asdfljas dflajsdfdfdsf", foo = "Bar" ), headers = list( farm = "animal", `User-Agent` = "stuff things whasdlfj adsfla jsdflja sdflasj dflasj dfasljf asdf" ) ) # with: long query expect_output(x$print(), "foo=Bar, a=5, b=8, user=asdfa asldfj asdflja...") # with: long body expect_output(x$print(), "a=5, b=8, user=asdfa asldfj asdflja..., foo=Bar") # with: long request headers expect_output(x$print(), "farm=animal, User-Agent=stuff things whasdlf...") # to_return x$to_return( status = 200, body = list( name = "julia", title = "advanced user", location = "somewhere in the middle of the earth", foo = "Bar" ), headers = list( farm = "animal", `User-Agent` = "stuff things whasdlfj adsfla jsdflja sdflasj dflasj dfasljf asdf" ) ) # to_return: status code expect_output(x$print(), "200") # to_return: long body expect_output( x$print(), "name=julia, title=advanced user, location=somewhere in the mid..., foo=Bar" ) # to_return: long response headers expect_output(x$print(), "farm=animal, User-Agent=stuff things whasdlf...") }) test_that("StubbedRequest nested lists in body", { x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$with( query = list(foo = "Bar"), headers = list(farm = "animal"), body = list(a = list(b = list(c = "foo", d = "bar"))) ) expect_output( x$print(), "a = list\\(b = list\\(c = \"foo\", d = \"bar\"\\)\\)" ) # longer x$with( query = list(foo = "Bar"), headers = list(farm = "animal"), body = list( apple = list( bears = list( cheesecake = list(foo_do_the_thing = "bar asdjlfas dfaljsdf asljdf slf") ) ) ) ) expect_output( x$print(), "apple = list\\(bears = list\\(cheesecake = list\\(foo_do_the_thing = \"bar asdjlfas dfa..." ) }) test_that("StubbedRequest w/ >1 to_return()", { stub_registry_clear() x <- StubbedRequest$new(method = "get", uri = "hb.opencpu.org") x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x$to_return(status = 200, body = "bears", headers = list(b = 6)) x$to_s() expect_equal(length(x$responses_sequences), 2) expect_match(x$to_s(), "foobar") expect_match(x$to_s(), "bears") }) webmockr/tests/testthat/test-to_return_then.R0000644000176200001440000000377714752052374021253 0ustar liggesuserscontext("to_return: then") enable() webmockr_reset() test_that("to_return: then", { stub <- stub_request("get", hb("/get?stuff=things")) to_return(stub, status = 200, body = "foobar", headers = list(a = 5)) to_return(stub, status = 200, body = "bears", headers = list(b = 6)) cli <- crul::HttpClient$new(url = hb()) x1 <- cli$get("get", query = list(stuff = "things")) x2 <- cli$get("get", query = list(stuff = "things")) x3 <- cli$get("get", query = list(stuff = "things")) # first should have foobar expect_equal(x1$parse("UTF-8"), "foobar") # second should have bears expect_equal(x2$parse("UTF-8"), "bears") # third should have bears again, and so on expect_equal(x3$parse("UTF-8"), "bears") }) webmockr_reset() test_that("to_return: webmockr_reset allows multiple requests to start from beginning", { stub <- stub_request("get", hb("/get?stuff=things")) to_return(stub, status = 200, body = "foobar", headers = list(a = 5)) to_return(stub, status = 200, body = "bears", headers = list(b = 6)) cli <- crul::HttpClient$new(url = hb()) x1 <- cli$get("get", query = list(stuff = "things")) x2 <- cli$get("get", query = list(stuff = "things")) expect_equal(x1$parse("UTF-8"), "foobar") expect_equal(x2$parse("UTF-8"), "bears") # no reset - both requests give 2nd to_return body z1 <- cli$get("get", query = list(stuff = "things")) z2 <- cli$get("get", query = list(stuff = "things")) expect_equal(z1$parse("UTF-8"), "bears") expect_equal(z2$parse("UTF-8"), "bears") # RESET - requests give back expected body (have to make stub again) webmockr_reset() stub <- stub_request("get", hb("/get?stuff=things")) to_return(stub, status = 200, body = "foobar", headers = list(a = 5)) to_return(stub, status = 200, body = "bears", headers = list(b = 6)) w1 <- cli$get("get", query = list(stuff = "things")) w2 <- cli$get("get", query = list(stuff = "things")) expect_equal(w1$parse("UTF-8"), "foobar") expect_equal(w2$parse("UTF-8"), "bears") }) webmockr_reset() disable() webmockr/tests/testthat/helper-webmockr.R0000644000176200001440000000125014752052374020305 0ustar liggesuserssm <- function(x) suppressMessages(x) sw <- function(x) suppressWarnings(x) get_err_mssg <- function(x) { tmp <- tryCatch(x, error = function(e) e) if (inherits(tmp, "error")) unclass(tmp)$message else tmp } # from https://stackoverflow.com/a/14838321/1091766 re_escape <- function(strings) { vals <- c( "\\\\", "\\[", "\\]", "\\(", "\\)", "\\{", "\\}", "\\^", "\\$", "\\*", "\\+", "\\?", "\\.", "\\|" ) replace.vals <- paste0("\\\\", vals) for (i in seq_along(vals)) { strings <- gsub(vals[i], replace.vals[i], strings) } strings } base_url <- "https://hb.opencpu.org" hb <- function(x = NULL) if (is.null(x)) base_url else paste0(base_url, x) webmockr/tests/testthat/test-flipswitch.R0000644000176200001440000000371514752052374020360 0ustar liggesuserscontext("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'", { skip_if_not_installed("httr") skip_if_not_installed("httr2") aa <- enable() expect_is(aa, "logical") expect_equal(length(aa), 3) expect_true(all(aa)) expect_true(webmockr_lightswitch$crul) skip_if_not_installed("httr") expect_true(webmockr_lightswitch$httr) skip_if_not_installed("httr2") expect_true(webmockr_lightswitch$httr2) }) test_that("flipswitch - turn on with 'enable' - one pkg", { # disable all disable() # enable one pkg aa <- enable("crul") expect_is(aa, "logical") expect_equal(length(aa), 1) expect_true(aa) expect_true(webmockr_lightswitch$crul) skip_if_not_installed("httr") expect_false(webmockr_lightswitch$httr) skip_if_not_installed("httr2") expect_false(webmockr_lightswitch$httr2) }) test_that("flipswitch - turn off with 'disable'", { aa <- disable() # all are FALSE expect_true(!all(aa)) expect_false(webmockr_lightswitch$crul) skip_if_not_installed("httr") expect_false(webmockr_lightswitch$httr) skip_if_not_installed("httr2") expect_false(webmockr_lightswitch$httr2) }) test_that("enable and disable fail well", { expect_error(enable(wasp = 5), "unused argument") expect_error(disable(bee = 5), "unused argument") expect_error( enable(adapter = "stuff"), "adapter must be one of" ) expect_error( disable(adapter = "stuff"), "adapter must be one of" ) # FIXME: not sure how to test when pkg not installed # inside of test suite }) test_that("enabled works", { # disable all disable() expect_false(enabled()) expect_false(enabled("crul")) expect_false(enabled("httr")) expect_false(enabled("httr2")) expect_error(enabled("foobar"), "'adapter' must be in the set") }) webmockr/tests/testthat/crul_obj.rda0000644000176200001440000000036614113773445017372 0ustar liggesusersmPM 0 AyZ'_i7鶲)ujCJy/y^!p ]\=pal(n 3[L[E11Pt$i47We?1Ju:MBkF>XqGd(u8h3RWW*kVY x6>Yuviws 4߻, m7(@Dv^|RxU> my/Aq# PD^]ogmџ kN@(`DM^Q*{N%>ٲ/d[ey֎";KjHV/5vO|I5 4\vc㐫L[/n@׼ݤRڝy\E>Jpu}8#F׹Oz87ZPsK$<xS0 Gwebmockr/tests/testthat/test-Adapter.R0000644000176200001440000000070214752052374017555 0ustar liggesuserscontext("Adapter class") test_that("Adapter class can't be instantiated", { expect_is(Adapter, "R6ClassGenerator") expect_error( Adapter$new(), "Adapter parent class should not be called directly" ) }) test_that("Adapter initialize method errors as expected", { adap <- R6::R6Class("CrulAdapter", inherit = Adapter, public = list( client = NULL ) ) expect_error(adap$new(), "should not be called directly") }) webmockr/tests/testthat/test-onload.R0000644000176200001440000000140214752052374017447 0ustar liggesuserscontext("onload") test_that("onload: http_lib_adapter_registry", { expect_is(http_lib_adapter_registry, "HttpLibAdapaterRegistry") expect_is(http_lib_adapter_registry, "R6") expect_equal( sort(ls(envir = http_lib_adapter_registry)), c("adapters", "clone", "print", "register") ) expect_is(http_lib_adapter_registry$adapters, "list") expect_is( http_lib_adapter_registry$adapters[[1]], "CrulAdapter" ) expect_is( http_lib_adapter_registry$adapters[[2]], "HttrAdapter" ) expect_is( http_lib_adapter_registry$adapters[[3]], "Httr2Adapter" ) expect_is(http_lib_adapter_registry$clone, "function") expect_is(http_lib_adapter_registry$print, "function") expect_is(http_lib_adapter_registry$register, "function") }) webmockr/tests/testthat/test-stub_requests_crul.R0000644000176200001440000000707714752052374022146 0ustar liggesuserscontext("stub_request and crul: get") library(crul) crul::mock() # clear any stubs stub_registry_clear() test_that("stub_request works well: get requests", { skip_on_cran() # before any stubs made ## 0 stubs expect_equal(length(stub_registry()$request_stubs), 0) x <- crul::HttpClient$new(url = hb()) ms1 <- get_err_mssg(x$get("get", query = list(foo = "bar", a = 5))) expect_error( x$get("get", query = list(foo = "bar", a = 5)), re_escape(ms1) ) ms2 <- get_err_mssg(x$get("get", query = list(foo = "bar", stuff = FALSE))) expect_error( x$get("get", query = list(foo = "bar", stuff = FALSE)), re_escape(ms2) ) ms3 <- get_err_mssg(x$get("get", query = list(foo = "bar"))) expect_error( x$get("get", query = list(foo = "bar")), re_escape(ms3) ) # after a stub made stub_request("get", hb("/get?foo=bar&a=5")) %>% wi_th(headers = list( "Accept-Encoding" = "gzip, deflate", "Accept" = "application/json, text/xml, application/xml, */*" )) ## 1 stub expect_equal(length(stub_registry()$request_stubs), 1) # the matching request works z <- x$get("get", query = list(foo = "bar", a = 5)) expect_is(z, "HttpResponse") expect_equal(z$url, hb("/get?foo=bar&a=5")) # but the others still do not work cause they dont match the stub ms2 <- get_err_mssg(x$get("get", query = list(foo = "bar", stuff = FALSE))) expect_error(x$get("get", query = list(foo = "bar", stuff = FALSE)), re_escape(ms2)) ms3 <- get_err_mssg(x$get("get", query = list(foo = "bar"))) expect_error(x$get("get", query = list(foo = "bar")), re_escape(ms3)) # a stub for the second request stub_request("get", hb("/get?foo=bar&stuff=FALSE")) %>% wi_th(headers = list( "Accept-Encoding" = "gzip, deflate", "Accept" = "application/json, text/xml, application/xml, */*" )) ## 2 stubs now expect_equal(length(stub_registry()$request_stubs), 2) # the other request now works w <- x$get("get", query = list(foo = "bar", stuff = FALSE)) expect_is(w, "HttpResponse") expect_equal(w$url, hb("/get?foo=bar&stuff=FALSE")) # but the others still do not work cause they dont match the stub ms4 <- get_err_mssg(x$get("get", query = list(foo = "bar"))) expect_error(x$get("get", query = list(foo = "bar")), re_escape(ms4)) }) # clear any stubs again stub_registry_clear() context("stub_request and crul: post") test_that("stub_request works well: post requests", { skip_on_cran() # before any stubs made ## 0 stubs expect_equal(length(stub_registry()$request_stubs), 0) x <- crul::HttpClient$new(url = hb()) ms1 <- get_err_mssg(x$post("post", body = list(foo = "bar", a = 5))) expect_error( x$post("post", body = list(foo = "bar", a = 5)), re_escape(ms1) ) # after a stub made stub_request("post", hb("/post")) %>% wi_th( headers = list( "Accept-Encoding" = "gzip, deflate", "Accept" = "application/json, text/xml, application/xml, */*" ), body = list(foo = "bar", a = 5) ) ## 1 stub expect_equal(length(stub_registry()$request_stubs), 1) # the matching request works z <- x$post("post", body = list(foo = "bar", a = 5)) expect_is(z, "HttpResponse") expect_equal(z$url, hb("/post")) # but the others still do not work cause they dont match the stub ms2 <- get_err_mssg(x$post("post", query = list(foo = "bar", stuff = FALSE))) expect_error(x$post("post", query = list(foo = "bar", stuff = FALSE)), re_escape(ms2)) ms3 <- get_err_mssg(x$post("post", query = list(foo = "bar"))) expect_error(x$post("post", query = list(foo = "bar")), re_escape(ms3)) }) webmockr/tests/testthat/test-partial_matching.R0000644000176200001440000001335314752052374021511 0ustar liggesuserstest_that("include/exclude", { # keys and values works aa <- including(list(foo = "bar")) expect_output(print(aa), "") expect_is(aa, "partial") expect_is(unclass(aa), "list") expect_equal(length(aa), 1) expect_named(aa, "foo") expect_true(attr(aa, "partial_match")) expect_is(attr(aa, "partial_type"), "character") expect_equal(attr(aa, "partial_type"), "include") bb <- excluding(list(foo = "bar")) expect_output(print(bb), "") expect_is(bb, "partial") expect_is(unclass(bb), "list") expect_equal(length(bb), 1) expect_named(bb, "foo") expect_true(attr(bb, "partial_match")) expect_is(attr(bb, "partial_type"), "character") expect_equal(attr(bb, "partial_type"), "exclude") # just keys works cc <- including(list(foo = NULL, bar = NULL)) expect_output(print(cc), "") expect_is(cc, "partial") expect_is(unclass(cc), "list") expect_equal(length(cc), 2) }) skip_if_not_installed("httr") library(httr) test_that("include query parameters", { enable(adapter = "httr") on.exit({ disable(adapter = "httr") unloadNamespace("vcr") }) ## matches stub_request("get", "https://hb.opencpu.org/get") %>% wi_th(query = including(list(fruit = "pear"))) %>% to_return(body = "matched on including partial query!") resp_matched <- GET("https://hb.opencpu.org/get", query = list(fruit = "pear")) expect_equal(resp_matched$status_code, 200) expect_equal(rawToChar(content(resp_matched)), "matched on including partial query!") stub_registry_clear() ## doesn't match when query params dont include what the stub has expect_error( GET("https://hb.opencpu.org/get", query = list(meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("exclude query parameters", { enable(adapter = "httr") on.exit({ disable(adapter = "httr") unloadNamespace("vcr") }) ## matches stub_request("get", "https://hb.opencpu.org/get") %>% wi_th(query = excluding(list(fruit = "pear"))) %>% to_return(body = "matched on excluding partial query!") resp_matched <- GET("https://hb.opencpu.org/get", query = list(fruit = "apple")) expect_equal(resp_matched$status_code, 200) expect_equal(rawToChar(content(resp_matched)), "matched on excluding partial query!") ## doesn't match when query params include what's excluded expect_error( GET("https://hb.opencpu.org/get", query = list(fruit = "pear")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("include query parameters, just keys", { enable(adapter = "httr") on.exit({ disable(adapter = "httr") unloadNamespace("vcr") }) ## matches stub_request("get", "https://hb.opencpu.org/get") %>% wi_th(query = including(list(fruit = NULL))) %>% to_return(body = "matched on including key!") resp_matched <- GET("https://hb.opencpu.org/get", query = list(fruit = "pear")) expect_equal(resp_matched$status_code, 200) expect_equal(rawToChar(content(resp_matched)), "matched on including key!") stub_registry_clear() ## doesn't match when no query param keys match the include expect_error( GET("https://hb.opencpu.org/get", query = list(meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("exclude query parameters, just keys", { enable(adapter = "httr") on.exit({ disable(adapter = "httr") unloadNamespace("vcr") }) ## matches stub_request("get", "https://hb.opencpu.org/get") %>% wi_th(query = excluding(list(fruit = NULL))) %>% to_return(body = "matched on excluding key!") resp_matched <- GET("https://hb.opencpu.org/get", query = list(stuff = "things")) expect_equal(resp_matched$status_code, 200) expect_equal(rawToChar(content(resp_matched)), "matched on excluding key!") stub_registry_clear() ## doesn't match when there's a query param key that matches the exclude expect_error( GET("https://hb.opencpu.org/get", query = list(fruit = "pineapple")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("include request body", { enable(adapter = "httr") on.exit({ disable(adapter = "httr") unloadNamespace("vcr") }) ## matches stub_request("post", "https://hb.opencpu.org/post") %>% wi_th(body = including(list(fruit = "pear"))) %>% to_return(body = "matched on including partial body!") resp_matched <- POST("https://hb.opencpu.org/post", body = list(fruit = "pear", meat = "chicken") ) expect_equal(resp_matched$status_code, 200) expect_equal(rawToChar(content(resp_matched)), "matched on including partial body!") stub_registry_clear() ## doesn't match when request body does not include what the stub has expect_error( POST("https://hb.opencpu.org/post", query = list(meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("exclude request body", { enable(adapter = "httr") on.exit({ disable(adapter = "httr") unloadNamespace("vcr") }) ## matches stub_request("post", "https://hb.opencpu.org/post") %>% wi_th(body = excluding(list(fruit = "pear"))) %>% to_return(body = "matched on excluding partial body!") resp_matched <- POST("https://hb.opencpu.org/post", body = list(color = "blue") ) expect_equal(resp_matched$status_code, 200) expect_equal(rawToChar(content(resp_matched)), "matched on excluding partial body!") stub_registry_clear() ## doesn't match when request body does not include what the stub has expect_error( POST("https://hb.opencpu.org/post", body = list(fruit = "pear", meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) webmockr/tests/testthat/httr2_obj.rda0000644000176200001440000000030114715656454017465 0ustar liggesusers]PA0\Z!11# xfPShmKl᰻3L[UfU1A8Hb" !@rvuu3\AkQM.rC붳lf"wc=1ԋɤm/gǚ6FO0>9 6T*AI[[Q  !>webmockr/tests/testthat/test-HashCounter.R0000644000176200001440000000177514715656454020443 0ustar liggesuserscontext("HashCounter") test_that("HashCounter: structure", { expect_is(HashCounter, "R6ClassGenerator") x <- HashCounter$new() expect_is(x, "HashCounter") expect_is(x$clone, "function") expect_is(x$get, "function") expect_is(x$put, "function") expect_is(x$hash, "list") }) test_that("HashCounter: works as expected", { x <- HashCounter$new() a <- RequestSignature$new(method = "get", uri = hb("/get")) b <- RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/") x$put(a) expect_length(x$hash, 1) expect_equal(x$hash[[a$to_s()]]$count, 1) x$put(a) expect_length(x$hash, 1) expect_equal(x$hash[[a$to_s()]]$count, 2) x$put(b) expect_length(x$hash, 2) expect_equal(x$hash[[b$to_s()]]$count, 1) x$put(b) x$put(b) expect_length(x$hash, 2) expect_equal(x$hash[[b$to_s()]]$count, 3) }) test_that("HashCounter fails well", { x <- HashCounter$new() expect_error(x$get(), '\"req_sig\" is missing') expect_error(x$put(), '\"req_sig\" is missing') }) webmockr/tests/testthat/test-CrulAdapter.R0000644000176200001440000001323614752052374020411 0ustar liggesuserscontext("CrulAdapter") aa <- CrulAdapter$new() test_that("CrulAdapter bits are correct", { skip_on_cran() expect_is(CrulAdapter, "R6ClassGenerator") expect_is(aa, "CrulAdapter") expect_null(aa$build_crul_request) # pulled out of object, so should be NULL expect_null(aa$build_crul_response) # pulled out of object, so should be NULL expect_is(aa$disable, "function") expect_is(aa$enable, "function") expect_is(aa$handle_request, "function") expect_is(aa$remove_stubs, "function") expect_is(aa$name, "character") expect_equal(aa$name, "CrulAdapter") }) test_that("CrulAdapter behaves correctly", { skip_on_cran() expect_message(aa$enable(), "CrulAdapter enabled!") expect_message(aa$disable(), "CrulAdapter disabled!") }) test_that("build_crul_request/response fail well", { skip_on_cran() expect_error(build_crul_request(), "argument \"x\" is missing") expect_error(build_crul_response(), "argument \"resp\" is missing") }) test_that("CrulAdapter: works when vcr is loaded but no cassette is inserted", { skip_on_cran() skip_if_not_installed("vcr") webmockr::enable(adapter = "crul") on.exit({ webmockr::disable(adapter = "crul") unloadNamespace("vcr") }) stub_request("get", hb("/get")) library("vcr") # works when no cassette is loaded cli <- crul::HttpClient$new(hb()) expect_silent(x <- cli$get("get")) expect_is(x, "HttpResponse") # works when empty cassette is loaded vcr::vcr_configure(dir = tempdir()) vcr::insert_cassette("empty") expect_silent(x <- cli$get("get")) vcr::eject_cassette("empty") expect_is(x, "HttpResponse") }) context("CrulAdapter - with real data") test_that("CrulAdapter works", { skip_on_cran() skip_if_not_installed("vcr") load("crul_obj.rda") crul_obj$url$handle <- curl::new_handle() res <- CrulAdapter$new() # with vcr message library(vcr) expect_error( res$handle_request(crul_obj), "There is currently no cassette in use" ) # with webmockr message # unload vcr unloadNamespace("vcr") expect_error( res$handle_request(crul_obj), "Real HTTP connections are disabled" ) 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") # no response headers expect_equal(length(aa$response_headers), 0) expect_equal(length(aa$response_headers_all), 0) # with headers # clear registry stub_registry_clear() # stub with headers x <- stub_request("get", "http://localhost:9000/get") x <- to_return(x, headers = list("User-Agent" = "foo-bar")) 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") # has response_headers and response_headers_all expect_equal(length(aa$response_headers), 1) expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "user-agent") expect_equal(length(aa$response_headers_all), 1) expect_is(aa$response_headers_all, "list") expect_named(aa$response_headers_all, NULL) expect_named(aa$response_headers_all[[1]], "user-agent") # stub with redirect headers my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" x <- stub_request("get", my_url) x <- to_return(x, status = 302, headers = list( status = 302, location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" ) ) crul_obj$url$url <- my_url res <- CrulAdapter$new() aa <- res$handle_request(crul_obj) expect_equal(aa$method, "get") expect_equal(aa$url, my_url) expect_equal(aa$status_code, 302) # has response_headers and response_headers_all expect_equal(length(aa$response_headers), 2) expect_is(aa$response_headers, "list") expect_equal(sort(names(aa$response_headers)), c("location", "status")) expect_equal(length(aa$response_headers_all), 1) expect_equal(length(aa$response_headers_all[[1]]), 2) expect_is(aa$response_headers_all, "list") expect_is(aa$response_headers_all[[1]], "list") expect_named(aa$response_headers_all, NULL) expect_equal( sort(names(aa$response_headers_all[[1]])), c("location", "status") ) ## FIXME: ideally can test multiple redirect headers, e.g. like this: # x <- stub_request("get", "https://doi.org/10.1007/978-3-642-40455-9_52-1") # x <- to_return(x, headers = list( # list( # status = 'HTTP/1.1 302 ', # location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" # ), # list( # status = 'HTTP/1.1 301 Moved Permanently', # location = "https://link.springer.com/10.1007/978-3-642-40455-9_52-1" # ), # list( # status = 'HTTP/1.1 302 Found', # location = "https://link.springer.com/referenceworkentry/10.1007%2F978-3-642-40455-9_52-1" # ), # list( # status = 'HTTP/1.1 200 OK' # ) # )) }) test_that("crul requests with JSON-encoded bodies work", { skip_on_cran() on.exit(disable(adapter = "crul")) enable(adapter = "crul") body <- list(foo = "bar") url <- hb() cli <- crul::HttpClient$new(url) z <- stub_request("post", uri = file.path(url, "post")) %>% wi_th(body = jsonlite::toJSON(body, auto_unbox = TRUE)) # encoded body works res <- cli$post("post", body = body, encode = "json") expect_s3_class(res, "HttpResponse") # encoded but modified body fails expect_error( cli$post("post", body = list(foo = "bar1"), encode = "json"), "Unregistered request" ) # unencoded body should work because we serialize internally expect_s3_class(cli$post("post", body = body), "HttpResponse") }) webmockr/tests/testthat/test-HttrAdapter.R0000644000176200001440000002511014752052374020417 0ustar liggesuserscontext("HttrAdapter") skip_if_not_installed("httr") library("httr") aa <- HttrAdapter$new() test_that("HttrAdapter bits are correct", { skip_on_cran() expect_is(HttrAdapter, "R6ClassGenerator") expect_is(aa, "HttrAdapter") expect_null(aa$build_httr_request) # pulled out of object, so should be NULL expect_null(aa$build_httr_response) # pulled out of object, so should be NULL expect_is(aa$disable, "function") expect_is(aa$enable, "function") expect_is(aa$handle_request, "function") expect_is(aa$remove_stubs, "function") expect_is(aa$name, "character") expect_equal(aa$name, "HttrAdapter") }) test_that("HttrAdapter behaves correctly", { skip_on_cran() expect_message(aa$enable(), "HttrAdapter enabled!") expect_message(aa$disable(), "HttrAdapter disabled!") }) test_that("build_httr_request/response fail well", { skip_on_cran() expect_error(build_httr_request(), "argument \"x\" is missing") expect_error(build_httr_response(), "argument \"req\" is missing") }) test_that("HttrAdapter: works when vcr is loaded but no cassette is inserted", { skip_on_cran() skip_if_not_installed("vcr") webmockr::enable(adapter = "httr") on.exit({ webmockr::disable(adapter = "httr") unloadNamespace("vcr") }) stub_request("get", hb("/get")) library("vcr") # works when no cassette is loaded expect_silent(x <- httr::GET(hb("/get"))) expect_is(x, "response") # # works when empty cassette is loaded vcr::vcr_configure(dir = tempdir()) vcr::insert_cassette("empty") expect_silent(x <- httr::GET(hb("/get"))) vcr::eject_cassette("empty") expect_is(x, "response") }) # library(httr) # z <- GET(hb("/get")) # httr_obj <- z$request # save(httr_obj, file = "tests/testthat/httr_obj.rda", version = 2) context("HttrAdapter: date slot") test_that("HttrAdapter date slot works", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") path <- file.path(tempdir(), "foobar") vcr::vcr_configure(dir = path) vcr::use_cassette("test-date", httr::GET(hb("/get"))) # list.files(path) # readLines(file.path(path, "test-date.yml")) vcr::insert_cassette("test-date") x <- httr::GET(hb("/get")) # $date is of correct format expect_output(print(x), "Date") expect_is(x$date, "POSIXct") expect_is(format(x$date, "%Y-%m-%d %H:%M"), "character") # $headers$date is a different format expect_is(x$headers$date, "character") expect_error(format(x$headers$date, "%Y-%m-%d %H:%M"), "invalid 'trim'") vcr::eject_cassette("test-date") # cleanup unlink(path, recursive = TRUE) }) context("HttrAdapter: insensitive headers, webmockr flow") test_that("HttrAdapter insensitive headers work, webmockr flow", { skip_on_cran() unloadNamespace("vcr") httr_mock() stub_registry_clear() invisible(stub_request("get", uri = hb("/get")) %>% to_return( body = list(foo = "bar"), headers = list("Content-Type" = "application/json") )) x <- httr::GET(hb("/get")) expect_equal(x$headers[["content-type"]], "application/json") expect_is(httr::content(x), "list") expect_is(httr::content(x, "text", encoding = "UTF-8"), "character") stub_registry_clear() httr_mock(FALSE) }) context("HttrAdapter: insensitive headers, vcr flow") test_that("HttrAdapter insensitive headers work, vcr flow", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") path <- file.path(tempdir(), "helloworld") vcr::vcr_configure(dir = path) vcr::use_cassette("test-date", GET(hb("/get"))) vcr::insert_cassette("test-date") x <- httr::GET(hb("/get")) expect_equal(x$headers[["content-type"]], "application/json") expect_is(httr::content(x), "list") expect_is(httr::content(x, "text", encoding = "UTF-8"), "character") vcr::eject_cassette("test-date") # cleanup unlink(path, recursive = TRUE) }) context("HttrAdapter: works with real data") test_that("HttrAdapter works", { skip_on_cran() skip_if_not_installed("vcr") load("httr_obj.rda") # load("tests/testthat/httr_obj.rda") res <- HttrAdapter$new() # with vcr message library("vcr") expect_error( res$handle_request(httr_obj), "There is currently no cassette in use" ) # with webmockr message # unload vcr unloadNamespace("vcr") expect_error( res$handle_request(httr_obj), "Real HTTP connections are disabled" ) invisible(stub_request("get", hb("/get"))) aa <- res$handle_request(httr_obj) expect_is(res, "HttrAdapter") expect_is(aa, "response") expect_equal(aa$request$method, "GET") expect_equal(aa$url, hb("/get")) # no response headers expect_equal(length(aa$headers), 0) expect_equal(length(aa$all_headers), 1) # with headers # clear registry stub_registry_clear() # stub with headers x <- stub_request("get", hb("/get")) x <- to_return(x, headers = list("User-Agent" = "foo-bar")) aa <- res$handle_request(httr_obj) expect_is(res, "HttrAdapter") expect_is(aa, "response") expect_equal(aa$request$method, "GET") expect_equal(aa$url, hb("/get")) # has headers and all_headers expect_equal(length(aa$headers), 1) expect_is(aa$headers, "list") expect_named(aa$headers, "user-agent") expect_equal(length(aa$all_headers), 1) expect_is(aa$all_headers, "list") expect_named(aa$all_headers, NULL) expect_named(aa$all_headers[[1]], c("status", "version", "headers")) # stub with redirect headers my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" x <- stub_request("get", my_url) x <- to_return(x, status = 302, headers = list( status = 302, location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" ) ) httr_obj$url <- my_url res <- HttrAdapter$new() aa <- res$handle_request(httr_obj) expect_equal(aa$request$method, "GET") expect_equal(aa$url, my_url) expect_equal(aa$status_code, 302) # has headers and all_headers expect_equal(length(aa$headers), 2) expect_is(aa$headers, "list") expect_equal(sort(names(aa$headers)), c("location", "status")) expect_equal(length(aa$all_headers), 1) expect_equal(length(aa$all_headers[[1]]), 3) expect_is(aa$all_headers, "list") expect_is(aa$all_headers[[1]], "list") expect_named(aa$all_headers, NULL) expect_equal( sort(names(aa$all_headers[[1]])), c("headers", "status", "version") ) }) test_that("HttrAdapter works with httr::authenticate", { skip_on_cran() unloadNamespace("vcr") httr_mock() # httr_mock(FALSE) # webmockr_allow_net_connect() stub_registry_clear() # stub_registry() # request_registry() z <- stub_request("get", uri = hb("/basic-auth/foo/bar")) %>% to_return( body = list(foo = "bar"), headers = list("Content-Type" = "application/json") ) # x <- httr::GET(hb("/basic-auth/foo/bar"), httr::authenticate("foo", "bar")) # httr_obj_auth <- x$request # save(httr_obj_auth, file = "tests/testthat/httr_obj_auth.rda", version = 2) # load("tests/testthat/httr_obj_auth.rda") # mocked httr requests with auth work # before the fixes in HttrAdapter: a real request through webmockr would # not work with authenticate x <- httr::GET(hb("/basic-auth/foo/bar"), httr::authenticate("foo", "bar")) expect_is(x, "response") expect_equal(httr::content(x), list(foo = "bar")) expect_equal(x$headers, structure(list(`content-type` = "application/json"), class = c("insensitive", "list") )) expect_equal(x$status_code, 200) # HttrAdapter works on requests with auth load("httr_obj_auth.rda") zz <- HttrAdapter$new() z <- zz$handle_request(httr_obj_auth) expect_is(z, "response") expect_equal(httr::content(z), list(foo = "bar")) expect_equal(z$headers, structure(list(`content-type` = "application/json"), class = c("insensitive", "list") )) expect_equal(z$status_code, 200) }) test_that("httr works with webmockr_allow_net_connect", { skip_on_cran() httr_mock() stub_registry_clear() z <- stub_request("get", uri = hb("/get?stuff=things")) %>% to_return(body = "yum=cheese") x <- httr::GET(hb("/get?stuff=things")) expect_true(httr::content(x, "text", encoding = "UTF-8") == "yum=cheese") # allow net connect - stub still exists though - so not a real request webmockr_allow_net_connect() z <- httr::GET(hb("/get?stuff=things")) expect_true(httr::content(z, "text", encoding = "UTF-8") == "yum=cheese") # allow net connect - stub now gone - so real request should happen stub_registry_clear() w <- httr::GET(hb("/get?stuff=things")) expect_false(httr::content(w, "text", encoding = "UTF-8") == "yum=cheese") # disable net connect - now real requests can't be made webmockr_disable_net_connect() expect_error( httr::GET(hb("/get?stuff=things")), "Real HTTP connections are disabled" ) }) test_that("httr requests with bodies work", { skip_on_cran() httr_mock() stub_registry_clear() z <- stub_request("post", uri = hb("/post")) %>% to_return(body = "asdffsdsdf") x <- httr::POST(hb("/post"), body = list(stuff = "things")) expect_true(httr::content(x, "text", encoding = "UTF-8") == "asdffsdsdf") # now with allow net connect stub_registry_clear() webmockr_allow_net_connect() x <- httr::POST(hb("/post"), body = list(stuff = "things")) expect_identical(httr::content(x)$form, list(stuff = "things")) webmockr_disable_net_connect() }) test_that("httr requests with nested list bodies work", { skip_on_cran() httr_mock() stub_registry_clear() body <- list(id = " ", method = "x", params = list(pwd = "p", user = "a")) z <- stub_request("post", uri = hb("/post")) %>% wi_th(body = body) %>% to_return(body = "asdffsdsdf") x <- httr::POST(hb("/post"), body = body) expect_true(httr::content(x, "text", encoding = "UTF-8") == "asdffsdsdf") # now with allow net connect stub_registry_clear() webmockr_allow_net_connect() x <- httr::POST(hb("/post"), body = jsonlite::toJSON(body), httr::content_type_json() ) expect_equal( jsonlite::fromJSON(rawToChar(x$content))$json, body ) webmockr_disable_net_connect() }) test_that("httr requests with JSON-encoded bodies work", { skip_on_cran() on.exit(disable(adapter = "httr")) enable(adapter = "httr") stub_registry_clear() body <- list(foo = "bar") z <- stub_request("post", uri = hb("/post")) %>% wi_th(body = jsonlite::toJSON(body, auto_unbox = TRUE)) # encoded body works res <- httr::POST(hb("/post"), body = body, encode = "json") expect_s3_class(res, "response") # encoded but modified body fails expect_error( httr::POST(hb("/post"), body = list(foo = "bar1"), encode = "json"), "Unregistered request" ) # unencoded body should work because we serialize internally expect_s3_class(httr::POST(hb("/post"), body = body), "response") }) webmockr/tests/testthat/test-to_raise.R0000644000176200001440000000313014752052374020000 0ustar liggesuserscontext("to_raise") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) library(fauxpas) aa <- stub_request("get", hb("/get")) %>% to_raise(HTTPAccepted) test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_null(aa$response_headers) # expect_false(aa$timeout) # timeout will be removed in StubbedRequest expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, hb("/get")) # to_raise expected stuff rr <- aa$responses_sequences[[1]] expect_true(rr$raise) expect_is(rr$exceptions, "list") expect_is(rr$exceptions[[1]], "R6ClassGenerator") expect_equal(rr$exceptions[[1]]$classname, "HTTPAccepted") expect_equal(rr$exceptions[[1]]$new()$status_code, 202) }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(to_raise(), "argument \".data\" is missing") expect_error(to_raise(5), "must be of class StubbedRequest") stub_registry_clear() # exception clases zzz <- stub_request("get", hb("/get")) expect_error( sw(to_raise(zzz, "foo")), "all objects must be error classes from fauxpas" ) ### if stub is not registered any longer, errors about that expect_error( sw(to_raise(zzz, "foo")), "not registered" ) }) webmockr/tests/testthat/test-remove_request_stub.R0000644000176200001440000000161214752052374022300 0ustar liggesuserscontext("remove_request_stub") # clear stubs before starting stub_registry_clear() test_that("remove_request_stub", { # no stubs at beginning expect_equal(length(stub_registry()$request_stubs), 0) # make a stub x <- stub_request("get", hb("/get")) # no there's a stub expect_equal(length(stub_registry()$request_stubs), 1) # remove the stub w <- remove_request_stub(x) expect_is(w, "list") expect_equal(length(w), 0) # no there's no stubs expect_equal(length(stub_registry()$request_stubs), 0) }) test_that("remove_request_stub: removes the stub upon an error", { # no stubs at beginning stub_registry_clear() expect_equal(length(stub_registry()$request_stubs), 0) expect_error( stub_request("post", uri = hb("/post")) %>% to_return(body = 5) ) expect_equal(length(stub_registry()$request_stubs), 0) stub_registry_clear() }) request_registry_clear() webmockr/tests/testthat/crul_body_upload_no_list.rda0000644000176200001440000002167714113773445022660 0ustar liggesusers=Ypu &ARS.xH("CH(Jdbrfdɢ-.F+v$vI'qr9*Uq|%vH*)ʉ]OtN+Lϼy{fvؖ jLׯpɽ}O1Ҭ+e&K u~z0nf jJY(vi)ߔvZ>q3wV)&;V%/>LߴhyFsF E dgly] 096Ih=?c[5?e9^7+vBnB/m;/wwnu2l=|ⱋcgtd߱sAq`ZZ֌GU5Үrium/5xiM,~iV]zh8N𛡵qMP+H~W' U,#r(@8'Eݎ5q#$L,? lj'-uҠq^9 Ӽ:$xv9i Qhˡ> m9>hߏށm- P僎 gY8WAf'm^WAݻ6g-zw6lfAISoP(6&H͔fa*rUрjLZС ܴC4nqc1PQdSAVRҮ'd["M7(= ݖTg߲0x%^^ާ.uTW W.!"k )UXMP`u&&Zԛ 2}"U18k#|z27P-On~=9Xf>]t۝*%}~[-֜8oػ˿]$_(.`@$ gB%p'x,Z<piQRI^/J$ r$L+QZ@i| O+R? g3ԦGIR wC(ȸ+qKZyf3)^hswZ>\LM *m|lcrU˼ćԒ}n3 CYOAhnPs!W=+Qǯ{P'v Rwk7A>.׻ў9%; έ0oI`8wy'v9x}!üYGwf0INs>09$0ụN:x~8t)DCAѯއs>"9"dzy'}'Bqhh. %$ ?טO3OWLXg88::ceo ~yc t t)掄V*^MT_m|\c~ p"ܿ _pvܿ w?n{px3O/ϢzƢcU1mZ*Nm&I;DqfTYBs*ȋ+I CB$.NhReלs*JJmT76ԍ$CmHMAbϐlermVrQpَx@G(Y\޴ZE蹮TZY%ڢffQJD K_KStB^PuN$6#ʂm[|{4aEnQ=skgBla1H*)}$+^RpxhӅ\9nK!;H6(UD+iUv7 HxyE)Ͳ㎴9t[jGEO-n=~p'[X<i Rͥg/Kدŭ\\-kE-ZJ5ǰEQ!z8G(kkx@yuR%Nپ{XtZyҫ4hY*teV=x?5]S4>hC >3PZp4-~89IZQPki/'54_^Je-u*r8ǂpn-a[%JXzW~RD&qZIÇISbT+Nߒ<\g[?TWYV3 ZևUͲ:nc-kF4Bqr&8"N=TU/EտfL9YLDc%յZ{LU]jumtI{5O@/ )u4U$uke"ֹEPϷ&}q.@oݡ@hEBkfy9S,SA+Ła ZY2& ]hh>JT4t o7xk@U.$Z{F,4Z;p+{ n,1mAv{Ǭ^<_)-mo ~fSw{&=D,k)w [hN| rk屌kw0WH`g$4?|XDŽtI'$B@;8t"kK %3(.98Rq;k6IDžD|C 9uC^ycl 2s`!zpݷEZs +끌UgI$~䊑uw a bTsfBvDo[Yݯø<=";~+*!ڈۻ?&=^I?ڢFQT^kEzoםp].By~=xH;/pyeLWZkDdv=+op}q} 7ͽPWtBGmhP. 6)z[&̗w-a,Agύ0qs_ ZUӢq=ᕟXxtE? AJ(:;'[! 7/dxw8'/ .9Ո vȉ\ ƚXX"EOXfwyQ)_[C7csݏ g4k= c.iU:eo;Zl& PG]j}w4{ȿSЍ d=~-KV9I,W:)]6=ݿwM16nUgZ<K;" B;=vO[@4JD6zpR7|yD%l!a[$B_$Qw%-ev.\G] u51i]$h߈K6%& 'HIv$LP(Bڃ>NDń",PVzf&0]O ^\㐏u1-غw5A6jRA(SXIGF>@.=^F&Qioݐz^–P3>,bCDiꟓ( h K@1 s*jO%Ñu(Qps#4W(~sPu}L3ҤjyQ`K{@.]++v`NTǺc׫ vhE| Ą [Jc~iΈsϯa(DҚ]pS(o Y-<)@x4Qa ?ןIkZI]'#ZY4*|dpl4L\բ#'<(Sh:b sTWKN]sol^r"EEг6U+2I z+Tw@l6(L+Ȳ[hmt~JrJg a\.I)%|͏Q)C ? >%ti? ÑM'?º'Q/ ''X>15H(8 34Jq|ZPRjof ;̮6=ZH0~S19忘X| >ae,JT6ӏ$ 5:'m}E:tnBqRnp^*Qk%Pl=S]R{s )5u=WQ9=>t-y,юDe>w .jS8褞F$3ILvVqL*6e5fs]b"ݢ T?GD EHa LJȾB+2AA<6ȹ3cbBwH(i%tQM3<CO8Va>%ܿW_oєTq_EyPH.!B5e$Of!iJ,d12'^p4<&16-CM8k؅ lPIs8"N~ ME/e|\>bxFޝ^9G :s0LTHB_exEi,Bj)Jγ($4%Q;|yšp#BFh3loFS3QKQ퉈BwWҞ$ \1]Y^L~£13~u05FXRpgc uh@1-CL}Wghg[C܌S_yL'4T&TZe/L%jVI0OC~s{!TKB=ӊ, "jJ?kDtc^ o6QBW? ěPH`&$}]o;Nb*~.6|%׉0oU'2J/qE ,LNdR{ M}!q,^/f҆aUZ ܐ)f&[QܯK Gxzj,$2픕g;z]sBѫ"5'枨*0iŚ0_$ /[$ qdQBEbk WY&\JSd,級Y6[u0B׫$U\GNa?w;POQWtȆL J )ί&)YZEMp%Dik)z&FWTsBFPvdD6S'%ۘ?>\w}ԧtː VI0@^J˱ecʨ1+ boK˃)ؓ (}* _Fuv^C3v@)e27|1  6ʹcA;a\ % QV_Hh{Y|DگMIk]ƕ#A[.s\Bu=2!g@_D> px ZIf@[>|B38쫺Taz}Z>Z$ٙi;uYvgU? JzY>0e $H:3 AsymogV4q07jvMvrY Fޝ k#VdNn6ڰK2蛤wK T "q#sU{PyJq z=7cژS ]4ȫf+z+Җ& }0qtU,:B" StQI | HI 8UmI.⠀D=; JSP{TQU3G%G) 9S[1WQ*+*;לZt=zމ(ͦYxsO<"ZEj,зՀЇX(c1ځߡYNҮmբΓk=7$7y8*!U AӋ{h} |޲H+ҷ7:aH|~~=$A1MŖ>Q#D:ӊiM$l/S:/ gn Ut:WQ*BnIhIKM^ƾϨ5l BWt]W@yh? !y ,NRLySm77vG 7ڶfʑEjTv-!kێ<6䡲4q0aIxJrּ?I2%:ʒB/YYL㝉lvq%67*̨ξFg8q}UI鐵W>\r:Sj}WBCS;Z2FѨrC` DI鐵ʼnhfʡihegiv7/-`Lu>*ttp*ܱv]EK<.kZY!5NI'T D¥?b Rl>iWl{JYH@숁&Ql#-zV赔=]v6ݣ)8+>因AȳMXɤGFa~S5 ~"ᩚ+B!\I5F6L֔vLY38`‡'Qd*PѪER]d>ݫTL>qGGT:̶-W;8H+,-vlB`/0 b&n՟ }YoCVIز%!F&g\_\,!{b6hY%xkMB\'E?q)JD=,μ'6(jj"_^ iCF?bB:RĊlmcֲ`zr<|h>G/=E8'Dbp 5w\c~ G\ eu9m{ٞHFY{%ҪŅ'BhaW0k uM",/F /b=Xe?LiQN"Y+(Z{HSn.1`x"ߓËOWr2z)>t?]?A+>@ oghˡ> mmW6[P` >۬ x; 9=k6~`儿3P deиpZ r.%vkep`u~7P)X2ܶegzUW6 '` OOQҦ밴2211`&Z,أx)]n )@|sndɕI%7W _]|Pz27P-O,sïb&2-d[@Q Hvzd\t ({rV.9)Pۻϊ~~{"Eq# ~o~fL*z uO)iI´i !HkQZ60oHO-i-ٲ1Wrwύfnn_GsF xoXND\]V C/lyP֬˺l,x>]W˚{.Qݝ-e]\8ʏI5$mVvg]@SY\f"uCE'NJEZ9Y){z,V7vJ\b8?`yA]O>aᯧ]Eי-^:Eיp:/΋s[Ol ziK]"rzt$%IpM]w̜ggqKf,mJnZW܄_rYeQQ/ى{ l0-Fl1X4\4Bx)]bi$b4_Njl$webmockr/tests/testthat/test-RequestPattern.R0000644000176200001440000003041014752052374021162 0ustar liggesuserscontext("RequestPattern") test_that("RequestPattern: structure is correct", { expect_is(RequestPattern, "R6ClassGenerator") aa <- RequestPattern$new(method = "get", uri = hb("/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 = hb("/get")) rs1 <- RequestSignature$new(method = "get", uri = hb("/get")) rs2 <- RequestSignature$new(method = "post", uri = hb("/get")) rs3 <- RequestSignature$new( method = "get", uri = "https:/hb.opencpu.org", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) expect_true(aa$matches(rs1)) expect_false(aa$matches(rs2)) expect_false(aa$matches(rs3)) expect_is(aa$to_s(), "character") expect_match(aa$to_s(), "GET") expect_match(aa$to_s(), "hb.opencpu.org/get") }) test_that("RequestPattern: uri_regex", { x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org") expect_is(x$uri_pattern, "UriPattern") expect_equal(x$uri_pattern$to_s(), "https?://.+ossref.org") expect_equal(x$to_s(), "GET https?://.+ossref.org") }) test_that("RequestPattern fails well", { expect_error(RequestPattern$new(), "one of uri or uri_regex is required") x <- RequestPattern$new(method = "get", uri = hb("/get")) expect_error(x$matches(), "argument \"request_signature\" is missing") expect_error( x$matches("adfadf"), "must be of class RequestSignature" ) }) # BODY PATTERNS: plain text bodies and related test_that("should match if request body and body pattern are the same", { aa <- RequestPattern$new(method = "get", uri = hb("/get"), body = "abc") rs1 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = "abc") ) expect_true(aa$matches(rs1)) }) test_that("should match if request body and body pattern are the same with multline text", { multiline_text <- "hello\nworld" bb <- RequestPattern$new(method = "get", uri = hb("/get"), body = multiline_text) rs2 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = multiline_text) ) expect_true(bb$matches(rs2)) }) # FIXME: regex in bodies not supported yet test_that("regex", {}) test_that("should match if pattern is missing body but is in signature", { cc <- RequestPattern$new(method = "get", uri = hb("/get")) rs3 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = "abc") ) expect_true(cc$matches(rs3)) }) test_that("should not match if pattern has body specified as NA but request body is not empty", { dd <- RequestPattern$new(method = "get", uri = hb("/get"), body = NA) rs4 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = "abc") ) expect_false(dd$matches(rs4)) }) test_that("should not match if pattern has body specified as empty string but request body is not empty", { ee <- RequestPattern$new(method = "get", uri = hb("/get"), body = "") rs5 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = "abc") ) expect_false(ee$matches(rs5)) }) test_that("should not match if pattern has body specified but request has no body", { ff <- RequestPattern$new(method = "get", uri = hb("/get"), body = "abc") rs6 <- RequestSignature$new(method = "get", uri = hb("/get")) expect_false(ff$matches(rs6)) }) test_that("should match when pattern body is json or list", { body_list <- list( a = "1", b = "five", c = list( d = list("e", "f") ) ) # These should both be TRUE pattern_as_list <- RequestPattern$new( method = "get", uri = hb("/get"), body = body_list ) rs7 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list( headers = list(`Content-Type` = "application/json"), body = jsonlite::toJSON(body_list, auto_unbox = TRUE) ) ) expect_true(pattern_as_list$matches(rs7)) pattern_as_json <- RequestPattern$new( method = "get", uri = hb("/get"), body = jsonlite::toJSON(body_list, auto_unbox = TRUE) ) expect_true(pattern_as_json$matches(rs7)) }) test_that("should match when pattern body is a list and body is various content types", { pattern <- RequestPattern$new( method = "get", uri = hb("/get"), body = list(data = list(a = "1", b = "five")) ) rs_xml <- RequestSignature$new( method = "get", uri = hb("/get"), options = list( headers = list(`Content-Type` = "application/xml"), body = '' ) ) expect_true(pattern$matches(rs_xml)) xml_employees_text <- ' ' xml_employees_list <- list(company = list( employees = list( company = "MacroSoft", division = "Sales", employee = list( empno = "7369", ename = "SMITH", job = "CLERK", hiredate = "17-DEC-1980" ), employee = list( empno = "7499", ename = "ALLEN", job = "SALESMAN", hiredate = "20-FEB-1981" ) ), employees = list( company = "MacroSoft", division = "Research", employee = list( empno = "7698", ename = "BLAKE", job = "MANAGER", hiredate = "01-MAY-1981" ), employee = list( empno = "7782", ename = "CLARK", job = "MANAGER", hiredate = "09-JUN-1981" ) ) )) pattern2 <- RequestPattern$new( method = "get", uri = hb("/get"), body = xml_employees_list ) rs_xml2 <- RequestSignature$new( method = "get", uri = hb("/get"), options = list( headers = list(`Content-Type` = "application/xml"), body = xml_employees_text ) ) expect_true(pattern2$matches(rs_xml2)) }) test_that("should warn when xml parsing fails and fall back to the xml string", { pattern <- RequestPattern$new( method = "get", uri = hb("/get"), body = '' ) rs_xml_parse_fail <- RequestSignature$new( method = "get", uri = hb("/get"), options = list( headers = list(`Content-Type` = "application/xml"), body = ' wi_th(body = response_body) |> to_return(status = 200) res <- POST(url = "http://pink.tv/pajamas", body = response_body) expect_s3_class(res, "response") expect_equal(status_code(res), 200) disable() }) context("UriPattern") test_that("UriPattern: structure is correct", { expect_is(UriPattern, "R6ClassGenerator") aa <- UriPattern$new(pattern = "http://foobar.com") expect_is(aa, "UriPattern") expect_is(aa$pattern, "character") expect_false(aa$regex) expect_match(aa$pattern, "foobar") # matches w/o slash expect_true(aa$matches("http://foobar.com")) # and matches w/ slash expect_true(aa$matches("http://foobar.com/")) # fails well expect_error( expect_is(aa$matches(), "function"), "argument \"uri\" is missing" ) # regex usage z <- UriPattern$new(regex_pattern = ".+ample\\..") expect_is(z, "UriPattern") expect_is(z$pattern, "character") expect_true(z$regex) expect_true(z$matches("http://sample.org")) expect_true(z$matches("http://example.com")) expect_false(z$matches("http://tramples.net")) # add query params usage z <- UriPattern$new(pattern = "http://foobar.com") expect_equal(z$pattern, "http://foobar.com") z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) expect_equal(z$pattern, "http://foobar.com?pizza=cheese&cheese=cheddar") ## query params in uri only z <- UriPattern$new(pattern = "http://foobar.com?pizza=cheese&cheese=cheddar") expect_equal(z$pattern, "http://foobar.com?pizza=cheese&cheese=cheddar") ## before running add_query_params(), query_params_matches() of UriPattern won't match expect_false(z$matches("http://foobar.com?pizza=cheese&cheese=cheddar")) z$add_query_params() ## after unning add_query_params(), we should match expect_true(z$matches("http://foobar.com?pizza=cheese&cheese=cheddar")) # matches urls without scheme # - does match with "http" # - does not match with "https" z <- UriPattern$new(pattern = "foobar.com") expect_equal(z$pattern, "http://foobar.com") expect_true(z$matches("http://foobar.com")) expect_false(z$matches("https://foobar.com")) # regex with query parameters z <- UriPattern$new(regex_pattern = "https://x.com/.+/order\\?fruit=apple") expect_is(z, "UriPattern") expect_is(z$pattern, "character") expect_true(z$regex) expect_true(z$matches("https://x.com/a/order?fruit=apple")) expect_true(z$matches("https://x.com/b/order?fruit=apple")) expect_false(z$matches("https://x.com/a?fruit=apple")) }) webmockr/tests/testthat/test-RequestRegistry.R0000644000176200001440000000227314752052374021363 0ustar liggesuserscontext("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) z1 <- RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/") aa$register_request(request = z1) aa$register_request(request = z1) expect_length(aa$request_signatures$hash, 1) expect_equal( aa$request_signatures$hash[[z1$to_s()]]$count, 2 ) expect_output( print(aa), "Registered Requests" ) expect_output( print(aa), "POST: https://www.wikipedia.org/ 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(), '\"request\" is missing') }) webmockr/tests/testthat/test-HttpLibAdapaterRegistry.R0000644000176200001440000000341314752052374022740 0ustar liggesuserscontext("HttpLibAdapaterRegistry") test_that("HttpLibAdapaterRegistry: structure", { expect_is(HttpLibAdapaterRegistry, "R6ClassGenerator") aa <- HttpLibAdapaterRegistry$new() expect_is(aa, "HttpLibAdapaterRegistry") expect_null(aa$adapters) expect_is(aa$clone, "function") expect_is(aa$print, "function") expect_is(aa$register, "function") expect_output(print(aa), "HttpLibAdapaterRegistry") }) test_that("HttpLibAdapaterRegistry: behaves as expected", { skip_on_cran() aa <- HttpLibAdapaterRegistry$new() aa$register(CrulAdapter$new()) expect_length(aa$adapters, 1) expect_is(aa$adapters[[1]], "CrulAdapter") expect_equal(aa$adapters[[1]]$name, "CrulAdapter") expect_output(print(aa), "HttpLibAdapaterRegistry") expect_output(print(aa), "CrulAdapter") }) test_that("HttpLibAdapaterRegistry: behaves as expected", { skip_on_cran() aa <- HttpLibAdapaterRegistry$new() aa$register(HttrAdapter$new()) expect_length(aa$adapters, 1) expect_is(aa$adapters[[1]], "HttrAdapter") expect_equal(aa$adapters[[1]]$name, "HttrAdapter") expect_output(print(aa), "HttpLibAdapaterRegistry") expect_output(print(aa), "HttrAdapter") }) test_that("HttpLibAdapaterRegistry: behaves as expected", { skip_on_cran() aa <- HttpLibAdapaterRegistry$new() aa$register(Httr2Adapter$new()) expect_length(aa$adapters, 1) expect_is(aa$adapters[[1]], "Httr2Adapter") expect_equal(aa$adapters[[1]]$name, "Httr2Adapter") expect_output(print(aa), "HttpLibAdapaterRegistry") expect_output(print(aa), "Httr2Adapter") }) test_that("HttpLibAdapaterRegistry fails well", { x <- HttpLibAdapaterRegistry$new() expect_error(x$register(), "argument \"x\" is missing") expect_error( x$register(4), "'x' must be an adapter, such as CrulAdapter" ) }) webmockr/tests/testthat/test-uri_regex.R0000644000176200001440000000766214752052374020202 0ustar liggesuserscontext("uri_regex") test_that("uri_regex with crul", { stub_request("get", uri_regex = "hb.opencpu.org/.+") %>% to_return(body = list(foo = "bar")) library(crul) enable(adapter = "crul") webmockr_disable_net_connect() invisible( lapply(c("elephants", "bears", "leaves", "foo", "bar"), function(z) { expect_true(HttpClient$new(hb())$get(z)$success()) }) ) # more complicated regex stub_request("get", uri_regex = "[Aa].+\\.io/apple/") invisible( lapply(c("Anounce", "apple", "Afar", "after"), function(z) { expect_true(HttpClient$new(sprintf("https://%s.io", z))$get("apple")$success()) expect_error( HttpClient$new(sprintf("https://%s.io", z))$get("fruit"), "Real HTTP connections are disabled" ) }) ) # regex to match any URL ## https://github.com/ropensci/webmockr/issues/113 ## when matching any url with `.+`, it would lead to an empty url in response ## object, at least with crul stub_request("get", uri_regex = ".+") invisible( lapply(c("Anounce", "apple", "Afar", "after"), function(z) { url <- sprintf("https://%s.io", z) res <- HttpClient$new(url)$get(z) expect_is(res, "HttpResponse") expect_true(grepl(res$url, file.path(url, z), ignore.case = TRUE)) }) ) }) stub_registry_clear() test_that("uri_regex with httr", { stub_request("get", uri_regex = "hb.opencpu.org/.+") %>% to_return(body = list(foo = "bar")) library(httr) enable(adapter = "httr") invisible( lapply(c("elephants", "bears", "leaves", "foo", "bar"), function(z) { expect_false(http_error(GET(file.path(hb(), z)))) }) ) # more complicated regex stub_request("get", uri_regex = "[Aa].+\\.io/apple/") invisible( lapply(c("Anounce", "apple", "Afar", "after"), function(z) { expect_false(http_error(GET(sprintf("https://%s.io/apple", z)))) expect_error( GET(sprintf("https://%s.io/fruit", z)), "Real HTTP connections are disabled" ) }) ) # regex to match any URL ## https://github.com/ropensci/webmockr/issues/113 ## when matching any url with `.+`, it would lead to an empty url in response ## object, at least with crul stub_request("get", uri_regex = ".+") invisible( lapply(c("Anounce", "apple", "Afar", "after"), function(z) { url <- sprintf("https://%s.io", z) res <- GET(url, path = z) expect_is(res, "response") expect_true(grepl(res$url, file.path(url, z), ignore.case = TRUE)) }) ) }) stub_registry_clear() test_that("uri_regex with httr2", { skip_if_not_installed("httr2") stub_request("get", uri_regex = "hb.opencpu.org/.+") %>% to_return(body = list(foo = "bar")) library(httr2) enable(adapter = "httr2") invisible( lapply(c("elephants", "bears", "leaves", "foo", "bar"), function(z) { req <- request(file.path(hb(), z)) expect_false(resp_is_error(req_perform(req))) }) ) # more complicated regex stub_request("get", uri_regex = "[Aa].+\\.io/apple/") invisible( lapply(c("Anounce", "apple", "Afar", "after"), function(z) { req <- request(sprintf("https://%s.io/apple", z)) expect_false(resp_is_error(req_perform(req))) req2 <- request(sprintf("https://%s.io/fruit", z)) expect_error( req_perform(req2), "Real HTTP connections are disabled" ) }) ) # regex to match any URL ## https://github.com/ropensci/webmockr/issues/113 ## when matching any url with `.+`, it would lead to an empty url in response ## object, at least with crul stub_request("get", uri_regex = ".+") invisible( lapply(c("Anounce", "apple", "Afar", "after"), function(z) { url <- sprintf("https://%s.io", z) # res <- GET(url, path = z) req <- request(url) %>% req_url_path_append(z) res <- req_perform(req) expect_is(res, "httr2_response") expect_true(grepl(res$url, file.path(url, z), ignore.case = TRUE)) }) ) }) stub_registry_clear() webmockr/tests/testthat/test-wi_th.R0000644000176200001440000002101414752052374017306 0ustar liggesuserscontext("wi_th") test_that("wi_th: with just headers", { aa <- stub_request("get", hb("/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, hb("/get")) expect_equal(aa$request_headers, list("User-Agent" = "R")) }) test_that("wi_th: with headers and query", { aa <- stub_request("get", hb("/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: bodies", { aa <- stub_request("post", hb("/post")) %>% wi_th(body = list(foo = "bar")) expect_is(aa$body, "list") expect_output(print(aa), "body \\(class: list\\): foo=bar") bb <- stub_request("post", hb("/post")) %>% wi_th(body = '{"foo": "bar"}') expect_is(bb$body, "character") expect_output( print(bb), "body \\(class: character\\): \\{\"foo\": \"bar\"\\}" ) cc <- stub_request("post", hb("/post")) %>% wi_th(body = charToRaw('{"foo": "bar"}')) expect_is(cc$body, "raw") expect_output( print(cc), "body \\(class: raw\\): raw bytes, length: 14" ) dd <- stub_request("post", hb("/post")) %>% wi_th(body = 5) expect_is(dd$body, "numeric") expect_output(print(dd), "body \\(class: numeric\\): 5") ee <- stub_request("post", hb("/post")) %>% wi_th(body = crul::upload(system.file("CITATION"))) expect_is(ee$body, "form_file") expect_output(print(ee), "body \\(class: form_file\\): crul::upload") # FIXME: ideally (maybe?) we have a upload within a list look like # the above when not in a list? ff <- stub_request("post", hb("/post")) %>% wi_th(body = list(y = crul::upload(system.file("CITATION")))) expect_is(ff$body, "list") expect_is(ff$body$y, "form_file") expect_output(print(ff), "body \\(class: list\\): y = list\\(path") }) test_that("wi_th fails well", { expect_error(wi_th(), "argument \".data\" is missing") expect_error(wi_th(5), "must be of class StubbedRequest") # query zzz <- stub_request("get", hb("/get")) expect_error( sw(wi_th(zzz, query = list(5, 6))), "'query' must be a named list" ) zzz <- stub_request("get", hb("/get")) expect_error( sw(wi_th(zzz, query = list(a = 5, 6))), "'query' must be a named list" ) # headers zzz <- stub_request("get", hb("/get")) expect_error( sw(wi_th(zzz, headers = list(5, 6))), "'headers' must be a named list" ) zzz <- stub_request("get", hb("/get")) expect_error( sw(wi_th(zzz, headers = list(a = 5, 6))), "'headers' must be a named list" ) # only accepts certain set of named things zzz <- stub_request("get", hb("/get")) expect_error( sw(wi_th(zzz, a = 5)), "'wi_th' only accepts query, body, headers" ) }) test_that("wi_th .list works", { req <- stub_request("post", hb("/post")) expect_equal( wi_th(req, .list = list(body = list(foo = "bar"))), wi_th(req, body = list(foo = "bar")) ) expect_equal( wi_th(req, .list = list(query = list(a = 3445))), wi_th(req, query = list(a = 3445)) ) expect_equal(wi_th(req, .list = ), wi_th(req)) expect_error( sw(wi_th(req, .list = 4)), "must be of class list" ) req <- stub_request("post", hb("/post")) expect_error( sw(wi_th(req, .list = list(a = 5))), "'wi_th' only accepts query, body, headers" ) }) # addresses issue: https://github.com/ropensci/webmockr/issues/107 test_that("wi_th handles QUERIES with varied input classes", { stub_registry_clear() library(httr) enable("httr") # works w/ numeric stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = 30)) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ integer stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = 30L)) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ character stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = "30")) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ number as factor stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = as.factor(30))) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ character as factor stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(cursor = as.factor("ads97as9dfas8dfasfd"))) expect_is(GET("https://google.com?cursor=ads97as9dfas8dfasfd"), "response") # works w/ AsIs stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = I(30))) expect_is(GET("https://google.com?per_page=30"), "response") }) test_that("wi_th handles HEADERS with varied input classes", { stub_registry_clear() library(httr) enable("httr") # works w/ numeric stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30)) expect_is(GET("https://x.com", add_headers(foo = 30)), "response") # works w/ integer stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30L)) expect_is(GET("https://x.com", add_headers(foo = 30)), "response") # works w/ character stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = "30")) expect_is(GET("https://x.com", add_headers(foo = 30)), "response") # works w/ number as factor stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = as.factor(30))) expect_is(GET("https://x.com", add_headers(foo = 30)), "response") # works w/ character as factor stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = as.factor("bar"))) expect_is(GET("https://x.com", add_headers(foo = "bar")), "response") # works w/ AsIs stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30)) expect_is(GET("https://x.com", add_headers(foo = 30)), "response") }) disable("httr") test_that("wi_th basic_auth, crul", { # crul library(crul) enable("crul") con <- HttpClient$new("https://x.com", auth = auth("user", "passwd")) # pass stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) expect_is(con$get(), "HttpResponse") # ignores auth type con$auth <- crul::auth("user", "passwd", "digest") expect_is(con$get(), "HttpResponse") # fail stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) con$auth <- crul::auth("user", "password") expect_error(con$get(), "Unregistered") disable("crul") }) test_that("wi_th basic_auth, httr", { library(httr) enable("httr") # pass stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) expect_is(GET("https://x.com", authenticate("user", "passwd")), "response") # ignores auth type expect_is( GET("https://x.com", authenticate("user", "passwd", type = "digest")), "response" ) expect_is( GET("https://x.com", authenticate("user", "passwd", type = "ntlm")), "response" ) # fail stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) expect_error( GET("https://x.com", authenticate("user", "password")), "Unregistered" ) disable("httr") }) test_that("wi_th basic_auth, httr2", { skip_if_not_installed("httr2") library(httr2) enable("httr2") # pass stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) req <- request("https://x.com") %>% req_auth_basic("user", "passwd") expect_is(req_perform(req), "httr2_response") # fail stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) req2 <- request("https://x.com") %>% req_auth_basic("user", "password") expect_error( req_perform(req2), "Unregistered" ) disable("httr2") }) # cleanup stub_registry_clear() context("wi_th_: defunct") test_that("wi_th_: defunct", { expect_error(wi_th_(), "wi_th", class = "error") }) webmockr/tests/testthat/test-within_test_that_blocks.R0000644000176200001440000000305414752052374023116 0ustar liggesuserscontext("within test_that blocks: httr") library("httr") test_that("httr: without pipe", { httr_mock() enable() dat_json <- '{"foo":"bar"}' stub <- stub_request("get", uri = hb("/get")) to_return(stub, body = dat_json, headers = list("Content-Type" = "application/json; charset=utf-8") ) res <- GET(hb("/get")) expect_true(inherits(res, "response")) expect_is(content(res), "list") expect_named(content(res), "foo") expect_equal(content(res)$foo, "bar") disable() httr_mock(FALSE) }) test_that("httr: with pipe", { enable() dat_json <- '{"foo":"bar"}' stub <- stub_request("get", uri = hb("/get")) %>% to_return( body = dat_json, headers = list("Content-Type" = "application/json; charset=utf-8") ) res <- GET(hb("/get")) expect_true(inherits(res, "response")) expect_is(content(res), "list") expect_named(content(res), "foo") expect_equal(content(res)$foo, "bar") disable() }) unloadNamespace("httr") context("within test_that blocks: crul") test_that("crul works", { enable() dat_json <- '{"foo":"bar"}' stub <- stub_request("get", uri = hb("/get")) to_return(stub, body = dat_json, headers = list("Content-Type" = "application/json; howdy") ) res <- crul::HttpClient$new(hb())$get("get") expect_true(inherits(res, "HttpResponse")) expect_is(res$parse("UTF-8"), "character") expect_is(jsonlite::fromJSON(res$parse("UTF-8")), "list") expect_named(jsonlite::fromJSON(res$parse("UTF-8")), "foo") expect_equal(jsonlite::fromJSON(res$parse("UTF-8"))$foo, "bar") disable() }) webmockr/tests/testthat/test-StubRegistry.R0000644000176200001440000000570114752052374020647 0ustar liggesuserscontext("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$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 = "http://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 = hb()) aa <- StubRegistry$new() expect_is(aa$register_stub(stub = stub1), "list") expect_is(aa$register_stub(stub = stub2), "list") expect_is(aa, "StubRegistry") # 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, "http://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-Httr2Adapter.R0000644000176200001440000002067714752052374020516 0ustar liggesuserscontext("Httr2Adapter") skip_if_not_installed("httr2") library("httr2") aa <- Httr2Adapter$new() test_that("Httr2Adapter bits are correct", { skip_on_cran() expect_is(Httr2Adapter, "R6ClassGenerator") expect_is(aa, "Httr2Adapter") expect_null(aa$build_httr_request) # pulled out of object, so should be NULL expect_null(aa$build_httr_response) # pulled out of object, so should be NULL expect_is(aa$disable, "function") expect_is(aa$enable, "function") expect_is(aa$handle_request, "function") expect_is(aa$remove_stubs, "function") expect_is(aa$name, "character") expect_equal(aa$name, "Httr2Adapter") }) test_that("Httr2Adapter behaves correctly", { skip_on_cran() expect_message(aa$enable(), "Httr2Adapter enabled!") expect_message(aa$disable(), "Httr2Adapter disabled!") }) test_that("build_httr_request/response fail well", { skip_on_cran() expect_error(build_httr_request(), "argument \"x\" is missing") expect_error(build_httr_response(), "argument \"req\" is missing") }) test_that("Httr2Adapter: works when vcr is loaded but no cassette is inserted", { skip_on_cran() skip_if_not_installed("vcr") webmockr::enable(adapter = "httr2") on.exit({ webmockr::disable(adapter = "httr2") unloadNamespace("vcr") }) stub_request("get", hb("/get")) library("vcr") # works when no cassette is loaded expect_silent((x <- request(hb("/get")) %>% req_perform())) expect_s3_class(x, "httr2_response") # # works when empty cassette is loaded vcr::vcr_configure(dir = tempdir()) vcr::insert_cassette("empty") expect_silent((x <- request(hb("/get")) %>% req_perform())) vcr::eject_cassette("empty") expect_s3_class(x, "httr2_response") }) context("Httr2Adapter: date slot") test_that("Httr2Adapter date slot works", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") path <- file.path(tempdir(), "foobar") vcr::vcr_configure(dir = path) vcr::use_cassette("test-date", request(hb("/get")) %>% req_perform()) # list.files(path) # readLines(file.path(path, "test-date.yml")) vcr::insert_cassette("test-date") x <- request(hb("/get")) %>% req_perform() # $headers$date is a different format expect_is(x$headers$date, "character") expect_error(format(x$headers$date, "%Y-%m-%d %H:%M"), "invalid 'trim'") vcr::eject_cassette("test-date") # cleanup unlink(path, recursive = TRUE) }) # library(httr2) # z <- request(hb("/get")) %>% req_perform() # httr2_obj <- z$request # save(httr2_obj, file = "tests/testthat/httr2_obj.rda", version = 2) context("Httr2Adapter: works with real data") test_that("Httr2Adapter works", { skip_on_cran() skip_if_not_installed("vcr") load("httr2_obj.rda") # load("tests/testthat/httr2_obj.rda") res <- Httr2Adapter$new() # with vcr message library("vcr") expect_error( res$handle_request(httr2_obj), "There is currently no cassette in use" ) # with webmockr message # unload vcr unloadNamespace("vcr") expect_error( res$handle_request(httr2_obj), "Real HTTP connections are disabled" ) invisible(stub_request("get", hb("/get"))) aa <- res$handle_request(httr2_obj) expect_is(res, "Httr2Adapter") expect_is(aa, "httr2_response") expect_null(aa$request$method) expect_equal(aa$url, hb("/get")) # no response headers expect_equal(length(aa$headers), 0) # with headers # clear registry stub_registry_clear() # stub with headers x <- stub_request("get", hb("/get")) x <- to_return(x, headers = list("User-Agent" = "foo-bar")) aa <- res$handle_request(httr2_obj) expect_is(res, "Httr2Adapter") expect_is(aa, "httr2_response") expect_null(aa$request$method) expect_equal(aa$url, hb("/get")) # has headers and all_headers expect_equal(length(aa$headers), 1) expect_s3_class(aa$headers, "httr2_headers") expect_named(aa$headers, "user-agent") # stub with redirect headers my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" x <- stub_request("get", my_url) x <- to_return(x, status = 302, headers = list( status = 302, location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" ) ) httr2_obj$url <- my_url res <- Httr2Adapter$new() aa <- res$handle_request(httr2_obj) expect_null(aa$request$method) expect_equal(aa$url, my_url) expect_equal(aa$status_code, 302) # has headers and all_headers expect_equal(length(aa$headers), 2) expect_s3_class(aa$headers, "httr2_headers") expect_equal(sort(names(aa$headers)), c("location", "status")) }) test_that("Httr2Adapter works with req_auth_basic", { skip_on_cran() unloadNamespace("vcr") httr_mock() # httr_mock(FALSE) # webmockr_allow_net_connect() stub_registry_clear() # stub_registry() # request_registry() z <- stub_request("get", uri = hb("/basic-auth/foo/bar")) %>% to_return( body = list(foo = "bar"), headers = list("Content-Type" = "application/json") ) # mocked httr2 requests with auth work x <- request(hb("/basic-auth/foo/bar")) %>% req_auth_basic("foo", "bar") %>% req_perform() expect_is(x, "httr2_response") expect_equal( jsonlite::fromJSON(rawToChar(x$body)), list(authenticated = TRUE, user = "foo") ) expect_s3_class(x$headers, "httr2_headers") expect_equal(x$status_code, 200) # Httr2Adapter works on requests with auth # x <- request(hb("/basic-auth/foo/bar")) %>% # req_auth_basic("foo", "bar") %>% # req_perform() # httr2_obj_auth <- x$request # save(httr2_obj_auth, file = "tests/testthat/httr2_obj_auth.rda", version = 2) # load("tests/testthat/httr2_obj_auth.rda") load("httr2_obj_auth.rda") zz <- Httr2Adapter$new() z <- zz$handle_request(httr2_obj_auth) expect_is(z, "httr2_response") expect_equal( jsonlite::fromJSON(rawToChar(z$body)), list(foo = "bar") ) expect_s3_class(z$headers, "httr2_headers") expect_equal(z$status_code, 200) }) test_that("httr2 works with webmockr_allow_net_connect", { skip_on_cran() unloadNamespace("vcr") enable() stub_registry_clear() z <- stub_request("get", uri = hb("/get")) %>% wi_th(query = list(stuff = "things")) %>% to_return(body = "yum=cheese") req <- request(hb("/get")) %>% req_url_query(stuff = "things") x <- req_perform(req) expect_true(resp_body_string(x) == "yum=cheese") # disable net connect - now real requests can't be made webmockr_disable_net_connect() stub_registry_clear() expect_error( req_perform(req), "Real HTTP connections are disabled" ) # allow net connect - stub still exists though - so not a real request webmockr_allow_net_connect() z <- stub_request("get", uri = hb("/get")) %>% wi_th(query = list(stuff = "things")) %>% to_return(body = "yum=cheese") req <- request(hb("/get")) %>% req_url_query(stuff = "things") z <- req_perform(req) expect_true(resp_body_string(z) == "yum=cheese") # allow net connect - stub now gone - so real request should happen stub_registry_clear() req <- request(hb("/get")) %>% req_url_query(stuff = "things") httr2::local_mocked_responses(NULL) w <- req_perform(req) expect_false(resp_body_string(w) == "yum=cheese") }) test_that("httr2 requests with bodies work", { skip_on_cran() enable() stub_registry_clear() z <- stub_request("post", uri = hb("/post")) %>% to_return(body = "asdffsdsdf") req <- request(hb("/post")) %>% req_body_json(list(stuff = "things")) x <- req_perform(req) expect_true(httr2::resp_body_string(x) == "asdffsdsdf") # now with allow net connect stub_registry_clear() httr2_mock(FALSE) webmockr_allow_net_connect() req <- request(hb("/post")) %>% req_body_json(list(stuff = "things")) x <- req_perform(req) expect_identical(httr2::resp_body_json(x)$json, list(stuff = "things")) webmockr_disable_net_connect() }) disable() test_that("httr2 requests with nested list bodies work", { skip_on_cran() enable() # httr_mock() stub_registry_clear() body <- list(id = " ", method = "x", params = list(pwd = "p", user = "a")) z <- stub_request("post", uri = hb("/post")) %>% wi_th(body = body) %>% to_return(body = "asdffsdsdf") x <- request(hb("/post")) %>% req_body_json(body) %>% req_perform() expect_true(rawToChar(x$body) == "asdffsdsdf") # now with allow net connect stub_registry_clear() webmockr_allow_net_connect() response_real <- request(hb("/post")) %>% req_body_json(body) %>% req_perform() expect_equal( jsonlite::fromJSON(rawToChar(response_real$body))$json, body ) webmockr_disable_net_connect() }) webmockr/tests/testthat/test-pluck_body.R0000644000176200001440000000432114752052374020331 0ustar liggesuserscontext("pluck_body") test_that("pluck_body: crul", { # prep objects # con <- crul::HttpClient$new("https://httpbin.org") # upload_list <- list(y = crul::upload(system.file("CITATION"))) # b <- con$post("post", body = upload_list) # crul_body_upload_list <- b$request # crul_body_upload_list$url$handle <- NULL # save(crul_body_upload_list, # file = "tests/testthat/crul_body_upload_list.rda", version = 2) # upload_no_list <- crul::upload(system.file("CITATION")) # d <- con$post("post", body = upload_no_list) # crul_body_upload_no_list <- d$request # crul_body_upload_no_list$url$handle <- NULL # save(crul_body_upload_no_list, # file = "tests/testthat/crul_body_upload_no_list.rda", version = 2) # upload in a list load("crul_body_upload_list.rda") expect_is(pluck_body(crul_body_upload_list), "list") # upload not in a list load("crul_body_upload_no_list.rda") expect_is(pluck_body(crul_body_upload_no_list), "character") expect_match(pluck_body(crul_body_upload_no_list), "file size") }) test_that("pluck_body: httr", { # prep objects # upload_list <- list(y = httr::upload_file(system.file("CITATION"))) # b <- httr::POST("https://httpbin.org/post", body = upload_list) # httr_body_upload_list <- b$request # save(httr_body_upload_list, # file = "tests/testthat/httr_body_upload_list.rda", version = 2) # upload_no_list <- httr::upload_file(system.file("CITATION")) # d <- httr::POST("https://httpbin.org/post", body = upload_no_list) # httr_body_upload_no_list <- d$request # save(httr_body_upload_no_list, # file = "tests/testthat/httr_body_upload_no_list.rda", version = 2) # upload in a list load("httr_body_upload_list.rda") expect_is(pluck_body(httr_body_upload_list), "list") # upload not in a list load("httr_body_upload_no_list.rda") expect_is(pluck_body(httr_body_upload_no_list), "character") expect_match(pluck_body(httr_body_upload_no_list), "file size") }) test_that("pluck_body fails well", { expect_error(pluck_body(5), "not a valid") expect_error(pluck_body(mtcars), "not a valid") expect_error(pluck_body(FALSE), "not a valid") expect_error( pluck_body(list(url = "adf", method = 3, options = 5)), "not a valid" ) }) webmockr/tests/testthat/test-webmockr_reset.R0000644000176200001440000000170114113773445021210 0ustar liggesuserscontext("webmockr_reset") stub_registry_clear() request_registry_clear() enable() test_that("webmockr_reset works", { # before any stubs creatd expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) expect_null(webmockr_reset()) expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) # after a stub creatd stub_request("get", "https://scottchamberlain.info") crul::HttpClient$new("https://scottchamberlain.info")$get() expect_equal(length(stub_registry()$request_stubs), 1) expect_equal(length(request_registry()$request_signatures$hash), 1) webmockr_reset() expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) }) test_that("webmockr_reset fails well", { expect_error(webmockr_reset(4), "unused argument") }) disable() webmockr/tests/testthat/test-auth_handling.R0000644000176200001440000000247114752052374021007 0ustar liggesusers# from https://github.com/ropensci/webmockr/issues/108 # httr stub_registry()$remove_all_request_stubs() skip_if_not_installed("httr") library("httr") enable("httr") test_that("auth handling: httr", { stub_request("get", "http://stuff.com") # auth well-formed expect_is( GET("http://stuff.com", authenticate("adf", "adf")), "response" ) # user name invalid according to RFC, but we can't know that expect_is( GET("http://stuff.com", authenticate("foo:bar", "adf")), "response" ) # malformed: url as username expect_error( GET("http://stuff.com", authenticate("http://", "foo.com")) ) }) # crul disable() stub_registry()$remove_all_request_stubs() skip_if_not_installed("crul") library("crul") enable("crul") test_that("auth handling: httr", { stub_request("get", "http://stuff.com") # auth well-formed x <- HttpClient$new("http://stuff.com") x$auth <- auth("adf", "adf") expect_is(x$get(), "HttpResponse") # user name invalid according to RFC, but we can't know that y <- HttpClient$new("http://stuff.com") y$auth <- auth("foo:bar", "adf") expect_is(y$get(), "HttpResponse") # malformed: url as username z <- HttpClient$new("http://stuff.com") z$auth <- auth("http://", "foo.com") expect_error(z$get()) }) stub_registry()$remove_all_request_stubs() disable() webmockr/tests/testthat/httr_body_upload_no_list.rda0000644000176200001440000000257414113773445022667 0ustar liggesusersXmo6%Y4ov&Cl(:hvMaȇu+! ~3dʒ$پ??t_ xQ)q 0"w}!D!Ee?5Y{{EA;xVz#B1Y^|, ?4ڮ' e%=|߱{Vd{cw#zg#8t3F;JW]kDC џzԏkFԍ}ʾ/RQ`q;Łc>1vkx 0}!IDS-DY_ S/xGƀ? d`#S^hh:8k|vxŷ\BK)oEC;JL\ϱP2[x3ubdF_Mxq 6f U)hj}dEaLAnSZD8R^-NJ[Zg~@$ndZu\aڥ\}};WfVir=$0ߠ3B]DL/3YűMj# vm&l6}cF`eBh6A##c[@+?qaE=4+%5;4qD뗨vA ʥd^)14WVK:) =Rծ-S-'V uhy%axIIJh UZItIqDQw{Ž扰6R,;K%^q" %F99gy&[*9E6y? l+.(]Կ!fgA{/H~ki6_ 6]1EU\,rK)S&H{&X[uȂAHn>`|`S|0%p N25~h4Ug`륦kٰh؉WG{qQ xS`L9J cd@ʘz C\RwSZfv]׬zw&^g73z -}#rԳd.H>$?W؉l rf"L"`_>m`bNή6Ԑt %3M~rsv]<Քi'Jx79Ζ'㚳9&sep=i! Fz?5i`G3#/8-˜d\ !!webmockr/tests/testthat/test-to_return_body.R0000644000176200001440000000372114752052374021237 0ustar liggesuserscontext("to_return: response body types behave correctly for crul pkg") test_that("to_return: setting body behaves correctly", { enable() stub_registry_clear() # character aa <- stub_request("get", "https://google.com") %>% to_return(body = '{"foo":"bar"}') z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), '{"foo":"bar"}') stub_registry_clear() # cleanup # list bb <- stub_request("get", "https://google.com") %>% to_return(body = list(foo = "bar")) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), '{"foo":"bar"}') stub_registry_clear() # cleanup # NULL cc <- stub_request("get", "https://google.com") %>% to_return(body = NULL) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), "") stub_registry_clear() # cleanup # FALSE dd <- stub_request("get", "https://google.com") %>% to_return(body = FALSE) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), "") stub_registry_clear() # cleanup # raw ee <- stub_request("get", "https://google.com") %>% to_return(body = charToRaw('{"foo":"bar"}')) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), '{"foo":"bar"}') stub_registry_clear() # cleanup }) test_that("to_return: setting body with wrong type errors well", { stub_registry_clear() ## ERRORS when not of right type expect_error( stub_request("get", "https://google.com") %>% to_return(body = TRUE), "Unknown `body` type" ) }) webmockr/tests/testthat/test-b-no-cassette-in-use.R0000644000176200001440000000104514715656454022050 0ustar liggesuserscontext("no_cassette_in_use") test_that("no cassette in use behaves as expected", { skip_if_not_installed("vcr") library("vcr") dir <- tempdir() invisible(vcr_configure(dir = dir)) crul::mock() x <- crul::HttpClient$new(url = hb()) # when no cassette in use, we get expected vcr error expect_error( x$get("get"), "There is currently no cassette in use" ) # cleanup unlink(file.path(vcr_configuration()$dir, "turtle.yml")) # reset configuration vcr_configure_reset() # unload vcr unloadNamespace("vcr") }) webmockr/tests/testthat/httr_obj.rda0000644000176200001440000000051114715656454017406 0ustar liggesusers]Q=O0t!nLYXb_bC#n6)m!?8N\^w>߽{xϒy PP(s/CǶtmLH\˄\n9fNeQ]pFqaɮ*Fdhce m*|XfF ?I*o]sgx֑GKL%Ww (tL@\wYnq*ElaYFd'@| t uw1ojt sэiM}X·u-HSwebmockr/tests/testthat/test-RequestSignature.R0000644000176200001440000000332514752052374021513 0ustar liggesuserscontext("RequestSignature") test_that("RequestSignature: works", { expect_is(RequestSignature, "R6ClassGenerator") aa <- RequestSignature$new(method = "get", uri = hb("/get")) expect_is(aa, "RequestSignature") expect_null(aa$auth) expect_null(aa$body) expect_null(aa$headers) expect_null(aa$proxies) expect_null(aa$fields) expect_null(aa$output) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, hb("/get")) expect_is(aa$to_s, "function") expect_equal(aa$to_s(), sprintf("GET: %s", hb("/get"))) }) test_that("RequestSignature: with bodies work", { aa <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = "abc") ) expect_output(print(aa), "") bb <- RequestSignature$new( method = "get", uri = hb("/get"), options = list(body = list(some_thing = "abc")) ) expect_no_match(capture.output(print(bb)), "") }) test_that("RequestSignature: different methods work", { aa <- RequestSignature$new( method = "post", uri = hb("/post"), options = list(fields = list(foo = "bar")) ) 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") expect_is(aa$fields, "list") expect_named(aa$fields, "foo") }) 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/crul_body_upload_list.rda0000644000176200001440000000062214113773445022147 0ustar liggesusersuRKK@NҀ(1O[P( Hoalmv`㏯n^asmjkF_tC=u6P)q=dnKB%{dz8)9ny/$Z`#D]+-_ìx{j۩X|\xS{b~R[a==H0B,7NFVB%j%>&SddI`!#+C0% to_return(body = "success!", status = 200) invisible( crul::HttpClient$new(url = hb())$get("get") ) disable() x <- request_registry() expect_is(x, "RequestRegistry") expect_is(x$clone, "function") expect_is(x$print, "function") expect_is(x$register_request, "function") expect_null(x$request) expect_is(x$request_signatures, "HashCounter") expect_is(x$reset, "function") expect_is(x$request_signatures$hash, "list") expect_match(names(x$request_signatures$hash), "GET") expect_is(x$request_signatures$hash[[1]]$count, "numeric") }) webmockr/tests/testthat/test-stub_body_diff.R0000644000176200001440000000307714752052374021167 0ustar liggesuserstest_that("stub_body_diff throws error when no stubs OR requests found", { request_registry_clear() stub_registry_clear() expect_error(stub_body_diff()) }) test_that("stub_body_diff throws error when a stub is found but a request is not found", { request_registry_clear() stub_registry_clear() stub_request("get", "https://hb.opencpu.org/get") expect_error(stub_body_diff()) }) test_that("stub_body_diff throws error when no stub is found but a request is found", { request_registry_clear() stub_registry_clear() crul::ok("https://nytimes.com") expect_error(stub_body_diff()) }) test_that("stub_body_diff works when both stub AND request are found, no diff found", { request_registry_clear() stub_registry_clear() enable() stub_request("head", "https://nytimes.com") crul::ok("https://nytimes.com") body_diff <- stub_body_diff() expect_s4_class(body_diff, "Diff") expect_equal(attr(body_diff@diffs, "meta")$diffs[2], 0) }) ### WRITE THE TEST FOR A DIFFERENCE FOND test_that("stub_body_diff works when both stub AND request are found, & there's a diff", { request_registry_clear() stub_registry_clear() enable() stub_request("post", "https://hb.opencpu.org/post") %>% wi_th(body = list(apple = "green")) library(crul) expect_error( HttpClient$new("https://hb.opencpu.org")$post( path = "post", body = list(apple = "red") ), "disabled" ) body_diff <- stub_body_diff() expect_s4_class(body_diff, "Diff") expect_gt(attr(body_diff@diffs, "meta")$diffs[2], 0) }) request_registry_clear() stub_registry_clear() webmockr/tests/testthat/test-last_request.R0000644000176200001440000000056314715656454020725 0ustar liggesuserstest_that("last_request works when no requests found", { request_registry_clear() expect_null(last_request()) }) test_that("last_request works when requests are found", { request_registry_clear() enable() stub_request("head", "https://nytimes.com") crul::ok("https://nytimes.com") last_request() expect_s3_class(last_request(), "RequestSignature") }) webmockr/tests/testthat/test-writing-to-disk-write_disk_path.R0000644000176200001440000000651214715656454024423 0ustar liggesuserscontext("write_disk_path behavior") # crul test_that("with crul", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") dir <- tempdir() invisible(vcr_configure(dir = dir)) library(crul) f <- tempfile(fileext = ".json") webmockr_net_connect_allowed() # path not set expect_error( suppressWarnings(use_cassette("write_disk_path_not_set_crul_error", { out <- HttpClient$new(hb("/get"))$get(disk = f) })), "write_disk_path must be given" ) # now set path wdp <- file.path(dir, "files") invisible(vcr_configure(dir = dir, write_disk_path = wdp)) expect_error( use_cassette("write_disk_path_not_set_crul_noerror", { out <- HttpClient$new(hb("/get"))$get(disk = f) }), NA ) # cleanup unlink(f) unlink(wdp, TRUE) unlink(file.path(dir, "write_disk_path_not_set_crul_error.yml")) unlink(file.path(dir, "write_disk_path_not_set_crul_noerror.yml")) webmockr_disable_net_connect() unloadNamespace("vcr") }) test_that("if relative path set its not expanded to full path anymore", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") dir <- tempdir() f <- "stuff.json" wdp <- "../files" invisible(vcr_configure(dir = dir, write_disk_path = wdp)) og <- getwd() setwd(dir) on.exit(setwd(og)) expect_error( use_cassette("write_disk_path_is_relative", { out <- HttpClient$new(hb("/get?foo=foo"))$get(disk = f) }), NA ) txt <- readLines(file.path(dir, "write_disk_path_is_relative.yml")) expect_true(any(grepl("../files/stuff.json", txt))) # cleanup # unlink("files", recursive = TRUE) unlink("stuff.json") webmockr_disable_net_connect() unloadNamespace("vcr") }) # httr test_that("with httr", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") enable() dir <- tempdir() invisible(vcr_configure(dir = dir)) library(httr) f <- tempfile(fileext = ".json") webmockr_net_connect_allowed() # path not set expect_error( suppressWarnings(use_cassette("write_disk_path_not_set_crul_error", { out <- GET(hb("/get"), write_disk(f)) })), "write_disk_path must be given" ) # now set path f <- tempfile(fileext = ".json") wdp <- file.path(dir, "files") invisible(vcr_configure(dir = dir, write_disk_path = wdp)) expect_error( use_cassette("write_disk_path_not_set_crul_noerror", { out <- GET(hb("/get"), write_disk(f)) }), NA ) # cleanup unlink(f) unlink(wdp, TRUE) unlink(file.path(dir, "write_disk_path_not_set_crul_error.yml")) unlink(file.path(dir, "write_disk_path_not_set_crul_noerror.yml")) webmockr_disable_net_connect() unloadNamespace("vcr") }) test_that("if relative path set its not expanded to full path anymore: httr", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") dir <- tempdir() f <- "stuff.json" wdp <- "../files" invisible(vcr_configure(dir = dir, write_disk_path = wdp)) og <- getwd() setwd(dir) on.exit(setwd(og)) expect_error( use_cassette("write_disk_path_is_relative", { out <- GET(hb("/get?foo=foo"), write_disk(f)) }), NA ) txt <- readLines(file.path(dir, "write_disk_path_is_relative.yml")) expect_true(any(grepl("../files/stuff.json", txt))) # cleanup # unlink("files", recursive = TRUE) unlink("stuff.json") webmockr_disable_net_connect() unloadNamespace("vcr") }) webmockr/tests/testthat/test-to_return.R0000644000176200001440000001572514752052374020231 0ustar liggesuserscontext("to_return: works as expected") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) aa <- stub_request("get", hb("/get")) %>% to_return(status = 200, body = "stuff", headers = list(a = 5)) test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, hb("/get")) # to_return expected stuff expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "a") expect_equal(aa$response_headers$a, 5) expect_is(aa$responses_sequences, "list") expect_identical( sort(names(aa$responses_sequences[[1]])), sort(c( "status", "body", "headers", "body_raw", "timeout", "raise", "exceptions" )) ) expect_equal(aa$responses_sequences[[1]]$status, 200) expect_equal(aa$responses_sequences[[1]]$body, "stuff") }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(to_return(), "argument \".data\" is missing") expect_error(to_return(5), "must be of class StubbedRequest") # status zzz <- stub_request("get", hb("/get")) expect_error( sw(to_return(zzz, status = "foo")), "must be of class numeric" ) # headers zzz <- stub_request("get", hb("/get")) expect_error( sw(to_return(zzz, headers = list(5, 6))), "'headers' must be a named list" ) zzz <- stub_request("get", hb("/get")) expect_error( sw(to_return(zzz, headers = list(a = 5, 6))), "'headers' must be a named list" ) zzz <- stub_request("get", hb("/get")) expect_error( sw(to_return(zzz, .list = 4)), "must be of class list" ) }) stub_registry_clear() enable() context("to_return: response headers returned all lowercase") test_that("to_return (response) headers are all lowercase, crul", { stub <- stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = "baz")) cli <- crul::HttpClient$new(url = hb()) x <- cli$get("get") expect_is(x$response_headers, "list") expect_named(x$response_headers, "foo-bar") }) stub_registry_clear() test_that("to_return (response) headers are all lowercase, httr", { loadNamespace("httr") stub <- stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = "baz")) x <- httr::GET(hb("/get")) expect_is(x$headers, "list") expect_named(x$headers, "foo-bar") }) disable() stub_registry_clear() enable() test_that("to_return (response) headers are all lowercase, httr2", { skip_if_not_installed("httr2") loadNamespace("httr2") stub <- stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = "baz")) req <- httr2::request(hb("/get")) x <- httr2::req_perform(req) expect_is(x$headers, "httr2_headers") expect_named(x$headers, "foo-bar") }) disable() stub_registry_clear() enable() test_that("to_return (response) header is the correct class, httr2", { skip_if_not_installed("httr2") loadNamespace("httr2") stub <- stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = "baz")) req <- httr2::request(hb("/get")) x <- httr2::req_perform(req) expect_is(x$headers, "httr2_headers") }) disable() stub_registry_clear() enable() context("to_return: response header values are all character") test_that("to_return response header values are all character, crul", { cli <- crul::HttpClient$new(url = hb()) stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = 10)) x <- cli$get("get") expect_is(x$response_headers, "list") expect_named(x$response_headers, "foo-bar") expect_is(x$response_headers$`foo-bar`, "character") expect_equal(x$response_headers$`foo-bar`, "10") stub_registry_clear() stub_request(uri = hb("/get")) %>% to_return(headers = list( a = 10, b = 234233434, c = 2344.342342, d = "brown", e = as.factor("blue") )) z <- cli$get("get") expect_is(z$response_headers, "list") expect_named(z$response_headers, letters[1:5]) invisible( vapply(z$response_headers, function(z) expect_is(z, "character"), "") ) expect_equal(z$response_headers$c, "2344.342342") expect_equal(z$response_headers$e, "blue") }) stub_registry_clear() test_that("to_return response header values are all character, httr", { loadNamespace("httr") stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = 10)) x <- httr::GET(hb("/get")) expect_is(x$headers, "list") expect_named(x$headers, "foo-bar") expect_is(x$headers$`foo-bar`, "character") expect_equal(x$headers$`foo-bar`, "10") stub_registry_clear() stub_request(uri = hb("/get")) %>% to_return(headers = list( a = 10, b = 234233434, c = 2344.342342, d = "brown", e = as.factor("blue") )) z <- httr::GET(hb("/get")) expect_is(z$headers, "list") expect_named(z$headers, letters[1:5]) invisible( vapply(z$headers, function(z) expect_is(z, "character"), "") ) expect_equal(z$headers$c, "2344.342342") expect_equal(z$headers$e, "blue") }) disable() enable() test_that("to_return response header values are all character, httr2", { skip_if_not_installed("httr2") loadNamespace("httr2") stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = 10)) req <- httr2::request(hb("/get")) x <- httr2::req_perform(req) expect_is(x$headers, "httr2_headers") expect_named(x$headers, "foo-bar") expect_is(x$headers$`foo-bar`, "character") expect_equal(x$headers$`foo-bar`, "10") stub_registry_clear() stub_request(uri = hb("/get")) %>% to_return(headers = list( a = 10, b = 234233434, c = 2344.342342, d = "brown", e = as.factor("blue") )) req <- httr2::request(hb("/get")) z <- httr2::req_perform(req) expect_is(z$headers, "httr2_headers") expect_named(z$headers, letters[1:5]) invisible( vapply(z$headers, function(z) expect_is(z, "character"), "") ) expect_equal(z$headers$c, "2344.342342") expect_equal(z$headers$e, "blue") }) disable() context("to_return_: defunct") test_that("to_return_: defunct", { expect_error(to_return_(), "to_return", class = "error") }) stub_to_return_status_code <- function() { stub_registry()$request_stubs[[1]]$responses_sequences[[1]]$status } stub_registry_clear() enable() test_that("stub_request status accepts numeric or integer values", { stub_status_type_a <- stub_request("get", hb("/get")) expect_s3_class(to_return(stub_status_type_a, status = 200), "StubbedRequest") expect_type(stub_to_return_status_code(), "double") # numeric = double stub_registry_clear() stub_status_type_b <- stub_request("get", hb("/get")) expect_s3_class(to_return(stub_status_type_b, status = 200L), "StubbedRequest") expect_type(stub_to_return_status_code(), "integer") }) disable() webmockr/tests/testthat/test-zutils.R0000644000176200001440000001512414752052374017533 0ustar liggesuserscontext("util fxns: normalize_uri") test_that("normalize_uri", { # prunes trailing slash expect_is(normalize_uri("example.com/"), "character") expect_match(normalize_uri("example.com/"), "example.com") # prunes ports 80 and 443 expect_match(normalize_uri("example.com:80"), "example.com") expect_match(normalize_uri("example.com:443"), "example.com") # escapes special characters expect_match( normalize_uri("example.com/foo/bar"), "example.com/foo%2Fbar" ) expect_match( normalize_uri("example.com/foo+bar"), "example.com/foo%2Bbar" ) expect_match( normalize_uri("example.com/foo*bar"), "example.com/foo%2Abar" ) }) context("util fxns: net_connect_explicit_allowed") test_that("net_connect_explicit_allowed", { aa <- net_connect_explicit_allowed( allowed = "example.com", uri = "http://example.com" ) expect_is(aa, "logical") expect_equal(length(aa), 1) # works with lists expect_true( net_connect_explicit_allowed( list("example.com", "foobar.org"), "example.com" ) ) expect_false( net_connect_explicit_allowed( list("example.com", "foobar.org"), "stuff.io" ) ) # no uri passed, returns FALSE expect_false(net_connect_explicit_allowed("google.com")) # empty character string uri passed, returns FALSE expect_false(net_connect_explicit_allowed("google.com", "")) # no allowed passed, errors expect_error( net_connect_explicit_allowed(), "argument \"allowed\" is missing" ) }) context("util fxns: webmockr_net_connect_allowed") test_that("webmockr_net_connect_allowed", { # works with character strings expect_false(webmockr_net_connect_allowed("example.com")) expect_false(webmockr_net_connect_allowed("http://example.com")) expect_false(webmockr_net_connect_allowed("https://example.com")) # no uri passed, returns FALSE expect_false(webmockr_net_connect_allowed()) # nonense passed, returns FALSE expect_false(webmockr_net_connect_allowed("")) expect_false(webmockr_net_connect_allowed("asdfadfafsd")) # errors when of wrong class expect_error( webmockr_net_connect_allowed(mtcars), "class character or list" ) }) context("util fxns: webmockr_disable_net_connect") test_that("webmockr_disable_net_connect", { # nothing passed expect_null(sm(webmockr_disable_net_connect())) expect_message(webmockr_disable_net_connect(), "net connect disabled") # single uri passed expect_message(webmockr_disable_net_connect("google.com"), "net connect disabled") expect_is(sm(webmockr_disable_net_connect("google.com")), "character") expect_equal(sm(webmockr_disable_net_connect("google.com")), "google.com") # many uri's passed expect_message( webmockr_disable_net_connect(c("google.com", "nytimes.com")), "net connect disabled" ) expect_is( sm(webmockr_disable_net_connect(c("google.com", "nytimes.com"))), "character" ) expect_equal( sm(webmockr_disable_net_connect(c("google.com", "nytimes.com"))), c("google.com", "nytimes.com") ) # errors when of wrong class expect_error( webmockr_disable_net_connect(5), "class character" ) expect_error( webmockr_disable_net_connect(mtcars), "class character" ) }) context("util fxns: webmockr_allow_net_connect") test_that("webmockr_allow_net_connect", { # first call, sets to TRUE, and returns message # nothing passed expect_message(z <- webmockr_allow_net_connect(), "net connect allowed") expect_true(z) # check if net collect allowed afterwards, should be TRUE expect_true(webmockr_net_connect_allowed()) # errors when an argument passed expect_error(webmockr_allow_net_connect(5), "unused argument") }) context("config options: show_stubbing_instructions") test_that("show_stubbing_instructions", { enable() x <- crul::HttpClient$new("https://hb.opencpu.org/get") # DO show stubbing instructions webmockr_configure(show_stubbing_instructions = TRUE) err_mssg <- as.character(tryCatch(x$get(), error = function(e) e)) expect_true(grepl("snippet", err_mssg, perl = TRUE)) # DO NOT show stubbing instructions webmockr_configure(show_stubbing_instructions = FALSE) err_mssg <- as.character(tryCatch(x$get(), error = function(e) e)) expect_false(grepl("^((?!snippet).)*$", err_mssg, perl = TRUE)) # reset to default webmockr_configure(show_stubbing_instructions = TRUE) disable() }) context("util fxns: webmockr_configuration") test_that("webmockr_configuration", { expect_is(webmockr_configuration(), "webmockr_config") expect_named( webmockr_configuration(), c( "show_stubbing_instructions", "show_body_diff", "allow", "allow_net_connect", "allow_localhost" ) ) # errors when an argument passed expect_error(webmockr_configuration(5), "unused argument") }) context("util fxns: webmockr_configure_reset") test_that("webmockr_configure_reset", { # webmockr_configure_reset does the same thing as webmockr_configure expect_identical(webmockr_configure(), webmockr_configure_reset()) # errors when an argument passed expect_error(webmockr_configure_reset(5), "unused argument") }) context("util fxns: defunct") test_that("webmockr_disable", { expect_error(webmockr_disable(), "disable", class = "error") }) test_that("webmockr_enable", { expect_error(webmockr_enable(), "enable", class = "error") }) context("util fxns: hdl_lst") test_that("hdl_lst works", { expect_equal(hdl_lst(NULL), "") expect_equal(hdl_lst(character(0)), "") expect_equal(hdl_lst(raw(0)), "") expect_equal(hdl_lst(raw(5)), "raw bytes, length: 5") expect_error(hdl_lst(), "argument \"x\" is missing") expect_equal(hdl_lst(list(foo = "bar")), "foo=bar") expect_equal(hdl_lst(list(foo = "5")), "foo=5") expect_equal(hdl_lst(list(foo = "5", bar = "a")), "foo=5, bar=a") expect_equal(hdl_lst(1.5), 1.5) }) context("util fxns: hdl_lst2") test_that("hdl_lst2 works", { expect_equal(hdl_lst2(NULL), "") expect_equal(hdl_lst2(character(0)), "") expect_equal(hdl_lst2(raw(5)), "") expect_equal(hdl_lst2(charToRaw("hello")), "hello") expect_error(hdl_lst2(), "argument \"x\" is missing") expect_equal(hdl_lst2(list(foo = "bar")), "foo=\"bar\"") expect_equal(hdl_lst2(list(foo = 5)), "foo=5") expect_equal(hdl_lst2(list(foo = 5, bar = "a")), "foo=5, bar=\"a\"") expect_equal(hdl_lst2(list(foo = "bar", stuff = FALSE)), "foo=\"bar\", stuff=FALSE") expect_equal(hdl_lst2(1.5), 1.5) }) context("query_mapper") test_that("query_mapper", { expect_is(query_mapper, "function") expect_null(query_mapper(NULL)) expect_equal(query_mapper(5), 5) expect_equal(query_mapper("aaa"), "aaa") expect_equal(query_mapper(mtcars), mtcars) }) webmockr/tests/testthat/test-last_stub.R0000644000176200001440000000043314715656454020206 0ustar liggesuserstest_that("last_stub works when no stubs found", { stub_registry_clear() expect_null(last_stub()) }) test_that("last_stub works when stubs are found", { stub_registry_clear() stub_request("head", "https://nytimes.com") expect_s3_class(last_stub(), "StubbedRequest") }) webmockr/tests/testthat/httr_obj_auth.rda0000644000176200001440000000056214715656454020435 0ustar liggesusers]QN0t*$~TV BqGzmR ;Hj"<z J%k_04E__;еrP@iILlQeF0fBazg<#XeD;HуB"w0F~ *;jN\O<;Fa]YBV-\ڀ&=~fe5*ZVP:В jSkZsS~B{1>YX:<ۋLѸ_ 6.u.Oi+J[(^S!o|q[ׅ,V샖δZM}褠VEwebmockr/tests/testthat/test-stub_request.R0000644000176200001440000000247314752052374020731 0ustar liggesuserscontext("stub_request") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) aa <- stub_request("get", hb("/get")) test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$query) expect_null(aa$request_headers) 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, hb("/get")) expect_is(aa$print, "function") expect_output(aa$print(), "") expect_is(aa$to_return, "function") expect_error(aa$to_return(), "argument \"body\" is missing") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), sprintf("GET: %s", hb("/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/test-all.R0000644000176200001440000000005314113773445015104 0ustar liggesuserslibrary("testthat") test_check("webmockr") webmockr/MD50000644000176200001440000002043014752731512012401 0ustar liggesusers16b51993a0ae4b4a764d0ba159974edb *DESCRIPTION aed2f6fd7c66d41e23923b84acb5f26b *LICENSE 362054e7d6cab7809590afabb7830d06 *NAMESPACE 0ea83b5f9b99f49ac5899185314b36da *NEWS.md 4bc3592f7db7ad2a6c5ea8888e0a1550 *R/HttpLibAdapterRegistry.R 232926b1d2c88b9743530e144230d11b *R/RequestPattern.R 43e7261f4f1339f9fa31ee8eaff66686 *R/RequestRegistry.R 5b5a2703a94079e10cf94b9366470e9c *R/RequestSignature.R e7c345e92ed4a6e6f5ae60c31f22ba2e *R/Response.R 6e756f5cdd2e75e7a5b4272a63bab523 *R/StubRegistry.R 05e572c74e66ac6e01a735d075422c55 *R/StubbedRequest.R 774842d27dae5107a73e45f358c7cb2a *R/adapter-crul.R 903d0185796d9a648a836d81fe9004f9 *R/adapter-httr.R e0e4d85a20547aff55e916270b61f505 *R/adapter-httr2.R 6edd71d86d6d3b5f3a3914f3fd941cb7 *R/adapter.R c106024d861656a99ed8fae3c1620c94 *R/defunct.R 64ed19689c22021a6a97f1b3e21d57dd *R/error-handling.R f02ee92c2a5e4d984a351a491a196197 *R/flipswitch.R d64d3ea6fde479b3e3a7c4114d7abb63 *R/globals.R b66973cc47fb9eea55871a44907e4570 *R/headers.R 1c957057e7bb4cc4ab94871d4fcbec9d *R/last.R cb69b3d0c23dce6e20b1f66ce91aed19 *R/mock_file.R 3b9c50c13b27112c20ae044cc5525fc9 *R/mocking-disk-writing.R 58c0d470ed1db51c40c7bcb8e7a45e19 *R/onload.R a308e4812eec1f3098429bbc705e4298 *R/partial.R f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/pipe.R b7392399adcd93f7ed24ca8505b3ef5c *R/pluck_body.R daeed7760bd653cd52477e791314d4cb *R/query_mapper.R 56db156253368fd808bb2fa279befede *R/remove_request_stub.R 1591fbffccf0e3dccd11091bf116ab35 *R/request_is_in_cache.R cf8659bf9704ada5fee104f0db5c04c8 *R/request_registry.R 69927bbc94c43565d5037d7cc50e5037 *R/stub_body_diff.R 438dff69cc7d81704acee6654dfb38f1 *R/stub_registry.R 625bcfa5857f8355a4dee3d16fc603c3 *R/stub_registry_clear.R 8ba380285204fc558b88a20dd3b51042 *R/stub_request.R 4f2da1ca065937b2e72c4779ffd3d252 *R/to_raise.R 4a7be91db6d472c0bdeaff4ff99453e2 *R/to_return.R dca6a47767b6cb027f9fffa4fee1d6e5 *R/to_timeout.R 07d2ef280ac25011db04f804c1fca3bb *R/webmockr-opts.R 41a6ff9f91f338da26c22fd2826714a6 *R/webmockr-package.R 4aca567a1967f684b74a9ea5be84d7ff *R/webmockr_reset.R df8189e823682cfd59228ccc346f7995 *R/wi_th.R ead214320bcfb43ac82f9bc63de78ddb *R/zzz.R bfab6207f448fab82e6cd42ebc3abbf2 *inst/ignore/adapter-httr.R c2dad18498a5fbbfa1ad2b9618072bcb *inst/ignore/sockets.R f297d52d7dac5a674d54e8056ee571dd *man/Adapter.Rd 8268b6b252aa8c7e8dab386d733f2503 *man/BodyPattern.Rd 7fd0badad2fc9a9e9f35d4d672b5c19e *man/HashCounter.Rd dc221206c2db00a5872c25b865eeb9dc *man/HeadersPattern.Rd 20a9b2c1e8ee5bc95ba3f919d9d9ab59 *man/HttpLibAdapaterRegistry.Rd b7e221806660cae439fc4c5804ab80e4 *man/MethodPattern.Rd ef1537de2ee420f1fa2e66eacc64f7a1 *man/RequestPattern.Rd 5f27524581c4c722895d159a730c1d4a *man/RequestRegistry.Rd c870d0c6695ae2b6bcb54caa1c6be9af *man/RequestSignature.Rd 28f10c0a7e1f4d94ad9ffcefb3d19df3 *man/Response.Rd 5cbe5328f5ea5c70fb92dcb57a6b0da4 *man/StubCounter.Rd 09e139a29c2cf3ead9b9cf54be452c8b *man/StubRegistry.Rd 510f497a996b58412c484541ec95e444 *man/StubbedRequest.Rd 7a1dc23de78b68c7676565e29270edc4 *man/UriPattern.Rd 58ea5dc971c95c9d289bd2728d429636 *man/build_crul_request.Rd 3150b5130431d33a0854f49107c36124 *man/build_crul_response.Rd 2c7d03b030a56d8d51ba1fc6d2beaa83 *man/build_httr2_request.Rd 701cabde8abe7fb71ea216de4685fc0b *man/build_httr2_response.Rd 0aa38ec0cf479afaa142cbb5fddc2cc9 *man/build_httr_request.Rd cf1087a981502f25b0c28ccaa46c909f *man/build_httr_response.Rd be2d8fb8e0fbf32cac2c93af076f4cc0 *man/enable.Rd 4a99e9a4b14c7976d6b7e3cb09320408 *man/handle_stub_removal.Rd 4e8ba182f5e25e003c84ce9204e73cfe *man/httr2_mock.Rd 794e0b0cfa2eb0a044a228c7b78697de *man/httr_mock.Rd 1fd9a91361335b32011b0d47faa77b4c *man/including.Rd 426735ede0faa797b3ca8331d027f362 *man/last_request.Rd edf287d13cd1c1c6023c2b00bc6e37c2 *man/last_stub.Rd ebfaadcba0c55dafbe78d030064d23e0 *man/mock_file.Rd 8b1b79cf37c390bc77a5ade16b57ed6a *man/mocking-disk-writing.Rd e17f41e959fd90a1736ad0fc8ee7ff81 *man/pipe.Rd c1badf8a25f58a22b931c5fa146a09af *man/pluck_body.Rd 844665795132f45b5af92f1018e856f7 *man/remove_request_stub.Rd e62b1f979c9b89292cc35a9da34b528d *man/request_registry.Rd 860684e21e1383e095a822d22f3ddbf5 *man/stub_body_diff.Rd 3b96ff03cbe89852e97b48fb1621ce90 *man/stub_registry.Rd 37024434d8cbc7eb698fc4b354a207b3 *man/stub_registry_clear.Rd adad666e6acc1bed837a492a120a35fc *man/stub_request.Rd f673db75f0d7cb9f72797159a7b86460 *man/to_raise.Rd 9858bde7bb938a18617649b7fa618127 *man/to_return.Rd 90cbd5a6751fe9042883ffa40fa396d5 *man/to_return_-defunct.Rd b49744ded1577db1eda32787347902fb *man/to_timeout.Rd 6dec78f38272f4437c3b143e9c53c8fc *man/webmockr-defunct.Rd c825b4d5c7c0e4065e7cbc32e1565703 *man/webmockr-package.Rd d33e021b9c8dded42aad12b2be9388b0 *man/webmockr_configure.Rd e5d6b8f058f5f8f0395db6c44148b276 *man/webmockr_crul_fetch.Rd 75b69f3bba04215c723a3d8cc11a9b48 *man/webmockr_disable-defunct.Rd 16199ca3a65851252d381cdcf4e924b1 *man/webmockr_enable-defunct.Rd a9880e552d3122cb39a5c15fbd590896 *man/webmockr_reset.Rd 280c85dc8cde101f396a566ed0e43510 *man/wi_th.Rd 32740100031047c3073973060764fa4b *man/wi_th_-defunct.Rd 6695b4e11699caab8ba7c936ff9d0778 *tests/test-all.R 9b69fa7ce58021b08f11de7c6412b32e *tests/testthat/crul_body_upload_list.rda 9b6c5be18b4fc24baf77fdff0b7af1d0 *tests/testthat/crul_body_upload_no_list.rda 43e9a3a2f19d982c0919de0490556d0c *tests/testthat/crul_obj.rda 3919db0e3b65ede1f8447e0160af85a8 *tests/testthat/helper-webmockr.R f66c4c48b313693e112868a8ec4c3de5 *tests/testthat/httr2_obj.rda b9ccccd76746b34c0c00e9cf75847789 *tests/testthat/httr2_obj_auth.rda eb5571d890cfb38097090fe789ef84e1 *tests/testthat/httr_body_upload_list.rda b11125facccee9440f7cf052fdaa33b3 *tests/testthat/httr_body_upload_no_list.rda 01962a302aafcada81561813b4ca9945 *tests/testthat/httr_obj.rda 5b0c0e35baa595887f153524030ca240 *tests/testthat/httr_obj_auth.rda e2fb6788f11ae5c5670151e6e1939bdf *tests/testthat/test-Adapter.R 372dde7a878a53d7032c78ba1ebb10e0 *tests/testthat/test-CrulAdapter.R c21feedb5ddc5021e8c42bdfa160f6e6 *tests/testthat/test-HashCounter.R 46a47168a436b2141258e96ed2b4a9f5 *tests/testthat/test-HttpLibAdapaterRegistry.R 1702dbdb522aa8e12f3e3d759e621159 *tests/testthat/test-Httr2Adapter.R 480faab81bddd76bd18514cec8a6653c *tests/testthat/test-HttrAdapter.R f1a4e4e9b1ddfbe4536495c0d8c8ab25 *tests/testthat/test-RequestPattern.R 8c7c2e3fb0a702e3381d2459935c1d80 *tests/testthat/test-RequestRegistry.R 58d0c6140f031fdb5c129e4f46f36bf5 *tests/testthat/test-RequestSignature.R 003a8f10c09aefbbd471080ff5628db8 *tests/testthat/test-Response.R 415d2618497a81c80344fc3f1a27b1d7 *tests/testthat/test-StubRegistry.R da682021d6ceab9a52c451f7f4dd0640 *tests/testthat/test-StubbedRequest.R c736f48de873621555e2cd49db561327 *tests/testthat/test-auth_handling.R d88485b4593713d60abcfa5da03939d5 *tests/testthat/test-b-no-cassette-in-use.R 12dffb7d9424f7c1ea27632890664737 *tests/testthat/test-flipswitch.R d5ddbe9caca06189980795cfa978445c *tests/testthat/test-last_request.R 57f9b85948ec1415a74a64f170154aeb *tests/testthat/test-last_stub.R 7504a95a33618846ab24aaa7156218e1 *tests/testthat/test-onload.R 350f9a5c536d70ae32754ddbc83b105d *tests/testthat/test-partial_matching.R e5a2b1819250b6f400c85c68ae070221 *tests/testthat/test-pluck_body.R 087ceb6aeb62840971d5527faaee6ecb *tests/testthat/test-remove_request_stub.R d6cec4f6ee956956fe39ed769a4eb900 *tests/testthat/test-request_registry.R 1da085ffe7a411c8eef4de49b4ed91b4 *tests/testthat/test-stub_body_diff.R 1fa7af606de4d0c20f9bf7e2f4ac3906 *tests/testthat/test-stub_registry.R 06e07387df6a8f2f3a0b5d1086f51279 *tests/testthat/test-stub_request.R 7475a4ed4c148c7772dacf277729805f *tests/testthat/test-stub_requests_crul.R 2b99b047c2e5573756050164c259ad3a *tests/testthat/test-to_raise.R 3cf634e13662c09262cd1401364ac51b *tests/testthat/test-to_return.R 0ed601e26f95bacabafb092ebc220d73 *tests/testthat/test-to_return_body.R af3de6dc5988a48e9254e6a59ae4db8c *tests/testthat/test-to_return_then.R d4b2014e82efb03253e3584d20d6f14c *tests/testthat/test-to_timeout.R d62144bf039fd56de903eae257a0ece5 *tests/testthat/test-uri_regex.R d164e049e0cd21276673f5138288a41f *tests/testthat/test-webmockr_reset.R d5fc056c8af869521530c2535a8dd7f8 *tests/testthat/test-wi_th.R b6db963ca5dc4a26ed98fc709dc6831a *tests/testthat/test-within_test_that_blocks.R b806feef35400edab033a38e8136f560 *tests/testthat/test-writing-to-disk-write_disk_path.R c924cd9d544a9ad695c747864c933572 *tests/testthat/test-writing-to-disk.R bdfe5b7ab9098f0c2fc1bdba15ae7b4c *tests/testthat/test-zutils.R webmockr/R/0000755000176200001440000000000014752725763012306 5ustar liggesuserswebmockr/R/to_raise.R0000644000176200001440000000355714752052374014237 0ustar liggesusers#' Set raise error condition #' #' @export #' @param .data input. Anything that can be coerced to a `StubbedRequest` #' class object #' @param ... One or more HTTP exceptions from the \pkg{fauxpas} package. Run #' `grep("HTTP*", getNamespaceExports("fauxpas"), value = TRUE)` for a list of #' possible exceptions #' @return an object of class `StubbedRequest`, with print method describing #' the stub #' @section Raise vs. Return: #' `to_raise()` always raises a stop condition, while `to_return(status=xyz)` #' only sets the status code on the returned HTTP response object. So if you #' want to raise a stop condition then `to_raise()` is what you want. But if #' you don't want to raise a stop condition use `to_return()`. Use cases for #' each vary. For example, in a unit test you may have a test expecting a 503 #' error; in this case `to_raise()` makes sense. In another case, if a unit #' test expects to test some aspect of an HTTP response object that httr, #' httr2, or crul typically returns, then you'll want `to_return()`. #' #' @details The behavior in the future will be: #' #' When multiple exceptions are passed, the first is used on the first #' mock, the second on the second mock, and so on. Subsequent mocks use the #' last exception #' #' But for now, only the first exception is used until we get that fixed #' @note see examples in [stub_request()] to_raise <- function(.data, ...) { handle_stub_removal(.data, { assert_is(.data, "StubbedRequest") assert_stub_registered(.data) tmp <- list(...) if (!all(vapply( tmp, function(x) inherits(x, "R6ClassGenerator"), logical(1) ))) { abort("all objects must be error classes from fauxpas") } if (!all(vapply(tmp, function(x) grepl("HTTP", x$classname), logical(1)))) { abort("all objects must be error classes from fauxpas") } .data$to_raise(tmp) }) return(.data) } webmockr/R/adapter-httr2.R0000644000176200001440000000724414752052374015110 0ustar liggesusershttr2_headers <- function(x) { structure(x %||% list(), class = "httr2_headers") } tryx <- function(exp, give = NULL) { z <- tryCatch(exp, error = function(e) e) if (inherits(z, "error")) give else z } #' Build a httr2 response (`httr2_response`) #' @export #' @param req a request #' @param resp a response #' @return an httr2 response (`httr2_response`) #' @examples \dontrun{ #' # x <- Httr2Adapter$new() #' # library(httr2) #' # req <- request("https://r-project.org") #' # req = req %>% req_body_json(list(x = 1, y = 2)) #' # #req$method <- 'POST' #' # stub_request("post", "https://r-project.org") %>% #' # to_return(status = 418, body = list(a = 5)) #' # stub = webmockr_stub_registry$request_stubs[[1]] #' # stub$counter$.__enclos_env__$private$total <- 1 #' # resp = x$.__enclos_env__$private$build_stub_response(stub) #' # resp = x$.__enclos_env__$private$build_response(req, resp) #' # resp = x$.__enclos_env__$private$add_response_sequences(stub, resp) #' # out #' # out$body #' # out$content #' } build_httr2_response <- function(req, resp) { bd <- resp$body %||% resp$content lst <- list( method = req_method_get_w(req), url = tryCatch(resp$url, error = function(e) e) %|s|% req$url, status_code = as.integer( tryx(resp$status_code$status_code) %||% tryx(resp$status_code) %||% resp$status$status_code ), headers = { if (grepl("^ftp://", resp$url %||% "")) { # in case uri_regex only httr2_headers(list()) } else { httr2_headers(resp$headers %||% resp$response_headers) } }, body = tryx(charToRaw(bd)) %||% bd, request = req, cache = new.env() ) structure(lst, class = "httr2_response") } req_method_get_w <- function(req) { if (!is.null(req$method)) { req$method } else if ("nobody" %in% names(req$options)) { "HEAD" } else if (!is.null(req$body)) { "POST" } else { "GET" } } #' Build an httr2 request #' @export #' @param x an unexecuted httr2 request object #' @return a `httr2_request` build_httr2_request <- function(x) { headers <- as.list(x$headers) %||% NULL auth <- check_user_pwd(x$options$userpwd) %||% NULL if (!is.null(auth)) { auth_header <- prep_auth(auth) headers <- c(headers, auth_header) } RequestSignature$new( method = req_method_get_w(x), uri = x$url, options = list( body = x$body$data, headers = headers, proxies = x$proxies %||% NULL, auth = auth, disk = x$disk %||% NULL, fields = x$fields %||% NULL, output = x$output %||% NULL ) ) } #' Turn on `httr2` mocking #' #' Sets a callback that routes `httr2` requests through `webmockr` #' #' @export #' @param on (logical) `TRUE` to turn on, `FALSE` to turn off. default: `TRUE` #' @return Silently returns `TRUE` when enabled and `FALSE` when disabled. httr2_mock <- function(on = TRUE) { check_installed("httr2") if (on) { httr2::local_mocked_responses( ~ Httr2Adapter$new()$handle_request(.x), env = .GlobalEnv ) } else { httr2::local_mocked_responses(NULL, env = .GlobalEnv) options(httr2_mock = NULL) } invisible(on) } #' @rdname Adapter #' @export Httr2Adapter <- R6::R6Class("Httr2Adapter", inherit = Adapter, public = list( #' @field client HTTP client package name client = "httr2", #' @field name adapter name name = "Httr2Adapter" ), private = list( pluck_url = function(request) request$url, mock = function(on) httr2_mock(on), build_request = build_httr2_request, build_response = build_httr2_response, request_handler = function(request) vcr::RequestHandlerHttr2$new(request), fetch_request = function(request) httr2::req_perform(request) ) ) webmockr/R/StubRegistry.R0000644000176200001440000001255514752052374015076 0ustar liggesusers#' @title StubRegistry #' @description stub registry to keep track of [StubbedRequest] stubs #' @export #' @family stub-registry #' @examples \dontrun{ #' # Make a stub #' 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()) #' 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( #' @field request_stubs (list) list of request stubs request_stubs = list(), #' @description print method for the `StubRegistry` class #' @param x self #' @param ... ignored print = function(x, ...) { cat_line(" ") cat_line(" Registered Stubs") for (i in seq_along(self$request_stubs)) { cat_line(" ", self$request_stubs[[i]]$to_s()) } invisible(self$request_stubs) }, #' @description Register a stub #' @param stub an object of type [StubbedRequest] #' @return nothing returned; registers the stub register_stub = function(stub) { self$request_stubs <- Filter(length, c(self$request_stubs, stub)) }, #' @description Find a stubbed request #' @param req an object of class [RequestSignature] #' @return an object of type [StubbedRequest], if matched find_stubbed_request = function(req) { self$request_stubs[self$request_stub_for(req)] }, #' @description Find a stubbed request #' @param request_signature an object of class [RequestSignature] #' @param count (bool) iterate counter or not. default: `TRUE` #' @return logical, 1 or more request_stub_for = function(request_signature, count = TRUE) { stubs <- self$request_stubs mtchs <- 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, basic_auth = z$basic_auth ) tmp$matches(request_signature) }, logical(1)) if (count) { for (i in seq_along(stubs)) { if (mtchs[i]) stubs[[i]]$counter$put(request_signature) } } return(mtchs) }, #' @description Remove a stubbed request by matching request signature #' @param stub an object of type [StubbedRequest] #' @return nothing returned; removes the stub from the registry 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 { abort(c( "This request stub is not registered:", stub$to_s() )) } }, #' @description Remove all request stubs #' @return nothing returned; removes all request stubs remove_all_request_stubs = function() { for (stub in self$request_stubs) { if (inherits(stub, "StubbedRequest")) stub$reset() } self$request_stubs <- list() }, #' @description Find a stubbed request from a request signature #' @param x an object of class [RequestSignature] #' @return nothing returned; registers the stub is_registered = function(x) any(self$request_stub_for(x, count = FALSE)), #' @description Check if a stubbed request is in the stub registry #' @param stub an object of class [StubbedRequest] #' @return single boolean, `TRUE` or `FALSE` is_stubbed = function(stub) { if (!length(self$request_stubs)) { return(FALSE) } any(stub$to_s() %in% vapply(self$request_stubs, \(x) x$to_s(), "")) } ) ) #' @importFrom jsonlite validate json_validate <- function(x) { res <- tryCatch(jsonlite::validate(x), error = function(e) e) if (inherits(res, "error")) { return(FALSE) } res } # make body info for print method make_body <- function(x) { if (is.null(x)) { return("") } if (inherits(x, "mock_file")) x <- x$payload if (inherits(x, c("form_file", "partial"))) x <- unclass(x) clzzes <- vapply(x, function(z) inherits(z, "form_file"), logical(1)) if (any(clzzes)) for (i in seq_along(x)) x[[i]] <- unclass(x[[i]]) if (json_validate(x)) { body <- x } else { body <- jsonlite::toJSON(x, auto_unbox = TRUE) } paste0(" with body ", body) } # make query info for print make_query <- function(x) { if (is.null(x)) { return("") } txt <- paste(names(x), subs(unname(unlist(x)), 20), sep = "=", collapse = ", " ) if (attr(x, "partial_match") %||% FALSE) { txt <- sprintf( "%s(%s)", switch(attr(x, "partial_type"), include = "including", exclude = "excluding" ), txt ) } paste0(" with query params ", txt) } #' make headers info for print method #' @importFrom jsonlite toJSON #' @param x a named list #' @noRd make_headers <- function(x) { if (is.null(x)) { return("") } paste0(" with headers ", jsonlite::toJSON(x, auto_unbox = TRUE)) } # make body info for print method make_status <- function(x) { if (is.null(x)) { return("") } paste0(" with status ", as.character(x)) } webmockr/R/stub_request.R0000644000176200001440000001776214752052374015162 0ustar liggesusers#' 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 or partial uri. #' \pkg{webmockr} can match uri's without the "http" scheme, but does #' not match if the scheme is "https". required, unless `uri_regex` given. #' See [UriPattern] for more. See the "uri vs. uri_regex" section #' @param uri_regex (character) A URI represented as regex. required, if `uri` #' not given. See examples and the "uri vs. uri_regex" section #' @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 #' #' If multiple stubs match the same request, we use the first stub. So if you #' want to use a stub that was created after an earlier one that matches, #' remove the earlier one(s). #' #' Note on `wi_th()`: If you pass `query`, values are coerced to character #' class in the recorded stub. You can pass numeric, integer, etc., but #' all will be coerced to character. #' #' See [wi_th()] for details on request body/query/headers and #' [to_return()] for details on how response status/body/headers #' are handled #' #' @note Trailing slashes are dropped from stub URIs before matching #' #' @section uri vs. uri_regex: #' When you use `uri`, we compare the URIs without query params AND #' also the query params themselves without the URIs. #' #' When you use `uri_regex` we don't compare URIs and query params; #' we just use your regex string defined in `uri_regex` as the pattern #' for a call to [grepl] #' #' @section Mocking writing to disk: #' See [mocking-disk-writing] #' @section Error handling: #' To construct stubs, one uses [stub_request()] first - which registers #' the stub in the stub registry. Any additional calls to modify the stub #' with for example [wi_th()] or [to_return()] can error. In those error #' cases we ideally want to remove (unregister) the stub because you #' certainly don't want a registered stub that is not exactly what you #' intended. #' #' When you encounter an error creating a stub you should see a warning #' message that the stub has been removed, for example: #' #' ``` #' stub_request("get", "https://httpbin.org/get") %>% #' wi_th(query = mtcars) #' #> Error in `wi_th()`: #' #> ! z$query must be of class list or partial #' #> Run `rlang::last_trace()` to see where the error occurred. #' #> Warning message: #' #> Encountered an error constructing stub #' #> • Removed stub #' #> • To see a list of stubs run stub_registry() #' ``` #' #' #' @seealso [wi_th()], [to_return()], [to_timeout()], [to_raise()], #' [mock_file()] #' @examples \dontrun{ #' # basic stubbing #' stub_request("get", "https://httpbin.org/get") #' stub_request("post", "https://httpbin.org/post") #' #' # any method, use "any" #' stub_request("any", "https://httpbin.org/get") #' #' # list stubs #' stub_registry() #' #' # request headers #' stub_request("get", "https://httpbin.org/get") %>% #' wi_th(headers = list("User-Agent" = "R")) #' #' # request body #' stub_request("post", "https://httpbin.org/post") %>% #' wi_th(body = list(foo = "bar")) #' stub_registry() #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' crul::mock() #' x$post("post", body = list(foo = "bar")) #' #' # 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\\..") #' #' # set stub an expectation to timeout #' stub_request("get", "https://httpbin.org/get") %>% to_timeout() #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' res <- x$get("get") #' #' # raise exception #' library(fauxpas) #' stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPAccepted) #' stub_request("get", "https://httpbin.org/get") %>% #' to_raise(HTTPAccepted, HTTPGone) #' #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPBadGateway) #' crul::mock() #' x$get("get") #' #' # pass a list to .list #' z <- stub_request("get", "https://httpbin.org/get") #' wi_th(z, .list = list(query = list(foo = "bar"))) #' #' # just body #' stub_request("any", uri_regex = ".+") %>% #' wi_th(body = list(foo = "bar")) #' ## with crul #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' crul::mock() #' x$post("post", body = list(foo = "bar")) #' x$put("put", body = list(foo = "bar")) #' ## with httr #' library(httr) #' httr_mock() #' POST("https://example.com", body = list(foo = "bar")) #' PUT("https://google.com", body = list(foo = "bar")) #' #' #' # just headers #' headers <- list( #' "Accept-Encoding" = "gzip, deflate", #' "Accept" = "application/json, text/xml, application/xml, */*" #' ) #' stub_request("any", uri_regex = ".+") %>% wi_th(headers = headers) #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org", headers = headers) #' crul::mock() #' x$post("post") #' x$put("put", body = list(foo = "bar")) #' x$get("put", query = list(stuff = 3423234L)) #' #' # many responses #' ## the first response matches the first to_return call, and so on #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(status = 200, body = "foobar", headers = list(a = 5)) %>% #' to_return(status = 200, body = "bears", headers = list(b = 6)) #' con <- crul::HttpClient$new(url = "https://httpbin.org") #' con$get("get")$parse("UTF-8") #' con$get("get")$parse("UTF-8") #' #' ## OR, use times with to_return() to repeat the same response many times #' library(fauxpas) #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(status = 200, body = "apple-pie", times = 2) %>% #' to_raise(HTTPUnauthorized) #' con <- crul::HttpClient$new(url = "https://httpbin.org") #' con$get("get")$parse("UTF-8") #' con$get("get")$parse("UTF-8") #' con$get("get")$parse("UTF-8") #' #' # partial matching #' ## query parameters #' library(httr) #' enable() #' ### matches #' stub_request("get", "https://hb.opencpu.org/get") %>% #' wi_th(query = including(list(fruit = "pear"))) %>% #' to_return(body = "matched on partial query!") #' resp <- GET("https://hb.opencpu.org/get", #' query = list(fruit = "pear", bread = "scone") #' ) #' rawToChar(content(resp)) #' ### doesn't match #' stub_registry_clear() #' stub_request("get", "https://hb.opencpu.org/get") %>% #' wi_th(query = list(fruit = "pear")) %>% #' to_return(body = "didn't match, ugh!") #' # GET("https://hb.opencpu.org/get", #' # query = list(fruit = "pear", meat = "chicken")) #' #' ## request body #' ### matches - including #' stub_request("post", "https://hb.opencpu.org/post") %>% #' wi_th(body = including(list(fruit = "pear"))) %>% #' to_return(body = "matched on partial body!") #' resp <- POST("https://hb.opencpu.org/post", #' body = list(fruit = "pear", meat = "chicken") #' ) #' rawToChar(content(resp)) #' ### matches - excluding #' stub_request("post", "https://hb.opencpu.org/post") %>% #' wi_th(body = excluding(list(fruit = "pear"))) %>% #' to_return(body = "matched on partial body!") #' res <- POST("https://hb.opencpu.org/post", #' body = list(color = "blue") #' ) #' rawToChar(content(res)) #' # POST("https://hb.opencpu.org/post", #' # body = list(fruit = "pear", meat = "chicken")) #' #' # clear all stubs #' stub_registry() #' stub_registry_clear() #' } stub_request <- function(method = "get", uri = NULL, uri_regex = NULL) { if (is_null(uri) && is_null(uri_regex)) { abort("one of uri or uri_regex is required") } tmp <- StubbedRequest$new(method = method, uri = uri, uri_regex = uri_regex) webmockr_stub_registry$register_stub(tmp) return(tmp) } webmockr/R/pipe.R0000644000176200001440000000021314113773445013351 0ustar liggesusers#' Pipe operator #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs NULL webmockr/R/remove_request_stub.R0000644000176200001440000000071714113773445016527 0ustar liggesusers#' 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/to_timeout.R0000644000176200001440000000072114715656454014620 0ustar liggesusers#' Set timeout as an expected return on a match #' #' @export #' @param .data input. Anything that can be coerced to a `StubbedRequest` class #' object #' @return an object of class `StubbedRequest`, with print method describing #' the stub #' @note see examples in [stub_request()] to_timeout <- function(.data) { handle_stub_removal(.data, { assert_is(.data, "StubbedRequest") assert_stub_registered(.data) .data$to_timeout() }) return(.data) } webmockr/R/onload.R0000644000176200001440000000126514715656454013710 0ustar liggesusershttp_lib_adapter_registry <- NULL # nocov start webmockr_stub_registry <- NULL webmockr_request_registry <- NULL .onLoad <- function(libname, pkgname) { # set defaults for webmockr webmockr_configure() # assign crul, httr, and httr2 adapters # which doesn't require those packages loaded yet x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) x$register(HttrAdapter$new()) x$register(Httr2Adapter$new()) http_lib_adapter_registry <<- x # initialize empty stub registry on package load webmockr_stub_registry <<- StubRegistry$new() # initialize empty request registry on package load webmockr_request_registry <<- RequestRegistry$new() } # nocov end webmockr/R/mock_file.R0000644000176200001440000000123014752052374014344 0ustar liggesusers#' Mock file #' #' @export #' @param path (character) a file path. required #' @param payload (character) string to be written to the file given #' at `path` parameter. required #' @return a list with S3 class `mock_file` #' @examples #' mock_file(path = tempfile(), payload = "{\"foo\": \"bar\"}") mock_file <- function(path, payload) { assert_is(path, "character") assert_is(payload, c("character", "json")) structure(list(path = path, payload = payload), class = "mock_file") } #' @export print.mock_file <- function(x, ...) { cat_line("") cat_line(paste0(" path: ", x$path)) cat_line(paste0(" payload: ", substring(x$payload, 1, 80))) } webmockr/R/last.R0000644000176200001440000000223014752052374013360 0ustar liggesusers#' Get the last HTTP request made #' #' @export #' @return `NULL` if no requests registered; otherwise the last #' registered request made as a `RequestSignature` class #' @examplesIf interactive() #' # no requests #' request_registry_clear() #' last_request() #' #' # a request is found #' enable() #' stub_request("head", "https://nytimes.com") #' library(crul) #' crul::ok("https://nytimes.com") #' last_request() #' #' # cleanup #' request_registry_clear() #' stub_registry_clear() last_request <- function() { last(webmockr_request_registry$request_signatures$hash)$sig } #' Get the last stub created #' #' @importFrom rlang is_empty #' @export #' @return `NULL` if no stubs found; otherwise the last stub created #' as a `StubbedRequest` class #' @examplesIf interactive() #' # no requests #' stub_registry_clear() #' last_stub() #' #' # a stub is found #' stub_request("head", "https://nytimes.com") #' last_stub() #' #' stub_request("post", "https://nytimes.com/stories") #' last_stub() #' #' # cleanup #' stub_registry_clear() last_stub <- function() { tmp <- last(webmockr_stub_registry$request_stubs) if (rlang::is_empty(tmp)) { return(NULL) } tmp } webmockr/R/query_mapper.R0000644000176200001440000000024114113773445015126 0ustar liggesusers# query mapper for BodyPattern # attempt to convert input to an R object regardless of format query_mapper <- function(x) { if (is.null(x)) return(NULL) x } webmockr/R/webmockr-opts.R0000644000176200001440000001152014752052374015213 0ustar liggesusers#' webmockr configuration #' #' @export #' @param allow_net_connect (logical) Default: `FALSE` #' @param allow_localhost (logical) Default: `FALSE` #' @param allow (character) one or more URI/URL to allow (and by extension #' all others are not allowed) #' @param show_stubbing_instructions (logical) Default: `TRUE`. If `FALSE`, #' stubbing instructions are not shown #' @param show_body_diff (logical) Default: `FALSE`. If `TRUE` show's #' a diff of the stub's request body and the http request body. See also #' [stub_body_diff()] for manually comparing request and stub bodies. #' Under the hood the Suggested package `diffobj` is required to do #' the comparison. #' @param uri (character) a URI/URL as a character string - to determine #' whether or not it is allowed #' #' @section webmockr_allow_net_connect: #' If there are stubs found for a request, even if net connections are #' allowed (by running `webmockr_allow_net_connect()`) the stubbed #' response will be returned. If no stub is found, and net connections #' are allowed, then a real HTTP request can be made. #' #' @examples \dontrun{ #' webmockr_configure() #' webmockr_configure( #' allow_localhost = TRUE #' ) #' webmockr_configuration() #' webmockr_configure_reset() #' #' webmockr_allow_net_connect() #' webmockr_net_connect_allowed() #' #' # disable net connect for any URIs #' webmockr_disable_net_connect() #' ### gives NULL with no URI passed #' webmockr_net_connect_allowed() #' # disable net connect EXCEPT FOR given URIs #' webmockr_disable_net_connect(allow = "google.com") #' ### is a specific URI allowed? #' webmockr_net_connect_allowed("google.com") #' #' # show body diff #' webmockr_configure(show_body_diff = TRUE) #' } webmockr_configure <- function( allow_net_connect = FALSE, allow_localhost = FALSE, allow = NULL, show_stubbing_instructions = TRUE, show_body_diff = FALSE) { opts <- list( allow_net_connect = allow_net_connect, allow_localhost = allow_localhost, allow = allow, show_stubbing_instructions = show_stubbing_instructions, 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_allow_net_connect <- function() { if (!webmockr_net_connect_allowed()) { message("net connect allowed") assign("allow_net_connect", TRUE, envir = webmockr_conf_env) } } #' @export #' @rdname webmockr_configure webmockr_disable_net_connect <- function(allow = NULL) { assert_is(allow, "character") message("net connect disabled") assign("allow_net_connect", FALSE, envir = webmockr_conf_env) assign("allow", allow, envir = webmockr_conf_env) } #' @export #' @rdname webmockr_configure webmockr_net_connect_allowed <- function(uri = NULL) { assert_is(uri, c("character", "list")) if (is.null(uri)) { return(webmockr_conf_env$allow_net_connect) } uri <- normalize_uri(uri) webmockr_conf_env$allow_net_connect || ( webmockr_conf_env$allow_localhost && is_localhost(uri) || `!!`(webmockr_conf_env$allow) && net_connect_explicit_allowed(webmockr_conf_env$allow, uri) ) } net_connect_explicit_allowed <- function(allowed, uri = NULL) { if (is.null(allowed)) { return(FALSE) } if (is.null(uri)) { return(FALSE) } z <- parse_a_url(uri) if (is.na(z$domain)) { return(FALSE) } if (inherits(allowed, "list")) { any(vapply(allowed, net_connect_explicit_allowed, logical(1), uri = uri)) } else if (inherits(allowed, "character")) { if (length(allowed) == 1) { allowed == uri || allowed == z$domain || allowed == sprintf("%s:%s", z$domain, z$port) || allowed == sprintf("%s://%s:%s", z$scheme, z$domain, z$port) || allowed == sprintf("%s://%s", z$scheme, z$domain) && z$port == z$default_port } else { any(vapply(allowed, net_connect_explicit_allowed, logical(1), uri = uri)) } } } #' @export print.webmockr_config <- function(x, ...) { cat_line("") cat_line(paste0(" crul enabled?: ", webmockr_lightswitch$crul)) cat_line(paste0(" httr enabled?: ", webmockr_lightswitch$httr)) cat_line(paste0(" httr2 enabled?: ", webmockr_lightswitch$httr2)) cat_line(paste0(" allow_net_connect?: ", x$allow_net_connect)) cat_line(paste0(" allow_localhost?: ", x$allow_localhost)) cat_line(paste0(" allow: ", x$allow %||% "")) cat_line(paste0( " show_stubbing_instructions: ", x$show_stubbing_instructions )) cat_line(paste0(" show_body_diff: ", x$show_body_diff)) } webmockr_conf_env <- new.env() webmockr/R/StubbedRequest.R0000644000176200001440000003167414752656344015403 0ustar liggesusers#' @title StubCounter #' @description hash with counter to store requests and count number #' of requests made against the stub #' @export #' @examples #' x <- StubCounter$new() #' x #' x$hash #' x$count() #' z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") #' x$put(z) #' x$count() #' x$put(z) #' x$count() StubCounter <- R6::R6Class( "StubCounter", public = list( #' @field hash (list) a list for internal use only, with elements #' `key`, `sig`, and `count` hash = list(), #' @description Register a request by it's key #' @param x an object of class `RequestSignature` #' @return nothing returned; registers request & iterates internal counter put = function(x) { assert_is(x, "RequestSignature") key <- x$to_s() self$hash[[key]] <- list(key = key, sig = x) private$total <- private$total + 1 }, #' @description Get the count of number of times any matching request has #' been made against this stub count = function() { private$total } ), private = list( total = 0 ) ) #' @title StubbedRequest #' @description stubbed request class underlying [stub_request()] #' @export #' @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", apple = "good")) #' x$to_return(status = 200, body = "foobar", headers = list(a = 5)) #' x #' x$to_s() #' #' # query #' x <- StubbedRequest$new(method = "get", uri = "httpbin.org") #' x$with(query = list(a = 5)) #' x #' x$to_s() #' ## including #' x <- StubbedRequest$new(method = "get", uri = "httpbin.org") #' x$with(query = including(list(a = 5))) #' x #' x$to_s() #' x$with(query = including(list(a = 5, b = 7))) #' x$to_s() #' ## excluding #' x <- StubbedRequest$new(method = "get", uri = "httpbin.org") #' x$with(query = excluding(list(a = 5))) #' x #' x$to_s() #' #' # many to_return's #' x <- StubbedRequest$new(method = "get", uri = "httpbin.org") #' x$to_return(status = 200, body = "foobar", headers = list(a = 5)) #' x$to_return(status = 200, body = "bears", headers = list(b = 6)) #' x #' x$to_s() #' #' # raw body #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$to_return(status = 200, body = raw(0), headers = list(a = 5)) #' x$to_s() #' x #' #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$to_return( #' status = 200, body = charToRaw("foo bar"), #' headers = list(a = 5) #' ) #' x$to_s() #' x #' #' # basic auth #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$with(basic_auth = c("foo", "bar")) #' x$to_s() #' x #' #' # file path #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' f <- tempfile() #' x$to_return(status = 200, body = file(f), headers = list(a = 5)) #' x #' x$to_s() #' unlink(f) #' #' # to_file(): file path and payload to go into the file #' # payload written to file during mocked response creation #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' f <- tempfile() #' x$to_return( #' status = 200, body = mock_file(f, "{\"foo\": \"bar\"}"), #' headers = list(a = 5) #' ) #' x #' x$to_s() #' unlink(f) #' #' # uri_regex #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$method #' x$uri_regex #' x$to_s() #' #' # to timeout #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$to_s() #' x$to_timeout() #' x$to_s() #' x #' #' # to raise #' library(fauxpas) #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$to_s() #' x$to_raise(HTTPBadGateway) #' x$to_s() #' x #' } StubbedRequest <- R6::R6Class( "StubbedRequest", public = list( #' @field method (xx) xx method = NULL, #' @field uri (xx) xx uri = NULL, #' @field uri_regex (xx) xx uri_regex = NULL, #' @field regex a logical regex = FALSE, #' @field uri_parts (xx) xx uri_parts = NULL, #' @field host (xx) xx host = NULL, #' @field query (xx) xx query = NULL, #' @field body (xx) xx body = NULL, #' @field basic_auth (xx) xx basic_auth = NULL, #' @field request_headers (xx) xx request_headers = NULL, #' @field response_headers (xx) xx response_headers = NULL, #' @field responses_sequences (xx) xx responses_sequences = NULL, #' @field status_code (xx) xx status_code = NULL, #' @field counter a StubCounter object counter = NULL, #' @description Create a new `StubbedRequest` object #' @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. \pkg{webmockr} can match uri's without the "http" scheme, #' but does not match if the scheme is "https". required, unless #' `uri_regex` given. See [UriPattern] for more. #' @param uri_regex (character) request URI as regex. either this or `uri` #' required #' @return A new `StubbedRequest` object 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)) { abort("one of uri or uri_regex is required") } self$uri <- uri self$uri_regex <- uri_regex if (!is.null(uri_regex)) self$regex <- TRUE if (!is.null(uri)) self$uri_parts <- parseurl(self$uri) self$counter <- StubCounter$new() }, #' @description print method for the `StubbedRequest` class #' @param x self #' @param ... ignored print = function(x, ...) { cat_line(" ") cat_line(paste0(" method: ", self$method)) cat_line(paste0(" uri: ", self$uri %||% self$uri_regex)) cat_line(" with: ") cat_line(paste0(" query: ", hdl_lst(self$query))) if (is.null(self$body)) { cat_line(" body: ") } else { cat_line(sprintf( " body (class: %s): %s", class(self$body)[1L], hdl_lst(self$body) )) } cat_line( paste0( " request_headers: ", hdl_lst(self$request_headers) ) ) cat_line( paste0( " auth: ", prep_cat_auth(self$basic_auth) ) ) cat_line(" to_return: ") rs <- self$responses_sequences for (i in seq_along(rs)) { cat_line(paste0(" - status: ", hdl_lst(rs[[i]]$status))) cat_line(paste0(" body: ", hdl_lst(rs[[i]]$body))) cat_line( paste0( " response_headers: ", hdl_lst(rs[[i]]$headers) ) ) cat_line(paste0(" should_timeout: ", rs[[i]]$timeout)) cat_line(paste0( " should_raise: ", if (rs[[i]]$raise) { paste0(vapply(rs[[i]]$exceptions, "[[", "", "classname"), collapse = ", " ) } else { "FALSE" } )) } }, #' @description Set expectations for what's given in HTTP request #' @param query (list) request query params, as a named list. optional #' @param body (list) request body, as a named list. optional #' @param headers (list) request headers as a named list. optional. #' @param basic_auth (character) basic authentication. optional. #' @return nothing returned; sets only with = function( query = NULL, body = NULL, headers = NULL, basic_auth = NULL) { if (!is.null(query)) { query[] <- lapply(query, as.character) } self$query <- query self$body <- body self$basic_auth <- basic_auth self$request_headers <- headers }, #' @description Set expectations for what's returned in HTTP response #' @param status (numeric) an HTTP status code #' @param body (list) response body, one of: `character`, `json`, #' `list`, `raw`, `numeric`, `NULL`, `FALSE`, or a file connection #' (other connection types not supported) #' @param headers (list) named list, response headers. optional. #' @return nothing returned; sets whats to be returned to_return = function(status, body, headers) { body <- if (inherits(body, "connection")) { bod_sum <- summary(body) close.connection(body) if (bod_sum$class != "file") { abort("'to_return' only supports connections of type 'file'") } structure(bod_sum$description, type = "file") } else { body } # FIXME: for then change, remove eventually self$response_headers <- headers body_raw <- { if (inherits(body, "mock_file")) { body } else if (inherits(body, "logical")) { if (!body) { raw() } else { webmockr_stub_registry$remove_request_stub(self) abort(c( "Unknown `body` type", "*" = "must be NULL, FALSE, character, raw or list; stub removed" )) } } else if (inherits(body, "raw")) { body } else if (is.null(body)) { raw() } else if (is.character(body) || inherits(body, "json")) { if (!is.null(attr(body, "type"))) { stopifnot(attr(body, "type") == "file") body } else { charToRaw(body) } } else if (!is.list(body)) { webmockr_stub_registry$remove_request_stub(self) abort(c( "Unknown `body` type", "*" = paste( "must be: numeric, NULL, FALSE, character,", "json, raw, list, or file connection" ), "*" = "stub removed" )) } else { charToRaw(jsonlite::toJSON(body, auto_unbox = TRUE)) } } private$append_response( private$response( status = status, body = body, headers = headers, body_raw = body_raw ) ) }, #' @description Response should time out #' @return nothing returned to_timeout = function() { private$append_response(private$response(timeout = TRUE)) }, #' @description Response should raise an exception `x` #' @param x (character) an exception message #' @return nothing returned to_raise = function(x) { private$append_response( private$response( raise = TRUE, exceptions = if (inherits(x, "list")) x else list(x) ) ) }, #' @description Response as a character string #' @return (character) the response as a string to_s = function() { ret <- self$responses_sequences gsub("^\\s+|\\s+$", "", sprintf( " %s: %s %s %s %s %s", toupper(self$method), url_builder(self$uri %||% self$uri_regex, self$regex), make_query(self$query), make_body(self$body), make_headers(self$request_headers), if (length(ret) > 0) { strgs <- c() for (i in seq_along(ret)) { bd <- make_body(ret[[i]]$body) stt <- make_status(ret[[i]]$status) hed <- make_headers(ret[[i]]$headers) strgs[i] <- sprintf( "%s %s %s", if (nzchar(paste0(bd, stt, hed))) { paste("| to_return: ", bd, stt, hed) } else { "" }, if (ret[[i]]$timeout) "| should_timeout: TRUE" else "", if (ret[[i]]$raise) { paste0( "| to_raise: ", paste0(vapply(ret[[i]]$exceptions, "[[", "", "classname"), collapse = ", " ) ) } else { "" } ) } paste0(strgs, collapse = " ") } else { "" } )) }, #' @description Reset the counter for the stub #' @return nothing returned; resets stub counter to no requests reset = function() { self$counter <- StubCounter$new() } ), private = list( append_response = function(x) { self$responses_sequences <- cc(c(self$responses_sequences, list(x))) }, response = function(status = NULL, body = NULL, headers = NULL, body_raw = NULL, timeout = FALSE, raise = FALSE, exceptions = list()) { list( status = status, body = body, headers = headers, body_raw = body_raw, timeout = timeout, raise = raise, exceptions = exceptions ) } ) ) #' @importFrom jsonlite base64_enc basic_auth_header <- function(x) { assert_is(x, "character") stopifnot(length(x) == 1) encoded <- jsonlite::base64_enc(x) paste0("Basic ", encoded) } prep_auth <- function(x) { if (!is_null(x)) { list(Authorization = basic_auth_header(x)) } } prep_cat_auth <- function(x) { if (!is_null(x %||% NULL)) { basic_auth_header(paste0(x, collapse = ":")) } } webmockr/R/partial.R0000644000176200001440000000362714752052374014064 0ustar liggesusers#' Partially match request query parameters or request bodies #' #' For use inside [wi_th()] #' #' @export #' @param x (list) a list; may support other classes in the future #' @return same as `x`, but with two attributes added: #' - partial_match: always `TRUE` #' - partial_type: the type of match, one of `include` or `exclude` #' @aliases partial #' @section Headers: #' Matching on headers already handles partial matching. That is, #' `wi_th(headers = list(Fruit = "pear"))` matches any request #' that has any request header that matches - the request can have #' other request headers, but those don't matter as long as there is #' a match. These helpers (`including`/`excluding`) are needed #' for query parameters and bodies because by default matching must be #' exact for those. #' @examples #' including(list(foo = "bar")) #' excluding(list(foo = "bar")) #' #' # get just keys by setting values as NULL #' including(list(foo = NULL, bar = NULL)) #' #' # in a stub #' req <- stub_request("get", "https://httpbin.org/get") #' req #' #' ## query #' wi_th(req, query = list(foo = "bar")) #' wi_th(req, query = including(list(foo = "bar"))) #' wi_th(req, query = excluding(list(foo = "bar"))) #' #' ## body #' wi_th(req, body = list(foo = "bar")) #' wi_th(req, body = including(list(foo = "bar"))) #' wi_th(req, body = excluding(list(foo = "bar"))) #' #' # cleanup #' stub_registry_clear() including <- function(x) { assert_is(x, "list") class(x) <- "partial" attr(x, "partial_match") <- TRUE attr(x, "partial_type") <- "include" return(x) } #' @export #' @rdname including excluding <- function(x) { assert_is(x, "list") class(x) <- "partial" attr(x, "partial_match") <- TRUE attr(x, "partial_type") <- "exclude" return(x) } #' @export print.partial <- function(x, ...) { cat_line("") cat_line(paste0(" partial type: ", attr(x, "partial_type"))) cat_line(paste0(" length: ", length(x))) } webmockr/R/zzz.R0000644000176200001440000001444514752155564013272 0ustar liggesusershttp_verbs <- c("any", "get", "post", "put", "patch", "head", "delete") cc <- function(x) Filter(Negate(is_null), x) is_nested <- function(x) { stopifnot(is.list(x)) for (i in x) { if (is.list(i)) { return(TRUE) } } return(FALSE) } col_l <- function(w) paste(names(w), unname(unlist(w)), sep = "=") hdl_nested <- function(x) { if (!is_nested(x)) col_l(x) } subs <- function(x, n) { unname(vapply(x, function(w) { w <- as.character(w) if (nchar(w) > n) paste0(substring(w, 1, n), "...") else w }, "")) } l2c <- function(w) paste(names(w), as.character(w), sep = " = ", collapse = "") has_attr <- function(x, at) { !is_null(attr(x, at, exact = TRUE)) } hdl_lst <- function(x) { if (is_null(x) || length(x) == 0) { return("") } if (is.raw(x)) { return(paste0("raw bytes, length: ", length(x))) } if (inherits(x, "form_file")) { return(sprintf("crul::upload(\"%s\", type=\"%s\")", x$path, x$type)) } if (inherits(x, "mock_file")) { return(paste0("mock file, path: ", x$path)) } if (inherits(x, c("list", "partial"))) { if (is_nested(x)) { subs(l2c(x), 80) } else { txt <- paste(names(x), subs(unname(unlist(x)), 20), sep = "=", collapse = ", " ) txt <- substring(txt, 1, 80) if (has_attr(x, "partial_match")) { txt <- sprintf( "%s(%s)", switch(attr(x, "partial_type"), include = "including", exclude = "excluding" ), txt ) } txt } } else { x } } upload_switch <- function(client, path, type) { switch(client, crul = sprintf("crul::upload(\"%s\", \"%s\")", path, type), httr = sprintf("httr::upload_file(\"%s\", \"%s\")", path, type), sprintf("curl::form_file(\"%s\", \"%s\")", path, type) ) } hdl_lst2 <- function(x, client) { if (is_null(x) || length(x) == 0) { return("") } if (is.raw(x)) { return(rawToChar(x)) } if (inherits(x, "form_file")) { return(upload_switch(client, x$path, x$type)) } if (inherits(x, "list")) { if (any(vapply(x, function(z) inherits(z, "form_file"), logical(1)))) { for (i in seq_along(x)) { x[[i]] <- upload_switch(client, x[[i]]$path, x[[i]]$type) } } out <- vector(mode = "character", length = length(x)) for (i in seq_along(x)) { targ <- x[[i]] out[[i]] <- paste(names(x)[i], switch(class(targ)[1L], character = if (grepl("upload", targ)) { targ } else { sprintf('\"%s\"', targ) }, list = sprintf("list(%s)", hdl_lst2(targ)), targ ), sep = "=" ) } return(paste(out, collapse = ", ")) } else { # FIXME: dumping ground, just spit out whatever and hope for the best return(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, regex) { if (regex) uri else normalize_uri(uri) } `%||%` <- function(x, y) { if ( is_null(x) || length(x) == 0 || all(nchar(x) == 0) || all(is.na(x)) ) { y } else { x } } # tryCatch version of above `%|s|%` <- function(x, y) { z <- tryCatch(x) if (inherits(z, "error")) { return(y) } if ( is_null(z) || length(z) == 0 || all(nchar(z) == 0) || all(is.na(z)) ) { y } else { x } } `!!` <- function(x) if (is_null(x) || is.na(x)) FALSE else TRUE wr_col <- function(x) { ansi_collapse(x, sep2 = " or ", last = ", or ") } webmockr_abort <- function(message, call = caller_env(2)) { cli_abort(message, call = call) } assert_is <- function(x, y, arg = caller_arg(x)) { if (!is_null(x)) { if (!inherits(x, y)) { msg <- format_error("{.arg {arg}} must be of class {wr_col(y)}") webmockr_abort(msg) } } } assert_gte <- function(x, y, arg = caller_arg(x)) { if (!x >= y) { msg <- format_error("{.arg {arg}} must be greater than or equal to {y}") webmockr_abort(msg) } } assert_length <- function(x, y, args = caller_arg(x)) { if (!is_null(x)) { if (!length(x) == y) { msg <- format_error("length of {.arg {arg}} must be equal to {y}") webmockr_abort(msg) } } } assert_not_function <- function(x) { for (i in seq_along(x)) { if (!is_null(x[[i]])) { if (is_function(x[[i]])) { msg <- format_error("{names(x)[i]} must not be a function") webmockr_abort(msg) } } } } assert_stub_registered <- function(x) { if (!webmockr_stub_registry$is_stubbed(x)) { msg <- format_error("stub {substitute(x)} is not registered") webmockr_abort(msg) } } 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)) #' execute a curl request #' @export #' @keywords internal #' @param x an object #' @return a curl response 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) } } # modified from purrr:::has_names along_rep <- function(x, y) rep(y, length.out = length(x)) hz_namez <- function(x) { nms <- names(x) if (is_null(nms)) { along_rep(x, FALSE) } else { !(is.na(nms) | nms == "") } } # lower case names in a list, return that list names_to_lower <- function(x) { names(x) <- tolower(names(x)) return(x) } as_character <- function(x) { stopifnot(is.list(x)) lapply(x, as.character) } last <- function(x) { if (length(x) == 0) { return(list()) } x[[length(x)]] } vcr_loaded <- function() { "package:vcr" %in% search() } # check whether a cassette is inserted without assuming vcr is installed vcr_cassette_inserted <- function() { if (vcr_loaded()) { return(length(vcr::current_cassette()) > 0) } return(FALSE) } webmockr/R/HttpLibAdapterRegistry.R0000644000176200001440000000222214752052374017016 0ustar liggesusers#' @title HttpLibAdapaterRegistry #' @description http lib adapter registry #' @export #' @examples #' x <- HttpLibAdapaterRegistry$new() #' x$register(CrulAdapter$new()) #' x #' x$adapters #' x$adapters[[1]]$name HttpLibAdapaterRegistry <- R6::R6Class( "HttpLibAdapaterRegistry", public = list( #' @field adapters list adapters = NULL, #' @description print method for the `HttpLibAdapaterRegistry` class #' @param x self #' @param ... ignored print = function(x, ...) { cat_line(" ") for (i in seq_along(self$adapters)) { cat_line( sprintf( " %s: webmockr:::%s", self$adapters[[i]]$name, class(self$adapters[[i]])[1] ) ) } }, #' @description Register an http library adapter #' @param x an http lib adapter, e.g., [CrulAdapter] #' @return nothing, registers the library adapter register = function(x) { if (!inherits(x, c("CrulAdapter", "HttrAdapter", "Httr2Adapter"))) { abort("'x' must be an adapter, such as CrulAdapter") } self$adapters <- c(self$adapters, x) } ) ) webmockr/R/adapter-httr.R0000644000176200001440000000731314752052374015023 0ustar liggesusers#' Build a httr response #' @export #' @param req a request #' @param resp a response #' @return a httr response build_httr_response <- function(req, resp) { try_url <- tryCatch(resp$url, error = function(e) e) lst <- list( url = try_url %|s|% req$url, status_code = as.integer(resp$status_code), headers = { if (grepl("^ftp://", resp$url %||% "")) { # in case uri_regex only list() } else { hds <- resp$headers if (is.null(hds)) { hds <- resp$response_headers if (is.null(hds)) { list() } else { stopifnot(is.list(hds)) stopifnot(is.character(hds[[1]])) httr::insensitive(hds) } } else { httr::insensitive(hds) } } }, all_headers = list(), cookies = httr_cookies_df(), content = resp$content, date = { if (!is.null(resp$response_headers$date)) { httr::parse_http_date(resp$response_headers$date) } else { Sys.time() } }, times = numeric(0), request = req, handle = NA ) lst$all_headers <- list(list( status = lst$status_code, version = "", headers = lst$headers )) structure(lst, class = "response") } httr_cookies_df <- function() { df <- data.frame(matrix(ncol = 7, nrow = 0)) x <- c("domain", "flag", "path", "secure", "expiration", "name", "value") colnames(df) <- x df } check_user_pwd <- function(x) { if (is.null(x)) { return(x) } if (grepl("^https?://", x)) { abort(c("expecting string of pattern 'user:pwd'", sprintf("got '%s'", x))) } return(x) } #' Build a httr request #' @export #' @param x an unexecuted httr request object #' @return a httr request build_httr_request <- function(x) { headers <- as.list(x$headers) %||% NULL auth <- check_user_pwd(x$options$userpwd) %||% NULL if (!is.null(auth)) { auth_header <- prep_auth(auth) headers <- c(headers, auth_header) } RequestSignature$new( method = x$method, uri = x$url, options = list( body = pluck_body(x), headers = headers, proxies = x$proxies %||% NULL, auth = auth, disk = x$disk %||% NULL, fields = x$fields %||% NULL, output = x$output %||% NULL ) ) } #' Turn on `httr` mocking #' #' Sets a callback that routes `httr` requests through `webmockr` #' #' @export #' @param on (logical) set to `TRUE` to turn on, and `FALSE` #' to turn off. default: `TRUE` #' @return Silently returns `TRUE` when enabled and `FALSE` when disabled. httr_mock <- function(on = TRUE) { check_installed("httr") webmockr_handle <- function(req) { webmockr::HttrAdapter$new()$handle_request(req) } if (on) { httr::set_callback("request", webmockr_handle) } else { httr::set_callback("request", NULL) } invisible(on) } #' @rdname Adapter #' @export HttrAdapter <- R6::R6Class("HttrAdapter", inherit = Adapter, public = list( #' @field client HTTP client package name client = "httr", #' @field name adapter name name = "HttrAdapter" ), private = list( pluck_url = function(request) request$url, mock = function(on) httr_mock(on), build_request = build_httr_request, build_response = build_httr_response, request_handler = function(request) vcr::RequestHandlerHttr$new(request), fetch_request = function(request) { METHOD <- eval(parse(text = paste0("httr::", request$method))) METHOD( private$pluck_url(request), body = pluck_body(request), do.call(httr::config, request$options), httr::add_headers(request$headers), if (!is.null(request$output$path)) { httr::write_disk(request$output$path, TRUE) } ) } ) ) webmockr/R/stub_registry.R0000644000176200001440000000126614752052374015332 0ustar liggesusers#' List stubs in the stub registry #' #' @export #' @return an object of class `StubRegistry`, print method gives the #' stubs in the registry #' @family stub-registry #' @examples #' # make a stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(body = "success!", status = 200) #' #' # check the stub registry, there should be one in there #' stub_registry() #' #' # make another stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(body = "woopsy", status = 404) #' #' # check the stub registry, now there are two there #' stub_registry() #' #' # to clear the stub registry #' stub_registry_clear() stub_registry <- function() webmockr_stub_registry webmockr/R/flipswitch.R0000644000176200001440000000572314752052374014603 0ustar liggesuserswebmockr_lightswitch <- new.env() webmockr_lightswitch$httr <- FALSE webmockr_lightswitch$httr2 <- FALSE webmockr_lightswitch$crul <- FALSE webmockr_adapters <- c("crul", "httr", "httr2") #' Enable or disable webmockr #' #' @export #' @param adapter (character) the adapter name, 'crul', 'httr', or 'httr2'. #' one or the other. if none given, we attempt to enable both #' adapters #' @param options list of options - ignored for now. #' @param quiet (logical) suppress messages? default: `FALSE` #' @details #' - `enable()` enables \pkg{webmockr} for all adapters #' - `disable()` disables \pkg{webmockr} for all adapters #' - `enabled()` answers whether \pkg{webmockr} is enabled for a given adapter #' @return `enable()` and `disable()` invisibly returns booleans for #' each adapter, as a result of running enable or disable, respectively, #' on each [HttpLibAdapaterRegistry] object. `enabled` returns a #' single boolean enable <- function(adapter = NULL, options = list(), quiet = FALSE) { adnms <- vapply(http_lib_adapter_registry$adapters, function(w) w$client, "") if (!is.null(adapter)) { if (!adapter %in% webmockr_adapters) { abort("adapter must be one of 'crul', 'httr', or 'httr2'") } if (!requireNamespace(adapter, quietly = TRUE)) { message(adapter, " not installed, skipping enable") return(invisible(FALSE)) } http_lib_adapter_registry$adapters[[which(adnms == adapter)]]$enable(quiet) } else { invisible(vapply(http_lib_adapter_registry$adapters, function(z) { pkgname <- z$client # check if package installed first if (!requireNamespace(pkgname, quietly = TRUE)) { message(pkgname, " not installed, skipping enable") FALSE } else { # if instaled, enable z$enable(quiet) } }, logical(1))) } } #' @export #' @rdname enable enabled <- function(adapter = "crul") { if (!adapter %in% webmockr_adapters) { abort(c( "'adapter' must be in the set ", paste0(webmockr_adapters, collapse = ", ") )) } webmockr_lightswitch[[adapter]] } #' @export #' @rdname enable disable <- function(adapter = NULL, options = list(), quiet = FALSE) { adnms <- vapply(http_lib_adapter_registry$adapters, function(w) w$client, "") if (!is.null(adapter)) { if (!adapter %in% webmockr_adapters) { abort("adapter must be one of 'crul', 'httr', or 'httr2'") } if (!requireNamespace(adapter, quietly = TRUE)) { message(adapter, " not installed, skipping disable") return(invisible(FALSE)) } http_lib_adapter_registry$adapters[[which(adnms == adapter)]]$disable(quiet) } else { invisible(vapply(http_lib_adapter_registry$adapters, function(z) { pkgname <- z$client # check if package installed first if (!requireNamespace(pkgname, quietly = TRUE)) { message(pkgname, " not installed, skipping disable") FALSE } else { # if instaled, disable z$disable(quiet) } }, logical(1))) } } webmockr/R/webmockr-package.R0000644000176200001440000000165114752052374015625 0ustar liggesusers#' @section 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 #' - Supports multiple HTTP libraries, including \pkg{crul}, #' \pkg{httr}, and \pkg{httr2} #' - Integration with HTTP test caching library \pkg{vcr} #' - Supports async http request mocking with \pkg{crul} only #' #' @examples #' library(webmockr) #' stub_request("get", "https://httpbin.org/get") #' stub_request("post", "https://httpbin.org/post") #' stub_registry() #' #' @keywords internal "_PACKAGE" ## usethis namespace: start #' @importFrom R6 R6Class #' @importFrom fauxpas HTTPRequestTimeout #' @importFrom crul mock #' @importFrom rlang abort warn check_installed is_list is_function is_error #' caller_arg try_fetch caller_env #' @importFrom cli cli_abort ansi_collapse format_error cat_line ## usethis namespace: end NULL webmockr/R/error-handling.R0000644000176200001440000000205514752052374015335 0ustar liggesuserserrors_to_skip_stub_removal <- function() { mssgs <- c( "\".data\" is missing", "must be of class StubbedRequest", "not registered", "Unknown" # , # "all objects must be error classes" ) paste0(mssgs, collapse = "|") } stub_removal_message <- c( "Encountered an error constructing stub", "Removed stub", "To see a list of stubs run stub_registry()" ) #' Handle stub removal #' @keywords internal #' @param .data an object of class `StubbedRequest` required #' @param code a code block. required #' @return if no error, the result of running `code`; if an error occurs #' [withCallingHandlers()] throws a warning and then the stub is removed handle_stub_removal <- function(.data, code) { withCallingHandlers( { force(code) }, error = function(cnd) { if (!grepl(errors_to_skip_stub_removal(), cnd$message)) { warn(stub_removal_message) remove_request_stub(.data) } } ) } # FIXME: add envir handling so that error message says the # exported user fxn that the error occurred in webmockr/R/defunct.R0000644000176200001440000000155314113773445014054 0ustar liggesusers#' This function is defunct. #' @export #' @rdname webmockr_enable-defunct #' @keywords internal webmockr_enable <- function(...) .Defunct("enable") #' This function is defunct. #' @export #' @rdname webmockr_disable-defunct #' @keywords internal webmockr_disable <- function(...) .Defunct("disable") #' This function is defunct. #' @export #' @rdname to_return_-defunct #' @keywords internal to_return_ <- function(...) .Defunct("to_return") #' This function is defunct. #' @export #' @rdname wi_th_-defunct #' @keywords internal wi_th_ <- function(...) .Defunct("wi_th") #' Defunct functions in \pkg{webmockr} #' #' - [webmockr_enable()]: Function removed, see [enable()] #' - [webmockr_disable()]: Function removed, see [disable()] #' - [to_return_]: Only [to_return()] is available now #' - [wi_th_]: Only [wi_th()] is available now #' #' @name webmockr-defunct NULL webmockr/R/Response.R0000644000176200001440000001304514752052374014221 0ustar liggesusers#' @title Response #' @description custom webmockr http response class #' @export #' @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() #' # raw body #' x$set_body(charToRaw("hello world")) #' x #' x$get_body() #' #' x$set_exception("exception") #' x #' x$get_exception() #' } Response <- R6::R6Class( "Response", public = list( #' @field url (character) a url url = NULL, #' @field body (various) list, character, etc body = NULL, #' @field content (various) response content/body content = NULL, #' @field request_headers (list) a named list request_headers = NULL, #' @field response_headers (list) a named list response_headers = NULL, #' @field options (character) list options = NULL, #' @field status_code (integer) an http status code status_code = 200, #' @field exception (character) an exception message exception = NULL, #' @field should_timeout (logical) should the response timeout? should_timeout = NULL, #' @description Create a new `Response` object #' @param options (list) a list of options #' @return A new `Response` object initialize = function(options = list()) { if (inherits(options, "file") || inherits(options, "character")) { self$options <- read_raw_response(options) } else { self$options <- options } }, #' @description print method for the `Response` class #' @param x self #' @param ... ignored print = function(x, ...) { cat_line(" ") cat_line(paste0(" url: ", self$url)) cat_line(paste0(" status: ", self$status_code)) cat_line(" headers: ") cat_line(" request headers: ") for (i in seq_along(self$request_headers)) { cat_line(paste0( " ", paste(names(self$request_headers)[i], self$request_headers[[i]], sep = ": " ) )) } cat_line(" response headers: ") for (i in seq_along(self$response_headers)) { cat_line(paste0( " ", paste(names(self$response_headers)[i], self$response_headers[[i]], sep = ": " ) )) } cat_line(paste0(" exception: ", self$exception)) cat_line(paste0(" body length: ", length(self$body))) }, #' @description set the url for the response #' @param url (character) a url #' @return nothing returned; sets url set_url = function(url) { self$url <- url }, #' @description get the url for the response #' @return (character) a url get_url = function() self$url, #' @description set the request headers for the response #' @param headers (list) named list #' @param capitalize (logical) whether to capitalize first letters of #' each header; default: `TRUE` #' @return nothing returned; sets request headers on the response set_request_headers = function(headers, capitalize = TRUE) { self$request_headers <- private$normalize_headers(headers, capitalize) }, #' @description get the request headers for the response #' @return (list) request headers, a named list get_request_headers = function() self$request_headers, #' @description set the response headers for the response #' @param headers (list) named list #' @param capitalize (logical) whether to capitalize first letters of #' each header; default: `TRUE` #' @return nothing returned; sets response headers on the response set_response_headers = function(headers, capitalize = TRUE) { self$response_headers <- private$normalize_headers(headers, capitalize) }, #' @description get the response headers for the response #' @return (list) response headers, a named list get_respone_headers = function() self$response_headers, #' @description set the body of the response #' @param body (various types) #' @param disk (logical) whether its on disk; default: `FALSE` #' @return nothing returned; sets body on the response set_body = function(body, disk = FALSE) { self$body <- self$content <- if (is.character(body)) { stopifnot(length(body) <= 1) if (disk) body else charToRaw(body) } else if (is.raw(body)) { body } else { raw(0) } }, #' @description get the body of the response #' @return various get_body = function() self$body %||% "", #' @description set the http status of the response #' @param status (integer) the http status #' @return nothing returned; sets the http status of the response set_status = function(status) { self$status_code <- status }, #' @description get the http status of the response #' @return (integer) the http status get_status = function() self$status_code %||% 200, #' @description set an exception #' @param exception (character) an exception string #' @return nothing returned; sets an exception set_exception = function(exception) { self$exception <- exception }, #' @description get the exception, if set #' @return (character) an exception get_exception = function() self$exception ), private = list( normalize_headers = function(x, capitalize = TRUE) { normalize_headers(x, capitalize) } ) ) webmockr/R/RequestRegistry.R0000644000176200001440000001102014752656504015600 0ustar liggesusers#' @title HashCounter #' @description hash with counter, to store requests, and count each time #' it is used #' @export #' @family request-registry #' @examples #' x <- HashCounter$new() #' x$hash #' z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") #' x$put(z) #' x$hash #' x$get(z) #' x$put(z) #' x$get(z) HashCounter <- R6::R6Class( "HashCounter", public = list( #' @field hash (list) a list for internal use only, with elements #' `key`, `sig`, and `count` hash = list(), #' @description Register a request by it's key #' @param req_sig an object of class `RequestSignature` #' @return nothing returned; registers request and iterates #' internal counter put = function(req_sig) { assert_is(req_sig, "RequestSignature") key <- req_sig$to_s() self$hash[[key]] <- list( key = key, sig = req_sig, count = (self$hash[[key]]$count %||% 0) + 1 ) }, #' @description Get a request by key #' @param req_sig an object of class `RequestSignature` #' @return (integer) the count of how many times the request has been made get = function(req_sig) { assert_is(req_sig, "RequestSignature") self$hash[[req_sig$to_s()]]$count %||% 0 } ) ) #' @title RequestRegistry #' @description keeps track of HTTP requests #' @export #' @family request-registry #' @seealso [stub_registry()] and [StubRegistry] #' @examples #' x <- RequestRegistry$new() #' z1 <- RequestSignature$new("get", "http://scottchamberlain.info") #' z2 <- RequestSignature$new("post", "https://httpbin.org/post") #' x$register_request(request = z1) #' x$register_request(request = z1) #' x$register_request(request = z2) #' # print method to list requests #' x #' #' # more complex requests #' w <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) #' ) #' w$to_s() #' x$register_request(request = w) #' x #' #' #' # hashes, and number of times each requested #' x$request_signatures$hash #' #' # times_executed method #' pat <- RequestPattern$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' headers = list(`User-Agent` = "foobar", stuff = "things") #' ) #' pat$to_s() #' x$times_executed(pat) #' z <- RequestPattern$new(method = "get", uri = "http://scottchamberlain.info") #' x$times_executed(z) #' w <- RequestPattern$new(method = "post", uri = "https://httpbin.org/post") #' x$times_executed(w) #' #' ## pattern with no matches - returns 0 (zero) #' pat <- RequestPattern$new( #' method = "get", #' uri = "http://recology.info/" #' ) #' pat$to_s() #' x$times_executed(pat) #' #' # reset the request registry #' x$reset() RequestRegistry <- R6::R6Class( "RequestRegistry", public = list( #' @field request_signatures a HashCounter object request_signatures = HashCounter$new(), #' @description print method for the `RequestRegistry` class #' @param x self #' @param ... ignored print = function(x, ...) { cat_line(" ") cat_line(" Registered Requests") for (i in seq_along(self$request_signatures$hash)) { cat_line( sprintf( " %s was made %s times\n", names(self$request_signatures$hash)[i], self$request_signatures$hash[[i]]$count ) ) } invisible(self$request_signatures$hash) }, #' @description Reset the registry to no registered requests #' @return nothing returned; resets registry to no requests reset = function() { self$request_signatures <- HashCounter$new() }, #' @description Register a request #' @param request a character string of the request, serialized from #' a `RequestSignature$new(...)$to_s()` #' @return nothing returned; registers the request register_request = function(request) { self$request_signatures$put(request) }, #' @description How many times has a request been made #' @param request_pattern an object of class `RequestPattern` #' @return integer, the number of times the request has been made #' @details if no match is found for the request pattern, 0 is returned times_executed = function(request_pattern) { bools <- c() for (i in seq_along(self$request_signatures$hash)) { bools[i] <- request_pattern$matches( self$request_signatures$hash[[i]]$sig ) } if (all(!bools)) { return(0) } self$request_signatures$hash[bools][[1]]$count } ) ) webmockr/R/to_return.R0000644000176200001440000000774714752656471014470 0ustar liggesusers#' 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 named variables. accepts the following: #' `status`, `body`, `headers`. See Details for more. #' @param .list named list, has to be one of 'status', 'body', #' and/or 'headers'. An alternative to passing in via `...`. Don't pass the #' same thing to both, e.g. don't pass 'status' to `...`, and also 'status' to #' this parameter #' @param times (integer) number of times the given response should be #' returned; default: 1. value must be greater than or equal to 1. Very large #' values probably don't make sense, but there's no maximum value. See #' Details. #' @return an object of class `StubbedRequest`, with print method describing #' the stub #' @note see more examples in [stub_request()] #' @details Values for status, body, and headers: #' #' - status: (numeric/integer) three digit status code #' - body: various: `character`, `json`, `list`, `raw`, `numeric`, #' `NULL`, `FALSE`, a file connection (other connetion types #' not supported), or a `mock_file` function call (see [mock_file()]) #' - headers: (list) a named list, must be named #' #' response headers are returned with all lowercase names and the values #' are all of type character. if numeric/integer values are given #' (e.g., `to_return(headers = list(a = 10))`), we'll coerce any #' numeric/integer values to character. #' #' @section multiple `to_return()`: #' You can add more than one `to_return()` to a webmockr stub (including #' [to_raise()], [to_timeout()]). Each one is a HTTP response returned. #' That is, you'll match to an HTTP request based on `stub_request()` and #' `wi_th()`; the first time the request is made, the first response #' is returned; the second time the request is made, the second response #' is returned; and so on. #' #' Be aware that webmockr has to track number of requests #' (see [request_registry()]), and so if you use multiple `to_return()` #' or the `times` parameter, you must clear the request registry #' in order to go back to mocking responses from the start again. #' [webmockr_reset()] clears the stub registry and the request registry, #' after which you can use multiple responses again (after creating #' your stub(s) again of course) #' #' @inheritSection to_raise Raise vs. Return #' #' @examples #' # first, make a stub object #' foo <- function() { #' stub_request("post", "https://httpbin.org/post") #' } #' #' # add status, body and/or headers #' foo() %>% to_return(status = 200) #' foo() %>% to_return(body = "stuff") #' foo() %>% to_return(body = list(a = list(b = "world"))) #' foo() %>% to_return(headers = list(a = 5)) #' foo() %>% #' to_return(status = 200, body = "stuff", headers = list(a = 5)) #' #' # .list - pass in a named list instead #' foo() %>% to_return(.list = list(body = list(foo = "bar"))) #' #' # multiple responses using chained `to_return()` #' foo() %>% #' to_return(body = "stuff") %>% #' to_return(body = "things") #' #' # many of the same response using the times parameter #' foo() %>% to_return(body = "stuff", times = 3) to_return <- function(.data, ..., .list = list(), times = 1) { handle_stub_removal(.data, { assert_is(.data, "StubbedRequest") assert_stub_registered(.data) assert_is(.list, "list") assert_is(times, c("integer", "numeric")) assert_gte(times, 1) z <- list(...) if (length(z) == 0) z <- NULL z <- c(z, .list) if ( !any(c("status", "body", "headers") %in% names(z)) && length(z) != 0 ) { abort("'to_return' only accepts status, body, headers") } assert_is(z$status, c("numeric", "integer")) assert_is(z$headers, "list") if (!all(hz_namez(z$headers))) abort("'headers' must be a named list") replicate( times, .data$to_return(status = z$status, body = z$body, headers = z$headers) ) }) return(.data) } webmockr/R/adapter.R0000644000176200001440000003336314752155564014055 0ustar liggesusers#' @title Adapters for Modifying HTTP Requests #' @description `Adapter` is the base parent class used to implement #' \pkg{webmockr} support for different HTTP clients. It should not be used #' directly. Instead, use one of the client-specific adapters that webmockr #' currently provides: #' * `CrulAdapter` for \pkg{crul} #' * `HttrAdapter` for \pkg{httr} #' * `Httr2Adapter` for \pkg{httr2} #' @details Note that the documented fields and methods are the same across all #' client-specific adapters. #' @export #' @examples \dontrun{ #' if (requireNamespace("httr", quietly = TRUE)) { #' # library(httr) #' #' # normal httr request, works fine #' # real <- GET("https://httpbin.org/get") #' # real #' #' # with webmockr #' # library(webmockr) #' ## turn on httr mocking #' # httr_mock() #' ## now this request isn't allowed #' # GET("https://httpbin.org/get") #' ## stub the request #' # stub_request('get', uri = 'https://httpbin.org/get') %>% #' # wi_th( #' # headers = list( #' # 'Accept' = 'application/json, text/xml, application/xml, */*' #' # ) #' # ) %>% #' # to_return(status = 418, body = "I'm a teapot!", headers = list(a = 5)) #' ## now the request succeeds and returns a mocked response #' # (res <- GET("https://httpbin.org/get")) #' # res$status_code #' # rawToChar(res$content) #' #' # allow real requests while webmockr is loaded #' # webmockr_allow_net_connect() #' # webmockr_net_connect_allowed() #' # GET("https://httpbin.org/get?animal=chicken") #' # webmockr_disable_net_connect() #' # webmockr_net_connect_allowed() #' # GET("https://httpbin.org/get?animal=chicken") #' #' # httr_mock(FALSE) #' } #' } Adapter <- R6::R6Class("Adapter", public = list( #' @field client HTTP client package name client = NULL, #' @field name adapter name name = NULL, #' @description Create a new Adapter object initialize = function() { if (is.null(self$client)) { abort(c( "Adapter parent class should not be called directly", "*" = "Use one of the following package-specific adapters instead:", "*" = " CrulAdapter$new()", "*" = " HttrAdapter$new()", "*" = " Httr2Adapter$new()" )) } }, #' @description Enable the adapter #' @param quiet (logical) suppress messages? default: `FALSE` #' @return `TRUE`, invisibly enable = function(quiet = FALSE) { assert_is(quiet, "logical") if (!quiet) message(sprintf("%s enabled!", self$name)) webmockr_lightswitch[[self$client]] <- TRUE switch(self$client, crul = crul::mock(on = TRUE), httr = httr_mock(on = TRUE), httr2 = httr2_mock(on = TRUE) ) }, #' @description Disable the adapter #' @param quiet (logical) suppress messages? default: `FALSE` #' @return `FALSE`, invisibly disable = function(quiet = FALSE) { assert_is(quiet, "logical") if (!quiet) message(sprintf("%s disabled!", self$name)) webmockr_lightswitch[[self$client]] <- FALSE self$remove_stubs() switch(self$client, crul = crul::mock(on = FALSE), httr = httr_mock(on = FALSE), httr2 = httr2_mock(on = FALSE) ) }, #' @description All logic for handling a request #' @param req a request #' @return various outcomes handle_request = function(req) { # put request in request registry request_signature <- private$build_request(req) webmockr_request_registry$register_request( request = request_signature ) if (request_is_in_cache(request_signature)) { # if real requests NOT allowed # even if net connects allowed, we check if stubbed found first ss <- webmockr_stub_registry$find_stubbed_request( request_signature )[[1]] # if user wants to return a partial object # get stub with response and return that resp <- private$build_stub_response(ss) # generate response / vcr: recordable/ignored if (vcr_cassette_inserted()) { # use RequestHandler - gets current cassette & record interaction resp <- private$request_handler(req)$handle() # if written to disk, see if we should modify file path if (self$client == "crul" && is.character(resp$content)) { resp <- private$update_vcr_disk_path(resp) } # no vcr } else { resp <- private$build_response(req, resp) # add to_return() elements if given resp <- private$add_response_sequences(ss, resp) } # request is not in cache but connections are allowed } else if (webmockr_net_connect_allowed(uri = private$pluck_url(req))) { # if real requests || localhost || certain exceptions ARE # allowed && nothing found above # if vcr loaded: record http interaction into vcr namespace # VCR: recordable if (vcr_loaded()) { # FIXME: maybe use RequestHandler instead? # which gets current cassette for us resp <- private$request_handler(req)$handle() # if written to disk, see if we should modify file path if (self$client == "crul" && is.character(resp$content)) { if (file.exists(resp$content)) { resp <- private$update_vcr_disk_path(resp) } } if (self$client == "httr2") { req$method <- req_method_get_w(req) } # stub request so next time we match it req_url <- private$pluck_url(req) urip <- crul::url_parse(req_url) m <- vcr::vcr_configuration()$match_requests_on if (all(m %in% c("method", "uri")) && length(m) == 2) { stub_request(req$method, req_url) } else if ( all(m %in% c("method", "uri", "query")) && length(m) == 3 ) { tmp <- stub_request(req$method, req_url) wi_th(tmp, .list = list(query = urip$parameter)) } else if ( all(m %in% c("method", "uri", "headers")) && length(m) == 3 ) { tmp <- stub_request(req$method, req_url) wi_th(tmp, .list = list(headers = req$headers)) } else if ( all(m %in% c("method", "uri", "headers", "query")) && length(m) == 4 ) { tmp <- stub_request(req$method, req_url) wi_th(tmp, .list = list(query = urip$parameter, headers = req$headers) ) } } else { private$mock(on = FALSE) resp <- private$fetch_request(req) private$mock(on = TRUE) } # request is not in cache and connections are not allowed } else { # throw vcr error: should happen when user not using # use_cassette or insert_cassette if (vcr_loaded()) { private$request_handler(req)$handle() } # no stubs found and net connect not allowed - STOP x <- c("Real HTTP connections are disabled.", "!" = "Unregistered request:" ) y <- "\nYou can stub this request with the following snippet:\n" z <- "\nregistered request stubs:\n" msgx <- c(x, "i" = request_signature$to_s()) msgy <- "" if (webmockr_conf_env$show_stubbing_instructions) { msgy <- paste(y, private$make_stub_request_code(request_signature)) } msgz <- "" if (length(webmockr_stub_registry$request_stubs)) { msgz <- paste( z, paste0(vapply(webmockr_stub_registry$request_stubs, function(z) { z$to_s() }, ""), collapse = "\n ") ) } msg_diff <- "" if (webmockr_conf_env$show_body_diff) { msg_diff <- private$make_body_diff(request_signature) } ending <- paste0("\n", paste(rep.int("=", 60), collapse = "")) abort(c(msgx, msgy, msgz, msg_diff, ending)) } return(resp) }, #' @description Remove all stubs #' @return nothing returned; removes all request stubs remove_stubs = function() { webmockr_stub_registry$remove_all_request_stubs() } ), private = list( make_stub_request_code = function(x) { tmp <- sprintf( "stub_request('%s', uri = '%s')", x$method, x$uri ) if (!is.null(x$headers) || !is.null(x$body)) { # set defaults to "" hd_str <- bd_str <- "" # headers has to be a named list, so easier to deal with if (!is.null(x$headers)) { hd <- x$headers hd_str <- paste0( paste(sprintf("'%s'", names(hd)), sprintf("'%s'", unlist(unname(hd))), sep = " = " ), collapse = ", " ) } # body can be lots of things, so need to handle various cases if (!is.null(x$body)) { bd <- x$body bd_str <- hdl_lst2(bd, client = self$client) } with_str <- "" if (all(nzchar(hd_str) && nzchar(bd_str))) { with_str <- sprintf( paste0( " wi_th(\n headers = list(%s),", "\n body = list(%s)\n )" ), hd_str, bd_str ) } else if (nzchar(hd_str) && !nzchar(bd_str)) { with_str <- sprintf( " wi_th(\n headers = list(%s)\n )", hd_str ) } else if (!nzchar(hd_str) && nzchar(bd_str)) { with_str <- sprintf(" wi_th(\n body = list(%s)\n )", bd_str) } tmp <- paste0(tmp, " %>%\n ", with_str) } return(tmp) }, build_stub_response = function(stub) { stopifnot(inherits(stub, "StubbedRequest")) resp <- Response$new() resp$set_url(stub$uri) resp$set_body(stub$body) resp$set_request_headers(stub$request_headers) resp$set_response_headers(stub$response_headers) resp$set_status(as.integer(stub$status_code %||% 200)) stub_num_get <- stub$counter$count() if (stub_num_get > length(stub$responses_sequences)) { stub_num_get <- length(stub$responses_sequences) } respx <- stub$responses_sequences[[stub_num_get]] # if user set to_timeout or to_raise, do that if (!is.null(respx)) { if (respx$timeout || respx$raise) { if (respx$timeout) { x <- fauxpas::HTTPRequestTimeout$new() resp$set_status(x$status_code) x$do_verbose(resp) } if (respx$raise) { x <- respx$exceptions[[1]]$new() resp$set_status(x$status_code) x$do_verbose(resp) } } } return(resp) }, add_response_sequences = function(stub, response) { # TODO: assert HttpResponse (is it ever a crul response?) stopifnot(inherits(stub, "StubbedRequest")) # FIXME: temporary fix, change to using request registry counter # to decide which responses_sequence entry to use # choose which response to return stub_num_get <- stub$counter$count() if (stub_num_get > length(stub$responses_sequences)) { stub_num_get <- length(stub$responses_sequences) } respx <- stub$responses_sequences[[stub_num_get]] # remove NULLs toadd <- cc(respx) if (is.null(toadd)) { return(response) } # remove timeout, raise, exceptions fields toadd <- toadd[!names(toadd) %in% c("timeout", "raise", "exceptions")] for (i in seq_along(toadd)) { if (names(toadd)[i] == "status") { response$status_code <- as.integer(toadd[[i]]) } if (names(toadd)[i] == "body") { if (inherits(respx$body_raw, "mock_file")) { cat_line( respx$body_raw$payload, file = respx$body_raw$path ) respx$body_raw <- respx$body_raw$path if (self$client == "httr") { class(respx$body_raw) <- "path" } if (self$client == "httr2") { class(respx$body_raw) <- "httr2_path" } } body_type <- attr(respx$body_raw, "type") %||% "" if (self$client == "httr" && body_type == "file") { attr(respx$body_raw, "type") <- NULL class(respx$body_raw) <- "path" } if (self$client == "httr2" && body_type == "file") { attr(respx$body_raw, "type") <- NULL class(respx$body_raw) <- "httr2_path" } if (self$client == "httr2") { response$body <- respx$body_raw } else { response$content <- respx$body_raw } } if (names(toadd)[i] == "headers") { headers <- names_to_lower(as_character(toadd[[i]])) if (self$client == "crul") { response$response_headers <- headers response$response_headers_all <- list(headers) } else if (self$client == "httr") { response$headers <- httr::insensitive(headers) } else { response$headers <- httr2_headers(headers) } } } return(response) }, make_body_diff = function(request_signature) { check_installed("diffobj") prefix <- "\n\nBody diff:" stubs <- webmockr_stub_registry$request_stubs comps <- lapply(stubs, \(stub) { diffobj::diffObj(stub$body, request_signature$body) }) num_diffs <- vapply(comps, \(w) attr(w@diffs, "meta")$diffs[2], 1) if (length(stubs) > 1) { diffs_msg <- "diffs: >1 stub found, showing diff with least differences" diff_to_show <- comps[which.min(num_diffs)][[1]] c(prefix, "i" = diffs_msg, as.character(diff_to_show)) } else { c(prefix, as.character(comps[[1]])) } } ) ) webmockr/R/webmockr_reset.R0000644000176200001440000000072114113773445015433 0ustar liggesusers#' @title webmockr_reset #' @description Clear all stubs and the request counter #' @export #' @return nothing #' @seealso [stub_registry_clear()] [request_registry_clear()] #' @details this function runs [stub_registry_clear()] and #' [request_registry_clear()] - so you can run those two yourself #' to achieve the same thing #' @examples #' # webmockr_reset() webmockr_reset <- function() { stub_registry_clear() request_registry_clear() invisible(NULL) } webmockr/R/request_is_in_cache.R0000644000176200001440000000022014113773445016406 0ustar liggesusers# Check if request is in cache request_is_in_cache <- function(request_signature) { webmockr_stub_registry$is_registered(request_signature) } webmockr/R/stub_registry_clear.R0000644000176200001440000000060414113773445016473 0ustar liggesusers#' @title stub_registry_clear #' @description Clear all stubs in the stub registry #' @export #' @return an empty list invisibly #' @family stub-registry #' @examples #' (x <- stub_request("get", "https://httpbin.org/get")) #' stub_registry() #' stub_registry_clear() #' stub_registry() stub_registry_clear <- function() { invisible(webmockr_stub_registry$remove_all_request_stubs()) } webmockr/R/mocking-disk-writing.R0000644000176200001440000000616314752052374016466 0ustar liggesusers#' Mocking writing to disk #' #' @name mocking-disk-writing #' @examples \dontrun{ #' # enable mocking #' enable() #' # getOption('httr2_mock') #' #' # Write to a file before mocked request #' #' # crul #' library(crul) #' ## make a temp file #' f <- tempfile(fileext = ".json") #' ## write something to the file #' cat("{\"hello\":\"world\"}\n", file = f) #' readLines(f) #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(body = file(f)) #' ## make a request #' (out <- HttpClient$new("https://httpbin.org/get")$get(disk = f)) #' out$content #' readLines(out$content) #' #' # httr #' library(httr) #' ## make a temp file #' f <- tempfile(fileext = ".json") #' ## write something to the file #' cat("{\"hello\":\"world\"}\n", file = f) #' readLines(f) #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return( #' body = file(f), #' headers = list("content-type" = "application/json") #' ) #' ## make a request #' ## with httr, you must set overwrite=TRUE or you'll get an errror #' out <- GET("https://httpbin.org/get", write_disk(f, overwrite = TRUE)) #' out #' out$content #' content(out, "text", encoding = "UTF-8") #' #' # httr2 #' library(httr2) #' ## make a temp file #' f <- tempfile(fileext = ".json") #' ## write something to the file #' cat("{\"hello\":\"world\"}\n", file = f) #' readLines(f) #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return( #' body = file(f), #' headers = list("content-type" = "application/json") #' ) #' ## make a request #' req <- request("https://httpbin.org/get") #' out <- req_perform(req, path = f) #' out #' out$body #' out #' out$headers #' readLines(out$body) #' #' #' # Use mock_file to have webmockr handle file and contents #' #' # crul #' library(crul) #' f <- tempfile(fileext = ".json") #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(body = mock_file(f, "{\"hello\":\"mars\"}\n")) #' ## make a request #' (out <- crul::HttpClient$new("https://httpbin.org/get")$get(disk = f)) #' out$content #' readLines(out$content) #' #' # httr #' library(httr) #' ## make a temp file #' f <- tempfile(fileext = ".json") #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return( #' body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), #' headers = list("content-type" = "application/json") #' ) #' ## make a request #' out <- GET("https://httpbin.org/get", write_disk(f)) #' out #' ## view stubbed file content #' out$content #' readLines(out$content) #' content(out, "text", encoding = "UTF-8") #' #' # httr2 #' library(httr2) #' ## make a temp file #' f <- tempfile(fileext = ".json") #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return( #' body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), #' headers = list("content-type" = "application/json") #' ) #' ## make a request #' req <- request("https://httpbin.org/get") #' out <- req_perform(req, path = f) #' out #' ## view stubbed file content #' out$body #' readLines(out$body) #' #' # disable mocking #' disable() #' } NULL webmockr/R/wi_th.R0000644000176200001440000001143414752052374013535 0ustar liggesusers#' Set additional parts of a stubbed request #' #' Set query params, request body, request headers and/or basic_auth #' #' @export #' @param .data input. Anything that can be coerced to a `StubbedRequest` class #' object #' @param ... Comma separated list of named variables. accepts the following: #' `query`, `body`, `headers`, `basic_auth`. See Details. #' @param .list named list, has to be one of `query`, `body`, #' `headers` and/or `basic_auth`. An alternative to passing in via `...`. #' Don't pass the same thing to both, e.g. don't pass 'query' to `...`, and #' also 'query' to this parameter #' @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 more examples in [stub_request()] #' @seealso [including()] #' @details #' Values for query, body, headers, and basic_auth: #' #' - query: (list) a named list. values are coerced to character #' class in the recorded stub. You can pass numeric, integer, etc., but #' all will be coerced to character. #' - body: various, including character string, list, raw, numeric, #' upload ([crul::upload()], [httr::upload_file()], [curl::form_file()], or #' [curl::form_data()] they both create the same object in the end). for the #' special case of an empty request body use `NA` instead of `NULL` because #' with `NULL` we can't determine if the user did not supply a body or #' they supplied `NULL` to indicate an empty body. #' - headers: (list) a named list #' - basic_auth: (character) a length two vector, username and password. #' We don't do any checking of the username/password except to detect #' edge cases where for example, the username/password #' were probably not set by the user on purpose (e.g., a URL is #' picked up by an environment variable). Only basic authentication #' supported . #' #' Note that there is no regex matching on query, body, or headers. They #' are tested for matches in the following ways: #' #' - query: compare stubs and requests with `identical()`. this compares #' named lists, so both list names and values are compared #' - body: varies depending on the body format (list vs. character, etc.) #' - headers: compare stub and request values with `==`. list names are #' compared with `%in%`. `basic_auth` is included in headers (with the name #' Authorization) #' #' @examples #' # first, make a stub object #' req <- stub_request("post", "https://httpbin.org/post") #' #' # add body #' # list #' wi_th(req, body = list(foo = "bar")) #' # string #' wi_th(req, body = '{"foo": "bar"}') #' # raw #' wi_th(req, body = charToRaw('{"foo": "bar"}')) #' # numeric #' wi_th(req, body = 5) #' # an upload #' wi_th(req, body = crul::upload(system.file("CITATION"))) #' # wi_th(req, body = httr::upload_file(system.file("CITATION"))) #' #' # add query - has to be a named list #' wi_th(req, query = list(foo = "bar")) #' #' # add headers - has to be a named list #' wi_th(req, headers = list(foo = "bar")) #' wi_th(req, headers = list(`User-Agent` = "webmockr/v1", hello = "world")) #' #' # .list - pass in a named list instead #' wi_th(req, .list = list(body = list(foo = "bar"))) #' #' # basic authentication #' wi_th(req, basic_auth = c("user", "pass")) #' wi_th(req, basic_auth = c("user", "pass"), headers = list(foo = "bar")) #' #' # partial matching, query params #' ## including #' wi_th(req, query = including(list(foo = "bar"))) #' ## excluding #' wi_th(req, query = excluding(list(foo = "bar"))) #' #' # partial matching, body #' ## including #' wi_th(req, body = including(list(foo = "bar"))) #' ## excluding #' wi_th(req, body = excluding(list(foo = "bar"))) #' #' # basic auth #' ## including #' wi_th(req, body = including(list(foo = "bar"))) #' ## excluding #' wi_th(req, body = excluding(list(foo = "bar"))) wi_th <- function(.data, ..., .list = list()) { handle_stub_removal(.data, { assert_is(.data, "StubbedRequest") assert_stub_registered(.data) assert_is(.list, "list") z <- list(...) if (length(z) == 0) z <- NULL z <- c(z, .list) if ( !any(c("query", "body", "headers", "basic_auth") %in% names(z)) && length(z) != 0 ) { abort("'wi_th' only accepts query, body, headers, basic_auth") } if (any(duplicated(names(z)))) abort("can not have duplicated names") assert_is(z$query, c("list", "partial")) if (!all(hz_namez(z$query))) abort("'query' must be a named list") assert_is(z$headers, "list") if (!all(hz_namez(z$headers))) abort("'headers' must be a named list") assert_is(z$basic_auth, "character") assert_length(z$basic_auth, 2) assert_not_function(z) .data$with( query = z$query, body = z$body, headers = z$headers, basic_auth = z$basic_auth ) }) return(.data) } webmockr/R/RequestSignature.R0000644000176200001440000001222414752052374015733 0ustar liggesusers#' @title RequestSignature #' @description General purpose request signature builder #' @export #' @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 #' w <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) #' ) #' w #' w$headers #' w$to_s() #' #' # headers and body #' bb <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list( #' headers = list(`User-Agent` = "foobar", stuff = "things"), #' body = list(a = "tables") #' ) #' ) #' bb #' bb$headers #' bb$body #' bb$to_s() #' #' # with disk path #' f <- tempfile() #' bb <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(disk = f) #' ) #' bb #' bb$disk #' bb$to_s() RequestSignature <- R6::R6Class( "RequestSignature", public = list( #' @field method (character) an http method method = NULL, #' @field uri (character) a uri uri = NULL, #' @field body (various) request body body = NULL, #' @field headers (list) named list of headers headers = NULL, #' @field proxies (list) proxies as a named list proxies = NULL, #' @field auth (list) authentication details, as a named list auth = NULL, #' @field url internal use url = NULL, #' @field disk (character) if writing to disk, the path disk = NULL, #' @field fields (various) request body details fields = NULL, #' @field output (various) request output details, disk, memory, etc output = NULL, #' @description Create a new `RequestSignature` object #' @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. #' @return A new `RequestSignature` object initialize = function(method, uri, options = list()) { verb <- match.arg(tolower(method), http_verbs) self$method <- verb self$uri <- uri self$url$url <- uri if (length(options)) private$assign_options(options) }, #' @description print method for the `RequestSignature` class #' @param x self #' @param ... ignored print = function() { cat_line(" ") cat_line(paste0(" method: ", toupper(self$method))) cat_line(paste0(" uri: ", self$uri)) if (!is.null(self$body)) { cat_line(" body: ") if (inherits(self$body, "form_file")) { cat_line(paste0( " ", sprintf("type=%s; path=%s", self$body$type, self$body$path) )) } else { cat_foo(self$body) } } if (!is.null(self$headers)) { cat_line(" headers: ") cat_foo(self$headers) } if (!is.null(self$proxies)) { cat_line(" proxies: ") cat_foo(self$proxies) } if (!is.null(self$auth)) { cat_line(" auth: ") cat_foo(self$auth) } if (!is.null(self$disk)) { cat_line(paste0(" disk: ", self$disk)) } if (!is.null(self$fields)) { cat_line(" fields: ") cat_foo(self$fields) } }, #' @description Request signature to a string #' @return a character string representation of the request signature to_s = function() { gsub("^\\s+|\\s+$", "", paste( paste0(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) { op_vars <- c( "body", "headers", "proxies", "auth", "disk", "fields", "output" ) for (i in seq_along(op_vars)) { if (op_vars[i] %in% names(options)) { if (!is.null(options[[op_vars[i]]]) && length(options)) { self[[op_vars[i]]] <- options[[op_vars[i]]] } } } } ) ) cat_foo <- function(x) { cat_line(paste0( " ", paste0(paste(names(x) %||% "", x, sep = ": "), collapse = "\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 if (inherits(x, "form_file")) { tmp <- sprintf("type=%s; path=%s", x$type, x$path) } else { tmp <- paste0(x, collapse = ", ") } return(sprintf("{%s}", tmp)) } webmockr/R/RequestPattern.R0000644000176200001440000006554714752656443015436 0ustar liggesusers#' @title RequestPattern class #' @description class handling all request matchers #' @export #' @seealso pattern classes for HTTP method [MethodPattern], headers #' [HeadersPattern], body [BodyPattern], and URI/URL [UriPattern] #' @examples \dontrun{ #' (x <- RequestPattern$new(method = "get", uri = "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 = "http://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() #' ## query params included in url, not separately #' (x <- RequestPattern$new( #' method = "get", uri = "https://httpbin.org/get?stuff=things" #' )) #' x$to_s() #' x$query_params #' #' # just headers (via setting method=any & uri_regex=.+) #' headers <- list( #' "User-Agent" = "Apple", #' "Accept-Encoding" = "gzip, deflate", #' "Accept" = "application/json, text/xml, application/xml, */*" #' ) #' x <- RequestPattern$new( #' method = "any", #' uri_regex = ".+", #' headers = headers #' ) #' x$to_s() #' rs <- RequestSignature$new( #' method = "any", uri = "http://foo.bar", #' options = list(headers = headers) #' ) #' rs #' x$matches(rs) #' #' # body #' x <- RequestPattern$new( #' method = "post", uri = "httpbin.org/post", #' body = list(y = crul::upload(system.file("CITATION"))) #' ) #' x$to_s() #' rs <- RequestSignature$new( #' method = "post", uri = "http://httpbin.org/post", #' options = list( #' body = list(y = crul::upload(system.file("CITATION"))) #' ) #' ) #' rs #' x$matches(rs) #' #' # basic auth #' x <- RequestPattern$new( #' method = "post", #' uri = "httpbin.org/post", #' basic_auth = c("user", "pass") #' ) #' x #' x$headers_pattern$to_s() #' x$to_s() #' rs <- RequestSignature$new( #' method = "post", uri = "http://httpbin.org/post", #' options = list(headers = prep_auth("user:pass")) #' ) #' rs #' x$matches(rs) # TRUE #' rs <- RequestSignature$new( #' method = "post", uri = "http://httpbin.org/post", #' options = list(headers = prep_auth("user:longpassword")) #' ) #' x$matches(rs) # FALSE #' } RequestPattern <- R6::R6Class( "RequestPattern", public = list( #' @field method_pattern xxx method_pattern = NULL, #' @field uri_pattern xxx uri_pattern = NULL, #' @field body_pattern xxx body_pattern = NULL, #' @field headers_pattern xxx headers_pattern = NULL, #' @description Create a new `RequestPattern` object #' @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 #' @param basic_auth (list) vector of length 2 (username, password), #' optional #' @return A new `RequestPattern` object initialize = function(method, uri = NULL, uri_regex = NULL, query = NULL, body = NULL, headers = NULL, basic_auth = NULL) { if (is.null(uri) && is.null(uri_regex)) { abort("one of uri or uri_regex is required") } self$method_pattern <- MethodPattern$new(pattern = method) self$uri_pattern <- if (is.null(uri_regex)) { 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) auth_headers <- private$set_basic_auth_as_headers(basic_auth) headers <- c(headers, auth_headers) self$headers_pattern <- if (!is.null(headers)) { HeadersPattern$new(pattern = headers) } }, #' @description does a request signature match the selected matchers? #' @param request_signature a [RequestSignature] object #' @return a boolean matches = function(request_signature) { assert_is(request_signature, "RequestSignature") c_type <- NULL c_type <- if (!is.null(request_signature$headers)) { request_signature$headers$`Content-Type` } if (!is.null(c_type)) 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) ) }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() { gsub("^\\s+|\\s+$", "", paste( toupper(self$method_pattern$to_s()), self$uri_pattern$to_s(), if (!is.null(self$body_pattern)) { if (!is.null(self$body_pattern$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( set_basic_auth_as_headers = function(x) { if (!is_null(x)) { private$validate_basic_auth(x) list( Authorization = private$make_basic_auth(x[1], x[2]) ) } }, validate_basic_auth = function(x) { if (!inherits(x, "character") || length(unique(unname(unlist(x)))) == 1) { abort(c( "error in basic auth", "'basic_auth' option should be a length 2 vector" )) } }, make_basic_auth = function(x, y) { paste0("Basic ", jsonlite::base64_enc(paste0(x, ":", y))) } ) ) #' @title MethodPattern #' @description method matcher #' @export #' @keywords internal #' @details 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") #' #' # all matches() calls should be TRUE #' (x <- MethodPattern$new(pattern = "any")) #' x$pattern #' x$matches(method = "post") #' x$matches(method = "GET") #' x$matches(method = "HEAD") MethodPattern <- R6::R6Class( "MethodPattern", public = list( #' @field pattern (character) an http method pattern = NULL, #' @description Create a new `MethodPattern` object #' @param pattern (character) a HTTP method, lowercase #' @return A new `MethodPattern` object initialize = function(pattern) { self$pattern <- tolower(pattern) }, #' @description test if the pattern matches a given http method #' @param method (character) a HTTP method, lowercase #' @return a boolean matches = function(method) { self$pattern == tolower(method) || self$pattern == "any" }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ) ) #' @title HeadersPattern #' @description headers matcher #' @export #' @keywords internal #' @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")` #' @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")) #' #' headers <- list( #' "User-Agent" = "Apple", #' "Accept-Encoding" = "gzip, deflate", #' "Accept" = "application/json, text/xml, application/xml, */*" #' ) #' (x <- HeadersPattern$new(pattern = headers)) #' x$to_s() #' x$pattern #' x$matches(headers) HeadersPattern <- R6::R6Class( "HeadersPattern", public = list( #' @field pattern a list pattern = NULL, #' @description Create a new `HeadersPattern` object #' @param pattern (list) a pattern, as a named list, must be named, #' e.g,. `list(a = 5, b = 6)` #' @return A new `HeadersPattern` object initialize = function(pattern) { stopifnot(is.list(pattern)) pattern <- private$normalize_headers(pattern) self$pattern <- pattern }, #' @description Match a list of headers against that stored #' @param headers (list) named list of headers, e.g,. `list(a = 5, b = 6)` #' @return a boolean matches = function(headers) { if (self$empty_headers(self$pattern)) { self$empty_headers(headers) } else { if (self$empty_headers(headers)) { return(FALSE) } headers <- private$normalize_headers(headers) 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) } }, #' @description Are headers empty? tests if null or length==0 #' @param headers named list of headers #' @return a boolean empty_headers = function(headers) { is.null(headers) || length(headers) == 0 }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() hdl_lst2(self$pattern) ), private = list( normalize_headers = function(x) { # normalize names names(x) <- tolower(names(x)) # underscores to single dash names(x) <- gsub("_", "-", names(x)) return(x) } ) ) #' @importFrom jsonlite fromJSON seems_like_json <- function(x) { res <- tryCatch(jsonlite::fromJSON(x), error = function(msg) msg) !inherits(res, "error") } #' @title BodyPattern #' @description body matcher #' @export #' @keywords internal #' @examples #' # make a request signature #' bb <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list( #' body = list(foo = "bar", a = 5) #' ) #' ) #' #' # make body pattern object #' ## FALSE #' z <- BodyPattern$new(pattern = list(foo = "bar")) #' z$pattern #' z$matches(bb$body) #' ## TRUE #' z <- BodyPattern$new(pattern = list(foo = "bar", a = 5)) #' z$pattern #' z$matches(bb$body) #' #' # uploads in bodies #' ## upload NOT in a list #' bb <- RequestSignature$new( #' method = "post", uri = "https:/httpbin.org/post", #' options = list(body = crul::upload(system.file("CITATION"))) #' ) #' bb$body #' z <- BodyPattern$new( #' pattern = #' crul::upload(system.file("CITATION")) #' ) #' z$pattern #' z$matches(bb$body) #' #' ## upload in a list #' bb <- RequestSignature$new( #' method = "post", uri = "https:/httpbin.org/post", #' options = list(body = list(y = crul::upload(system.file("CITATION")))) #' ) #' bb$body #' z <- BodyPattern$new( #' pattern = #' list(y = crul::upload(system.file("CITATION"))) #' ) #' z$pattern #' z$matches(bb$body) #' #' # partial matching #' ## including #' partial_incl <- including(list(foo = "bar")) #' z <- BodyPattern$new(pattern = partial_incl) #' z$pattern #' z$matches(list(foo = "bar", a = 5)) # TRUE #' #' ## excluding #' partial_excl <- excluding(list(hello = "world")) #' z <- BodyPattern$new(pattern = partial_excl) #' z$pattern #' z$matches(list(a = 5)) # TRUE #' z$matches(list(hello = "mars", a = 5)) # TRUE #' z$matches(list(hello = "world")) # FALSE BodyPattern <- R6::R6Class( "BodyPattern", public = list( #' @field pattern a list pattern = NULL, #' @field partial bool, default: `FALSE` partial = FALSE, #' @field partial_type a string, default: NULL partial_type = NULL, #' @description Create a new `BodyPattern` object #' @param pattern (list) a body object - from a request stub (i.e., #' the mock) #' @return A new `BodyPattern` object initialize = function(pattern) { if (inherits(pattern, "partial")) { self$partial <- attr(pattern, "partial_match") %||% FALSE self$partial_type <- attr(pattern, "partial_type") pattern <- drop_partial_attrs(pattern) self$pattern <- unclass(pattern) } else if (inherits(pattern, "form_file")) { self$pattern <- unclass(pattern) } else { self$pattern <- pattern } # convert self$pattern to a list if it's json if (seems_like_json(self$pattern)) { self$pattern <- jsonlite::fromJSON(self$pattern, FALSE) } }, #' @importFrom rlang is_null is_na #' @description Match a request body pattern against a pattern #' @param body (list) the body, i.e., from the HTTP request #' @param content_type (character) content type #' @return a boolean matches = function(body, content_type = "") { if (inherits(self$pattern, "list")) { if (length(self$pattern) == 0) { return(TRUE) } private$matching_hashes( self$pattern, private$body_as_hash(body, content_type) ) } else { # FIXME: add partial approach later (private$empty_string(self$pattern) && private$empty_string(body)) || { if (xor(is_na(self$pattern), is_na(body))) { return(FALSE) } if (xor(is_null(self$pattern), is_null(body))) { return(FALSE) } all(self$pattern == body) } } }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ), private = list( empty_string = function(string) { is_null(string) || !nzchar(string) }, matching_hashes = function(pattern, body) { if (is_null(pattern)) { return(FALSE) } if (!inherits(pattern, "list")) { return(FALSE) } if (!rlang::is_list(body)) { return(FALSE) } pattern_char <- rapply(pattern, as.character, how = "replace") body_char <- rapply(body, as.character, how = "replace") if (self$partial) { names_values_check <- switch(self$partial_type, # unname() here not needed for R < 4.5, but is needed for R 4.5 # because intersect changes to output unnamed lists include = identical( unname(intersect(pattern_char, body_char)), unname(pattern_char) ), exclude = length(intersect(pattern_char, body_char)) == 0 ) if (!names_values_check) { return(FALSE) } } else { if (!identical(pattern_char, body_char)) { return(FALSE) } } # return TRUE (a match) if no FALSE's returned above return(TRUE) }, body_as_hash = function(body, content_type) { if (inherits(body, "form_file")) body <- unclass(body) if (is_empty(content_type)) content_type <- "" bctype <- BODY_FORMATS[[content_type]] %||% "" if (grepl("json", content_type)) { bctype <- "json" } if (bctype == "json") { jsonlite::fromJSON(body, FALSE) } else if (bctype == "xml") { check_installed("xml2") try_xml2list <- rlang::try_fetch( { body_xml <- xml2::read_xml(body) xml_as_list <- xml2::as_list(body_xml) lapply(xml_as_list, promote_attr) }, error = function(e) e ) if (rlang::is_error(try_xml2list)) { rlang::warn( "xml to list conversion failed; using xml string for comparison", use_cli_format = TRUE, .frequency = "always" ) body } else { try_xml2list } } else { if (seems_like_json(body)) { return(jsonlite::fromJSON(body, FALSE)) } query_mapper(body) } } ) ) BODY_FORMATS <- list( "text/xml" = "xml", "application/xml" = "xml", "application/json" = "json", "text/json" = "json", "application/javascript" = "json", "text/javascript" = "json", "application/x-amz-json-1.1" = "json", # AWS "text/html" = "html", "application/x-yaml" = "yaml", "text/yaml" = "yaml", "text/plain" = "plain" ) # remove_reserved & promote_attr from # https://www.garrickadenbuie.com/blog/recursive-xml-workout/ remove_reserved <- function(this_attr) { reserved_attr <- c( "class", "comment", "dim", "dimnames", "names", "row.names", "tsp" ) if (!any(reserved_attr %in% names(this_attr))) { return(this_attr) } for (reserved in reserved_attr) { if (!is.null(this_attr[[reserved]])) this_attr[[reserved]] <- NULL } this_attr } promote_attr <- function(ll) { this_attr <- attributes(ll) this_attr <- remove_reserved(this_attr) if (length(ll)) { # recursive case c(this_attr, lapply(ll, promote_attr)) } else { # base case (no sub-items) this_attr } } #' @title UriPattern #' @description uri matcher #' @export #' @keywords internal #' @examples #' # trailing slash #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://foobar.com") # TRUE #' z$matches("http://foobar.com/") # TRUE #' #' # without scheme #' ## matches http by default: does not match https by default #' (z <- UriPattern$new(pattern = "foobar.com")) #' z$matches("http://foobar.com") # TRUE #' z$matches("http://foobar.com/") # TRUE #' z$matches("https://foobar.com") # FALSE #' z$matches("https://foobar.com/") # FALSE #' ## to match https, you'll have to give the complete url #' (z <- UriPattern$new(pattern = "https://foobar.com")) #' z$matches("https://foobar.com/") # TRUE #' z$matches("http://foobar.com/") # FALSE #' #' # default ports #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://foobar.com:80") # TRUE #' z$matches("http://foobar.com:80/") # TRUE #' z$matches("http://foobar.com:443") # TRUE #' z$matches("http://foobar.com:443/") # TRUE #' #' # user info - FIXME, not sure we support this yet #' (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") # TRUE #' z$matches("http://example.com") # TRUE #' z$matches("http://tramples.net") # FALSE #' #' # add query parameters #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) #' z #' z$pattern #' z$matches("http://foobar.com?pizza=cheese&cheese=cheddar") # TRUE #' z$matches("http://foobar.com?pizza=cheese&cheese=swiss") # FALSE #' #' # query parameters in the uri #' (z <- UriPattern$new(pattern = "https://httpbin.org/get?stuff=things")) #' z$add_query_params() # have to run this method to gather query params #' z$matches("https://httpbin.org/get?stuff=things") # TRUE #' z$matches("https://httpbin.org/get?stuff2=things") # FALSE #' #' # regex add query parameters #' (z <- UriPattern$new(regex_pattern = "https://foobar.com/.+/order")) #' z$add_query_params(list(pizza = "cheese")) #' z #' z$pattern #' z$matches("https://foobar.com/pizzas/order?pizza=cheese") # TRUE #' z$matches("https://foobar.com/pizzas?pizza=cheese") # FALSE #' #' # query parameters in the regex uri #' (z <- UriPattern$new(regex_pattern = "https://x.com/.+/order\\?fruit=apple")) #' z$add_query_params() # have to run this method to gather query params #' z$matches("https://x.com/a/order?fruit=apple") # TRUE #' z$matches("https://x.com/a?fruit=apple") # FALSE #' #' # any pattern #' (z <- UriPattern$new(regex_pattern = "stuff\\.com.+")) #' z$regex #' z$pattern #' z$matches("http://stuff.com") # FALSE #' z$matches("https://stuff.com/stff") # TRUE #' z$matches("https://stuff.com/apple?bears=brown&bats=grey") # TRUE #' #' # partial matching #' ## including #' z <- UriPattern$new(pattern = "http://foobar.com") #' z$add_query_params(including(list(hello = "world"))) #' z$matches(uri = "http://foobar.com?hello=world&bye=mars") # TRUE #' z$matches("http://foobar.com?bye=mars") # FALSE #' #' ## excluding #' z <- UriPattern$new(pattern = "http://foobar.com") #' z$add_query_params(excluding(list(hello = "world"))) #' z$matches(uri = "http://foobar.com?hello=world&bye=mars") # FALSE #' z$matches("http://foobar.com?bye=mars") # TRUE #' #' ## match on list keys (aka: names) only, ignore values 0 #' z <- UriPattern$new(pattern = "http://foobar.com") #' z$add_query_params(including(list(hello = NULL))) #' z$matches(uri = "http://foobar.com?hello=world&bye=mars") # TRUE #' z$matches("http://foobar.com?hello=stuff") # TRUE #' z$matches("http://foobar.com?bye=stuff") # FALSE UriPattern <- R6::R6Class( "UriPattern", public = list( #' @field pattern (character) pattern holder pattern = NULL, #' @field regex a logical regex = FALSE, #' @field query_params a list, or `NULL` if empty query_params = NULL, #' @field partial bool, default: `FALSE` partial = FALSE, #' @field partial_type a string, default: NULL partial_type = NULL, #' @description Create a new `UriPattern` object #' @param pattern (character) a uri, as a character string. if scheme #' is missing, it is added (we assume http) #' @param regex_pattern (character) a uri as a regex character string, #' see [base::regex]. if scheme is missing, it is added (we assume #' http) #' @return A new `UriPattern` object 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 if (self$regex) pattern <- add_scheme(pattern) self$pattern <- normalize_uri(pattern, self$regex) }, #' @description Match a uri against a pattern #' @param uri (character) a uri #' @return a boolean matches = function(uri) { uri <- normalize_uri(uri, self$regex) if (self$regex) { grepl(self$pattern, uri) } else { self$pattern_matches(uri) && self$query_params_matches(uri) } }, #' @description Match a URI #' @param uri (character) a uri #' @return a boolean pattern_matches = function(uri) { if (!self$regex) { return(just_uri(uri) == just_uri(self$pattern)) } # not regex grepl(drop_query_params(self$pattern), just_uri(uri)) # regex }, #' @importFrom rlang is_empty #' @description Match query parameters of a URI #' @param uri (character) a uri #' @return a boolean query_params_matches = function(uri) { if (self$partial) { uri_qp <- self$extract_query(uri) qp <- drop_partial_attrs(self$query_params) bools <- vector(mode = "logical") for (i in seq_along(qp)) { if (rlang::is_empty(qp[[i]])) { bools[i] <- names(qp) %in% names(uri_qp) } else { bools[i] <- qp %in% uri_qp } } out <- switch(self$partial_type, include = any(bools), exclude = !any(bools) ) return(out) } identical(self$query_params, self$extract_query(uri)) }, #' @description Extract query parameters as a named list #' @param uri (character) a uri #' @return named list, or `NULL` if no query parameters extract_query = function(uri) { params <- parse_a_url(uri)$parameter if (all(is.na(params))) { return(NULL) } params }, #' @description Add query parameters to the URI #' @param query_params (list|character) list or character #' @return nothing returned, updates uri pattern add_query_params = function(query_params) { if (self$regex) { return(NULL) } if (missing(query_params) || is.null(query_params)) { self$query_params <- self$extract_query(self$pattern) } else { self$query_params <- query_params self$partial <- attr(query_params, "partial_match") %||% FALSE self$partial_type <- attr(query_params, "partial_type") 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) } } }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ) ) drop_partial_attrs <- function(x) { attr(x, "partial_match") <- NULL attr(x, "partial_type") <- NULL return(x) } add_scheme <- function(x) { if (is.na(urltools::url_parse(x)$scheme)) { paste0("https?://", x) } else { x } } esc <- function(x) curl::curl_escape(x) normalize_uri <- function(x, regex = FALSE) { x <- prune_trailing_slash(x) x <- prune_port(x) if (!regex) { if (is.na(urltools::url_parse(x)$scheme)) { x <- paste0("http://", x) } } tmp <- urltools::url_parse(x) if (is.na(tmp$path)) { return(x) } if (!regex) tmp$path <- esc(tmp$path) urltools::url_compose(tmp) } prune_trailing_slash <- function(x) sub("/$", "", x) prune_port <- function(x) gsub("(:80)|(:443)", "", x) # matcher helpers -------------------------- ## URI stuff is_url <- function(x) { grepl("https?://", x, ignore.case = TRUE) || grepl("localhost:[0-9]{4}", x, ignore.case = TRUE) } is_localhost <- function(x) { grepl("localhost|127.0.0.1|0.0.0.0", x, ignore.case = TRUE) } parse_a_url <- function(url) { tmp <- urltools::url_parse(url) tmp <- as.list(tmp) if (!is.na(tmp$parameter)) { tmp$parameter <- unlist( lapply( strsplit(tmp$parameter, "&")[[1]], function(x) { z <- strsplit(x, split = "=")[[1]] as.list(stats::setNames(z[2], z[1])) } ), recursive = FALSE ) } tmp$default_port <- 443 return(tmp) } just_uri <- function(x) { z <- urltools::url_parse(x) z$parameter <- NA_character_ urltools::url_compose(z) } uri_fetch <- function(x) { x <- as.character(x) tmp <- x[vapply(x, FUN = is_url, FUN.VALUE = logical(1))] if (length(tmp) == 0) NULL else tmp } uri_host <- function(x) parse_a_url(x)$domain uri_path <- function(x) parse_a_url(x)$path uri_port <- function(x) parse_a_url(x)$port drop_query_params <- function(x) { x <- urltools::url_parse(x) x$parameter <- NA_character_ x <- urltools::url_compose(x) # prune trailing slash sub("\\/$", "", x) } webmockr/R/request_registry.R0000644000176200001440000000235714752052374016047 0ustar liggesusers#' List or clear requests in the request registry #' #' @export #' @return an object of class `RequestRegistry`, print method gives the #' requests in the registry and the number of times each one has been #' performed #' @family request-registry #' @details `request_registry()` lists the requests that have been made #' that webmockr knows about; `request_registry_clear()` resets the #' request registry (removes all recorded requests) #' @examples #' webmockr::enable() #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(body = "success!", status = 200) #' #' # nothing in the request registry #' request_registry() #' #' # make the request #' z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") #' #' # check the request registry - the request was made 1 time #' request_registry() #' #' # do the request again #' z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") #' #' # check the request registry - now it's been made 2 times, yay! #' request_registry() #' #' # clear the request registry #' request_registry_clear() #' webmockr::disable() request_registry <- function() webmockr_request_registry #' @export #' @rdname request_registry request_registry_clear <- function() webmockr_request_registry$reset() webmockr/R/adapter-crul.R0000644000176200001440000000570114752052374015006 0ustar liggesusers#' Build a crul response #' @export #' @param req a request #' @param resp a response #' @return a crul response build_crul_response <- function(req, resp) { # prep headers if (grepl("^ftp://", resp$url %||% "")) { # in case uri_regex only headers <- list() } else { hds <- resp$headers if (is.null(hds)) { hds <- resp$response_headers headers <- if (is.null(hds)) { list() } else { stopifnot(is.list(hds)) stopifnot(is.character(hds[[1]])) hds } } else { hh <- rawToChar(hds %||% raw(0)) if (is.null(hh) || nchar(hh) == 0) { headers <- list() } else { headers <- lapply( curl::parse_headers(hh, multiple = TRUE), crul_headers_parse ) } } } crul::HttpResponse$new( method = req$method, # if resp URL is empty, use URL from request url = resp$url %||% req$url$url, status_code = resp$status_code, request_headers = c("User-Agent" = req$options$useragent, req$headers), response_headers = { if (all(hz_namez(headers))) headers else last(headers) }, response_headers_all = headers, modified = resp$modified %||% NA, times = resp$times, content = resp$content, handle = req$url$handle, request = req ) } #' Build a crul request #' @export #' @param x an unexecuted crul request object #' @return a crul request build_crul_request <- function(x) { headers <- x$headers %||% NULL auth <- check_user_pwd(x$options$userpwd) %||% NULL if (!is.null(auth)) { auth_header <- prep_auth(auth) headers <- c(headers, auth_header) } RequestSignature$new( method = x$method, uri = x$url$url, options = list( body = pluck_body(x), headers = headers, proxies = x$proxies %||% NULL, auth = auth, disk = x$disk %||% NULL ) ) } #' @rdname Adapter #' @export CrulAdapter <- R6::R6Class("CrulAdapter", inherit = Adapter, public = list( #' @field client HTTP client package name client = "crul", #' @field name adapter name name = "CrulAdapter" ), private = list( pluck_url = function(request) request$url$url, mock = function(on) crul::mock(on), build_request = build_crul_request, build_response = build_crul_response, fetch_request = function(request) { private$build_response(request, webmockr_crul_fetch(request)) }, request_handler = function(request) vcr::RequestHandlerCrul$new(request), update_vcr_disk_path = function(response) { write_disk_path <- vcr::vcr_configuration()$write_disk_path # if crul_resp$content is character, it must be a file path (I THINK?) if (is.null(write_disk_path)) { abort(c( "if writing to disk, write_disk_path must be given", "see ?vcr::vcr_configure" )) } response$content <- file.path( write_disk_path, basename(response$content) ) response } ) ) webmockr/R/pluck_body.R0000644000176200001440000000277214752052374014563 0ustar liggesusers#' Extract the body from an HTTP request #' #' Returns an appropriate representation of the data contained within a request #' body based on its encoding. #' #' @export #' @param x an unexecuted crul, httr *or* httr2 request object #' @return one of the following: #' - `NULL` if the request is not associated with a body #' - `NULL` if an upload is used not in a list #' - list containing the multipart-encoded body #' - character vector with the JSON- or raw-encoded body, or upload form file pluck_body <- function(x) { assert_request(x) if (is_body_empty(x)) { return(NULL) } # multipart body if (!is.null(x$fields)) { return(x$fields) # json/raw-encoded body } else if (!is.null(x$options$postfields) && is.raw(x$options$postfields)) { return(rawToChar(x$options$postfields)) # upload not in a list } else if (!is.null(x$options$postfieldsize_large)) { return(paste0("upload, file size: ", x$options$postfieldsize_large)) # unknown, fail out } else { abort( "couldn't fetch request body; file an issue at \n", " https://github.com/ropensci/webmockr/issues/" ) } } assert_request <- function(x) { request_slots <- c("url", "method", "options", "headers") if (!is.list(x) || !all(request_slots %in% names(x))) { webmockr_abort( format_error("{.arg {deparse(substitute(x))}} is not a valid request") ) } } is_body_empty <- function(x) { is.null(x$fields) && (is.null(x$options$postfieldsize) || x$options$postfieldsize == 0L) } webmockr/R/stub_body_diff.R0000644000176200001440000000464014752052374015406 0ustar liggesusers#' Get a diff of a stub request body and a request body from an http request #' #' Requires the Suggested package `diffobj` #' #' @export #' @param stub object of class `StubbedRequest`. required. default is to #' call [last_stub()], which gets the last stub created #' @param request object of class `RequestSignature`. required. default is to #' call [last_request()], which gets the last stub created #' @return object of class `Diff` from the \pkg{diffobj} package #' @details Returns error message if either `stub` or `request` are `NULL`. #' Even though you may not intentionally pass in a `NULL`, the return values #' of [last_stub()] and [last_request()] when there's nothing found is `NULL`. #' #' Under the hood the Suggested package `diffobj` is used to do the comparison. #' @seealso [webmockr_configure()] to toggle `webmockr` showing request body #' diffs when there's not a match. `stub_body_diff()` is offered as a manual #' way to compare requests and stubs - whereas turning on with #' [webmockr_configure()] will do the diff for you. #' @examplesIf interactive() #' # stops with error if no stub and request #' request_registry_clear() #' stub_registry_clear() #' stub_body_diff() #' #' # Gives diff when there's a stub and request found - however, no request body #' stub_request("get", "https://hb.opencpu.org/get") #' enable() #' library(crul) #' HttpClient$new("https://hb.opencpu.org")$get(path = "get") #' stub_body_diff() #' #' # Gives diff when there's a stub and request found - with request body #' stub_request("post", "https://hb.opencpu.org/post") %>% #' wi_th(body = list(apple = "green")) #' enable() #' library(crul) #' HttpClient$new("https://hb.opencpu.org")$post( #' path = "post", body = list(apple = "red") #' ) #' stub_body_diff() #' #' # Gives diff when there's a stub and request found - with request body #' stub_request("post", "https://hb.opencpu.org/post") %>% #' wi_th(body = "the quick brown fox") #' HttpClient$new("https://hb.opencpu.org")$post( #' path = "post", body = "the quick black fox" #' ) #' stub_body_diff() stub_body_diff <- function(stub = last_stub(), request = last_request()) { check_installed("diffobj") if (is_empty(stub) || is_empty(request)) { abort(c( "`stub` and/or `request` are NULL or otherwise empty", "see `?stub_body_diff`" )) } assert_is(stub, "StubbedRequest") assert_is(request, "RequestSignature") diffobj::diffObj(stub$body, request$body) } webmockr/R/globals.R0000644000176200001440000000011614113773445014041 0ustar liggesusersif (base::getRversion() >= "2.15.1") { utils::globalVariables(c("vcr_c")) } webmockr/R/headers.R0000644000176200001440000000264314752052374014040 0ustar liggesusers#' @noRd #' @examples #' headers <- list(`Content-type` = "application/json", Stuff = "things") #' normalize_headers(x = headers) #' #' headers <- list(`content-type` = "application/json", stuff = "things") #' normalize_headers(x = headers, capitalize = FALSE) #' #' headers <- list( #' `content-type` = "application/json", #' `x-frame-options` = c("SAMEORIGIN", "sameorigin") #' ) #' normalize_headers(x = headers) #' normalize_headers(x = headers, FALSE) normalize_headers <- function(x = NULL, capitalize = TRUE) { if (is.null(x) || length(x) == 0) { return(x) } res <- list() for (i in seq_along(x)) { name <- paste0( vapply( strsplit(as.character(names(x)[i]), "_|-")[[1]], function(w) simple_cap(w, capitalize), "" ), collapse = "-" ) value <- switch(class(x[[i]]), list = if (length(x[[i]]) == 1) { x[[i]][[1]] } else { sort(vapply(x[[i]], function(z) as.character(z), "")) }, if (length(x[[i]]) > 1) { paste0(as.character(x[[i]]), collapse = ",") } else { as.character(x[[i]]) } ) res[[i]] <- list(name, value) } unlist(lapply(res, function(z) stats::setNames(z[2], z[1])), FALSE) } simple_cap <- function(x, capitalize) { if (capitalize) { s <- strsplit(x, " ")[[1]] paste(toupper(substring(s, 1, 1)), substring(s, 2), sep = "", collapse = " " ) } else { x } } webmockr/NAMESPACE0000644000176200001440000000410714752052374013315 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(print,mock_file) S3method(print,partial) S3method(print,webmockr_config) export("%>%") export(Adapter) export(BodyPattern) export(CrulAdapter) export(HashCounter) export(HeadersPattern) export(HttpLibAdapaterRegistry) export(Httr2Adapter) export(HttrAdapter) export(MethodPattern) export(RequestPattern) export(RequestRegistry) export(RequestSignature) export(Response) export(StubCounter) export(StubRegistry) export(StubbedRequest) export(UriPattern) export(build_crul_request) export(build_crul_response) export(build_httr2_request) export(build_httr2_response) export(build_httr_request) export(build_httr_response) export(disable) export(enable) export(enabled) export(excluding) export(httr2_mock) export(httr_mock) export(including) export(last_request) export(last_stub) export(mock_file) export(pluck_body) export(remove_request_stub) export(request_registry) export(request_registry_clear) export(stub_body_diff) export(stub_registry) export(stub_registry_clear) export(stub_request) export(to_raise) export(to_return) export(to_return_) export(to_timeout) export(webmockr_allow_net_connect) export(webmockr_configuration) export(webmockr_configure) export(webmockr_configure_reset) export(webmockr_crul_fetch) export(webmockr_disable) export(webmockr_disable_net_connect) export(webmockr_enable) export(webmockr_net_connect_allowed) export(webmockr_reset) export(wi_th) export(wi_th_) importFrom(R6,R6Class) importFrom(cli,ansi_collapse) importFrom(cli,cat_line) importFrom(cli,cli_abort) importFrom(cli,format_error) importFrom(crul,mock) importFrom(fauxpas,HTTPRequestTimeout) importFrom(jsonlite,base64_enc) importFrom(jsonlite,fromJSON) importFrom(jsonlite,toJSON) importFrom(jsonlite,validate) importFrom(magrittr,"%>%") importFrom(rlang,abort) importFrom(rlang,caller_arg) importFrom(rlang,caller_env) importFrom(rlang,check_installed) importFrom(rlang,is_empty) importFrom(rlang,is_error) importFrom(rlang,is_function) importFrom(rlang,is_list) importFrom(rlang,is_na) importFrom(rlang,is_null) importFrom(rlang,try_fetch) importFrom(rlang,warn) webmockr/LICENSE0000644000176200001440000000005714752655715013113 0ustar liggesusersYEAR: 2025 COPYRIGHT HOLDER: Scott Chamberlain webmockr/NEWS.md0000644000176200001440000004223714752656460013210 0ustar liggesuserswebmockr 2.0.0 ============== ### Breaking changes * Previous to this version when stubs were constructed starting with `stub_request()` if an error occurred in a pipe chain, or non-pipe flow, the stub prior to the error remained. This was not correct behavior from a logical perspective - i.e., one would expect if an error occurred that thing they were trying to do did not stick around. The new behavior as of this version deletes the stub upon any error during its creation. Under the hood we're using `withCallingHandlers` to handle different types of errors, throw warnings, etc. ### NEW FEATURES * Partial matching. New functions `including()` and `excluding()` for use with `wi_th()` support partial for bodies and queries (header partial matching was already supported without any additional steps). See `?partial`. This makes it slightly to a whole lot easier to do matching depending on the HTTP request your trying to match (e.g., let's say you're trying to match against a query with 20 parameters - if you can match uniquely to it with 1 or 2 of those params, then you're all set) (#38) * Basic auth internal work for `RequestPattern`. Shouldn't change behavior (#133) * New features for supporting request body diffs. There are two ways to use request body diffing. First, you can toggle it on/off globally like `webmockr_configure(show_body_diff = TRUE)` or `webmockr_configure(show_body_diff = FALSE)`. Second, a new function `stub_body_diff()` is a standalone function that compares by default the last stub created and the last http request made - but you can pass in any stub and http request. Note that body diffing functionality requires the suggested package `diffobj` (#126) * As part of the above body diffing functionality, two new functions are offered: `last_request()` and `last_stub()`, which get the last http request made and the last webmockr stub created, respectively. (#126) ### MINOR IMPROVEMENTS * Removed `global_stubs` field from the `StubRegistry` class as it was completely unused (holdover from the initial port from Ruby). Should not impact users at all. (#127) * Wider use of `rlang` functions throughout the package for nicer assertions and condition handling. This change alters the main error message you get when there's no match to registered stubs. Hopefully this feels like an improvement to you; let me know. (#129) * `StubRegistry` gains new method `is_stubbed()` to check if a stub is in the stub registry webmockr 1.0.0 ============== ### NEW FEATURES * `webmockr` now supports the `httr2` library, in addition to `httr` and `crul`. Note that you'll see different behavior from `httr2` relative to the other 2 http clients because it turns http errors (http statuses 400 and above) into R errors (#122) * `webmockr` can now mock async http requests with `crul` (w/ `crul` v1.5 or greater). no change was required in `webmockr` for this to happen. a PR was merged in `crul` to hook into `webmockr`. there's no support for async in `httr` as that package does not do any async and no support in `httr2` because `req_perform_parallel` does not have a mocking hook as does `req_perform` (#124) webmockr 0.9.0 ============== ### BUG FIXES * `to_return()` supports returning multiple responses to match many requests to the same matching stub. however, the internals were broken for this, but is now fixed (#115) thanks @kenahoo for the report * matching stubs with specifying a request body to match on (e.g., `stub_request('post', 'https://httpbin.org/post') %>% wi_th(body = list(a=5))`) was not working in some cases; internal matching logic was borked. now fixed. (#118) thanks @konradoberwimmer for the report * The `status` parameter in `to_return()` was documented to accept an integer, but it errored when an integer was passed (e.g., `to_return(status=200L)`). This bug is now fixed (#117) thanks @maelle for the report ### MINOR IMPROVEMENTS * Config options changes (see `webmockr_configure()`). Three options that were present but not implemented are now removed: `show_body_diff`, ` query_values_notation`, ` net_http_connect_on_start`. One option that was present but not implemented yet is now implemented: ` show_stubbing_instructions` (#27) (#120) ### DOCUMENTATION * `StubCounter` added to pkgdown docs page at (#119) @maelle webmockr 0.8.2 ============== ### BUG FIXES * change to `UriPattern` to make sure regex matching is working as intended (#114) thanks @kenahoo webmockr 0.8.0 ============== ### NEW FEATURES * `enable()` and the `enable()` method on the `Adapter` R6 class gain new parameter `quiet` to toggle whether messages are printed or not (#112) ### MINOR IMPROVEMENTS * to re-create http response objects for both httr and crul we were using the url from the request object; now we use the url from the response object, BUT if there is no url in the response object we fall back to using the url from the request object (#110) (#113) * improve docs: add further explanation to manual files for both `to_raise()` and `to_return()` to explain the difference between them and when you may want to use them (#100) webmockr 0.7.4 ============== ### MINOR IMPROVEMENTS * to support vcr being able to recreate httr objects fully (see github issue ropensci/vcr#132) we needed to handle additional parts of httr request objects: fields and output - with this change vcr should return objects much closer to what real httr requests return (#109) ### BUG FIXES * bug fix + improvement: fixes for simple authentication - `wi_th()` now supports `basic_auth` to mock basic authentication either with `crul::auth()` or `httr::authenticate()` (#108) webmockr 0.7.0 ============== ### NEW FEATURES * Gains ability to define more than 1 returned HTTP response, and the order in which the HTTP responses are returned. The idea is from the Ruby webmock library, but the implementation is different because the Ruby and R languages are very different. You can give more than one `to_return()` one creating a stub, or if you want to return the same response each time, you can use the new `times` parameter within `to_return()`. As a related use case (#31) you can mock http retry's using this new feature (#10) (#32) (#101) * Gains new function `webmockr_reset()` to be able to reset stub registry and request registry in one function call (#97) (#101) * Gains support for mocking simple authentication. `wi_th()` now accepts `basic_auth` in addition to query, body, and headers. Note that authentication type is ignored (#103) ### MINOR IMPROVEMENTS * change to how URI's are matched in `stub_request()`: we weren't allowing matching URI's without schemes; you can now do that. In addition, webmockr can match URI's without the "http" scheme, but does not match if the scheme is "https". See `UriPattern` for more (#102) * another change to how URI's are matched: now query params compared separately to the URI; note that regex not allowed in query params (#104) - And now query parameters are compared with the same code both when regex uri is used and when it is not (#107) * URI matching for stubs is now done only on the URI's themselves; that is, query parameters are removed before comparison, so only the base url with http scheme, plus paths, are compared (#107) * wasn't sure `write_disk_path` behavior was correct when using httr, seems to be working, added tests for it (#79) * values for query parameters given to `wi_th()` are now all coerced to character class to make sure that all comparisons of stubs and requests are done with the same class (character) (#107) ### BUG FIXES * fix for `uri_regex` usage in `stub_request()`: no longer curl escape the `uri_regex` given, only escape a non-regex uri (#106) webmockr 0.6.2 ============== * change to `CrulAdapter`: do not use `normalizePath` on the `write_disk_path` path so that relative paths are not changed to full paths - added tests for this (#95) (#96) webmockr 0.6.0 ============== ### NEW FEATURES * new `Adapter` class to consolidate common code for the `HttrAdapter` and `CrulAdapter` classes, which inherit from `Adapter`; not a user facing change (#87) * pkgdown documentation site gains grouping of functions to help the user navigate the package: see https://docs.ropensci.org/webmockr/reference/ (#93) ### MINOR IMPROVEMENTS * now correctly fails with informative message when `write_disk_path` is `NULL` when the user is trying to write to disk while using webmockr (#78) * improve README construction; use html child for the details section (#81) * fix matching stub matching for bodies when bodies are JSON encoded (#82) * when vcr was loaded real HTTP requests were being performed twice when they should have only been performed once (#91) (#92) ### BUG FIXES * fix for `set_body()` method in the `Response` class - handle cases where user writing to disk and not, and handle raw bytes correctly (#80) * fix to `to_s()` method in `StubbedRequest` class - was formatting query parameters incorrectly (#83) * fix to `BodyPattern` class to handle upload objects in a list; related issue fixed where `wi_th()` parameter `body` was not handling upload objects (#84) (#85) * httr requests were failing when vcr loaded, but with no cassette inserted; fixed `handle_request()` to skip vcr-related code unless a cassette is inserted (#86) (#88) webmockr 0.5.0 ============== ### NEW FEATURES * `webmockr` now supports mocking writing to disk. TLDR: see `?mocking-disk-writing` to get started - That is, both of the major high level http clients in R, crul and httr, support writing directly to disk (rather than the user manually getting the http response and writing it to disk). supporting this required quite a bit of work, both in code and in thinking about how to support the various scenarios in which users can find themselves when dealing with writing to disk - Please get in touch if you have problems with this (#57) (#76) * gains `request_registry_clear()` method to easily clear all requests in the request registry (#75) ### MINOR IMPROVEMENTS * better docs for R6 classes with R6 support in new roxygen2 version on cran (#77) * httr simple auth was being ignored - its now supported (simple auth with crul already worked) (#74) ### BUG FIXES * fix to handle raw responses that can not be converted to character, such as images; needed due to issue https://github.com/ropensci/vcr/issues/112 (#72) (#73) webmockr 0.4.0 ============== ### MINOR IMPROVEMENTS * fix link to http testing book, change ropensci to ropenscilabs (#67) * fixes to request matching: single match types working now (e.g., just match on query, or just on headers); in addition, header matching now works; added examples of single match types (#68) (#69) ### BUG FIXES * fix stub specification within crul and httr adapters; typo in setting headers (#70) webmockr 0.3.4 ============== ### DEFUNCT * underscore methods `to_return_()` and `wi_th_()` are defunct (#60) (#64) ### NEW FEATURES * `to_return()` gains parameter `.list` (#60) (#64) ### MINOR IMPROVEMENTS * typo fixes (#62) thanks @Bisaloo ! * improved the print method for stubs, found in `StubbedRequest`, to have better behavior for very long strings such as in headers and bodies (#63) ### BUG FIXES * fix date in mocked `httr` response object to match the date format that `httr` uses in real HTTP requests (#58) (#61) via * fix response headers in mocked `httr` response objects. `httr` makes the list of headers insensitive to case, so we now use that function from the package (#59) (#61) * `to_return()` and `wi_th()` drop use of the `lazyeval` package and fall back to using the simple `list(...)` - fixes problem where creating stubs was failing within `test_that()` blocks due to some weird lazy eval conflicts (i think) (#60) (#64) thanks @karawoo ! webmockr 0.3.0 ============== ### MINOR IMPROVEMENTS * returned mocked response headers were retaining case that the user gave - whereas they should be all lowercased to match the output in `crul` and `httr`. now fixed. (#49) thanks @hlapp * returned mocked response headers were not all of character class, but depended on what class was given by the user on creating the stub. this is now fixed, returning all character class values for response headers (#48) thanks @hlapp * skip tests that require `vcr` if `vcr` is not available (#53) * internal change to crul adapter to produce the same http response as a new version of crul returns - adds a `response_headers_all` slot (#51) (#54) webmockr 0.2.9 ============== ### MINOR IMPROVEMENTS * make `request_registry()` and `stub_registry()` print methods more similar to avoid confusion for users (#35) * update docs for `enable`/`disable` to indicate that `crul` and `httr` supported (#46) (related to #45) * wrap httr adapter examples in `requireNamespace` so only run when httr available * clean up `.onLoad` call, removing commented out code, and add note about creating adapter objects does not load crul and httr packages ### BUG FIXES * fix to `enable()` and `disable()` methods. even though `httr` is in Suggests, we were loading all adapters (crul, httr) with `stop` when the package was not found. We now give a message and skip when a package not installed. In addition, we `enable()` and `disable()` gain an `adapter` parameter to indicate which package you want to enable or disable. If `adapter` not given we attempt all adapters. Note that this bug shouldn't have affected `vcr` users as `httr` is in Imports in that package, so you'd have to have `httr` installed (#45) thanks to @maelle for uncovering the problem webmockr 0.2.8 ============== ### NEW FEATURES * Added support for integration with package `httr`; see `HttrAdapter` for the details; `webmockr` now integrates with two HTTP R packages: `crul` and `httr` (#43) (#44) * Along with `httr` integration is a new method `httr_mock()` to turn on mocking for `httr`; and two methods `build_httr_response` and `build_httr_request` meant for internal use webmockr 0.2.6 ============== ### NEW FEATURES * Added support for integration with package `vcr` (now on CRAN) for doing HTTP request caching webmockr 0.2.4 ============== ### NEW FEATURES * New function `enabled()` to ask if `webmockr` is enabled, gives a boolean * `wi_th()` gains new parameter `.list` as an escape hatch to avoid NSE. examples added in the `wi_th` man file to clarify its use ### MINOR IMPROVEMENTS * matching by request body was not supported, it now is; added examples of matching on request body, see `?stub_request` (#36) * make sure that the adapter for `crul` handles all types of matches (#29) * removed all internal usage of pipes in the package. still exporting pipe for users (#30) * fixed internals to give vcr error when vcr loaded - for future release with vcr support (#34) * require newest `crul` version ### BUG FIXES * Error messages with the suggest stub were not giving bodies. They now give bodies if needed along with method, uri, headers, query (#37) * Fixed `Response` class that was not dealing with capitalization correctly webmockr 0.2.0 ============== ### NEW FEATURES * New function `to_raise()` to say that a matched response should return a certain exception, currently `to_raise` accepts error classes from the `fauxpas` package (#9) * New function `to_timeout()` to say that a matched response should return a timeout. This is a special case of `to_raise` to easily do a timeout expectation (#11) * New function `request_registry()` to list requests in the request registry (#23) * package `crul` moved to Imports from Suggests as it's the only http client supported for now. will move back to Suggests once we support at least one other http client * `webmockr_configure()` changes: `turn_on` has been removed; `allow_net_connect` and `allow_localhost` were ignored before, but are now used and are now set to `FALSE` by default; fixed usage of `allow` which now accepts character vector of URLs instead of a boolean; the following correctly marked as being ignored for now until fixed `net_http_connect_on_start`, `show_stubbing_instructions`, `query_values_notation`, `show_body_diff` (#19) (#21) * `webmockr_disable_net_connect()` now accepts an `allow` parameter to disable all other connections except those URLs given in `allow` * `webmockr_net_connect_allowed()` now accepts a `uri` parameter to test if a URI/URL is allowed ### MINOR IMPROVEMENTS * Fixed printed stub statement when printed to the console - we weren't including headers accurately (#18) * Added examples to the `stub_registry()` and `stub_registry_clea()` manual files (#24) * internal methods `build_crul_request` and `build_crul_response` moved outside of the `CrulAdapter` class so that they can be accessed like `webmockr::` in other packages * `enable()` and `disable()` now return booleans invisibly * General improvements to documentation throughout * Added linting of user inputs to the `to_return()` method, and docs details on what to input to the method * Added linting of user inputs to the `wi_th()` method, and docs details on what to input to the method ### BUG FIXES * Fixed option `allow_localhost`, which wasn't actually workin before (#25) ### DEPRECATED AND DEFUNCT * `webmockr_enable()` and `webmockr_disable` are now defunct. Use `webmockr::enable()` and `webmockr::disable()` instead webmockr 0.1.0 ============== ### NEW FEATURES * Released to CRAN. webmockr/inst/0000755000176200001440000000000014113773445013051 5ustar liggesuserswebmockr/inst/ignore/0000755000176200001440000000000014113773445014334 5ustar liggesuserswebmockr/inst/ignore/sockets.R0000644000176200001440000000252214113773445016133 0ustar liggesuserswbenv <- 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.R0000644000176200001440000000520714113773445017062 0ustar liggesusers#' 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/man/0000755000176200001440000000000014752052374012647 5ustar liggesuserswebmockr/man/pipe.Rd0000644000176200001440000000031714113773445014074 0ustar liggesusers% 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/pluck_body.Rd0000644000176200001440000000125714715656454015306 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pluck_body.R \name{pluck_body} \alias{pluck_body} \title{Extract the body from an HTTP request} \usage{ pluck_body(x) } \arguments{ \item{x}{an unexecuted crul, httr \emph{or} httr2 request object} } \value{ one of the following: \itemize{ \item \code{NULL} if the request is not associated with a body \item \code{NULL} if an upload is used not in a list \item list containing the multipart-encoded body \item character vector with the JSON- or raw-encoded body, or upload form file } } \description{ Returns an appropriate representation of the data contained within a request body based on its encoding. } webmockr/man/BodyPattern.Rd0000644000176200001440000001021514752052374015370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{BodyPattern} \alias{BodyPattern} \title{BodyPattern} \description{ body matcher } \examples{ # make a request signature bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( body = list(foo = "bar", a = 5) ) ) # make body pattern object ## FALSE z <- BodyPattern$new(pattern = list(foo = "bar")) z$pattern z$matches(bb$body) ## TRUE z <- BodyPattern$new(pattern = list(foo = "bar", a = 5)) z$pattern z$matches(bb$body) # uploads in bodies ## upload NOT in a list bb <- RequestSignature$new( method = "post", uri = "https:/httpbin.org/post", options = list(body = crul::upload(system.file("CITATION"))) ) bb$body z <- BodyPattern$new( pattern = crul::upload(system.file("CITATION")) ) z$pattern z$matches(bb$body) ## upload in a list bb <- RequestSignature$new( method = "post", uri = "https:/httpbin.org/post", options = list(body = list(y = crul::upload(system.file("CITATION")))) ) bb$body z <- BodyPattern$new( pattern = list(y = crul::upload(system.file("CITATION"))) ) z$pattern z$matches(bb$body) # partial matching ## including partial_incl <- including(list(foo = "bar")) z <- BodyPattern$new(pattern = partial_incl) z$pattern z$matches(list(foo = "bar", a = 5)) # TRUE ## excluding partial_excl <- excluding(list(hello = "world")) z <- BodyPattern$new(pattern = partial_excl) z$pattern z$matches(list(a = 5)) # TRUE z$matches(list(hello = "mars", a = 5)) # TRUE z$matches(list(hello = "world")) # FALSE } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{a list} \item{\code{partial}}{bool, default: \code{FALSE}} \item{\code{partial_type}}{a string, default: NULL} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-BodyPattern-new}{\code{BodyPattern$new()}} \item \href{#method-BodyPattern-matches}{\code{BodyPattern$matches()}} \item \href{#method-BodyPattern-to_s}{\code{BodyPattern$to_s()}} \item \href{#method-BodyPattern-clone}{\code{BodyPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{BodyPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$new(pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(list) a body object - from a request stub (i.e., the mock)} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{BodyPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-matches}{}}} \subsection{Method \code{matches()}}{ Match a request body pattern against a pattern \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$matches(body, content_type = "")}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{body}}{(list) the body, i.e., from the HTTP request} \item{\code{content_type}}{(character) content type} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/stub_body_diff.Rd0000644000176200001440000000474614752052374016133 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_body_diff.R \name{stub_body_diff} \alias{stub_body_diff} \title{Get a diff of a stub request body and a request body from an http request} \usage{ stub_body_diff(stub = last_stub(), request = last_request()) } \arguments{ \item{stub}{object of class \code{StubbedRequest}. required. default is to call \code{\link[=last_stub]{last_stub()}}, which gets the last stub created} \item{request}{object of class \code{RequestSignature}. required. default is to call \code{\link[=last_request]{last_request()}}, which gets the last stub created} } \value{ object of class \code{Diff} from the \pkg{diffobj} package } \description{ Requires the Suggested package \code{diffobj} } \details{ Returns error message if either \code{stub} or \code{request} are \code{NULL}. Even though you may not intentionally pass in a \code{NULL}, the return values of \code{\link[=last_stub]{last_stub()}} and \code{\link[=last_request]{last_request()}} when there's nothing found is \code{NULL}. Under the hood the Suggested package \code{diffobj} is used to do the comparison. } \examples{ \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # stops with error if no stub and request request_registry_clear() stub_registry_clear() stub_body_diff() # Gives diff when there's a stub and request found - however, no request body stub_request("get", "https://hb.opencpu.org/get") enable() library(crul) HttpClient$new("https://hb.opencpu.org")$get(path = "get") stub_body_diff() # Gives diff when there's a stub and request found - with request body stub_request("post", "https://hb.opencpu.org/post") \%>\% wi_th(body = list(apple = "green")) enable() library(crul) HttpClient$new("https://hb.opencpu.org")$post( path = "post", body = list(apple = "red") ) stub_body_diff() # Gives diff when there's a stub and request found - with request body stub_request("post", "https://hb.opencpu.org/post") \%>\% wi_th(body = "the quick brown fox") HttpClient$new("https://hb.opencpu.org")$post( path = "post", body = "the quick black fox" ) stub_body_diff() \dontshow{\}) # examplesIf} } \seealso{ \code{\link[=webmockr_configure]{webmockr_configure()}} to toggle \code{webmockr} showing request body diffs when there's not a match. \code{stub_body_diff()} is offered as a manual way to compare requests and stubs - whereas turning on with \code{\link[=webmockr_configure]{webmockr_configure()}} will do the diff for you. } webmockr/man/webmockr_disable-defunct.Rd0000644000176200001440000000041014113773445020053 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{webmockr_disable} \alias{webmockr_disable} \title{This function is defunct.} \usage{ webmockr_disable(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/build_crul_request.Rd0000644000176200001440000000050714113773445017034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \name{build_crul_request} \alias{build_crul_request} \title{Build a crul request} \usage{ build_crul_request(x) } \arguments{ \item{x}{an unexecuted crul request object} } \value{ a crul request } \description{ Build a crul request } webmockr/man/enable.Rd0000644000176200001440000000214514715656454014376 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/flipswitch.R \name{enable} \alias{enable} \alias{enabled} \alias{disable} \title{Enable or disable webmockr} \usage{ enable(adapter = NULL, options = list(), quiet = FALSE) enabled(adapter = "crul") disable(adapter = NULL, options = list(), quiet = FALSE) } \arguments{ \item{adapter}{(character) the adapter name, 'crul', 'httr', or 'httr2'. one or the other. if none given, we attempt to enable both adapters} \item{options}{list of options - ignored for now.} \item{quiet}{(logical) suppress messages? default: \code{FALSE}} } \value{ \code{enable()} and \code{disable()} invisibly returns booleans for each adapter, as a result of running enable or disable, respectively, on each \link{HttpLibAdapaterRegistry} object. \code{enabled} returns a single boolean } \description{ Enable or disable webmockr } \details{ \itemize{ \item \code{enable()} enables \pkg{webmockr} for all adapters \item \code{disable()} disables \pkg{webmockr} for all adapters \item \code{enabled()} answers whether \pkg{webmockr} is enabled for a given adapter } } webmockr/man/request_registry.Rd0000644000176200001440000000261214113773445016557 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/request_registry.R \name{request_registry} \alias{request_registry} \alias{request_registry_clear} \title{List or clear requests in the request registry} \usage{ request_registry() request_registry_clear() } \value{ an object of class \code{RequestRegistry}, print method gives the requests in the registry and the number of times each one has been performed } \description{ List or clear requests in the request registry } \details{ \code{request_registry()} lists the requests that have been made that webmockr knows about; \code{request_registry_clear()} resets the request registry (removes all recorded requests) } \examples{ webmockr::enable() stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = "success!", status = 200) # nothing in the request registry request_registry() # make the request z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") # check the request registry - the request was made 1 time request_registry() # do the request again z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") # check the request registry - now it's been made 2 times, yay! request_registry() # clear the request registry request_registry_clear() webmockr::disable() } \seealso{ Other request-registry: \code{\link{HashCounter}}, \code{\link{RequestRegistry}} } \concept{request-registry} webmockr/man/UriPattern.Rd0000644000176200001440000002144314715656454015247 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{UriPattern} \alias{UriPattern} \title{UriPattern} \description{ uri matcher } \examples{ # trailing slash (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://foobar.com") # TRUE z$matches("http://foobar.com/") # TRUE # without scheme ## matches http by default: does not match https by default (z <- UriPattern$new(pattern = "foobar.com")) z$matches("http://foobar.com") # TRUE z$matches("http://foobar.com/") # TRUE z$matches("https://foobar.com") # FALSE z$matches("https://foobar.com/") # FALSE ## to match https, you'll have to give the complete url (z <- UriPattern$new(pattern = "https://foobar.com")) z$matches("https://foobar.com/") # TRUE z$matches("http://foobar.com/") # FALSE # default ports (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://foobar.com:80") # TRUE z$matches("http://foobar.com:80/") # TRUE z$matches("http://foobar.com:443") # TRUE z$matches("http://foobar.com:443/") # TRUE # user info - FIXME, not sure we support this yet (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") # TRUE z$matches("http://example.com") # TRUE z$matches("http://tramples.net") # FALSE # add query parameters (z <- UriPattern$new(pattern = "http://foobar.com")) z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) z z$pattern z$matches("http://foobar.com?pizza=cheese&cheese=cheddar") # TRUE z$matches("http://foobar.com?pizza=cheese&cheese=swiss") # FALSE # query parameters in the uri (z <- UriPattern$new(pattern = "https://httpbin.org/get?stuff=things")) z$add_query_params() # have to run this method to gather query params z$matches("https://httpbin.org/get?stuff=things") # TRUE z$matches("https://httpbin.org/get?stuff2=things") # FALSE # regex add query parameters (z <- UriPattern$new(regex_pattern = "https://foobar.com/.+/order")) z$add_query_params(list(pizza = "cheese")) z z$pattern z$matches("https://foobar.com/pizzas/order?pizza=cheese") # TRUE z$matches("https://foobar.com/pizzas?pizza=cheese") # FALSE # query parameters in the regex uri (z <- UriPattern$new(regex_pattern = "https://x.com/.+/order\\\\?fruit=apple")) z$add_query_params() # have to run this method to gather query params z$matches("https://x.com/a/order?fruit=apple") # TRUE z$matches("https://x.com/a?fruit=apple") # FALSE # any pattern (z <- UriPattern$new(regex_pattern = "stuff\\\\.com.+")) z$regex z$pattern z$matches("http://stuff.com") # FALSE z$matches("https://stuff.com/stff") # TRUE z$matches("https://stuff.com/apple?bears=brown&bats=grey") # TRUE # partial matching ## including z <- UriPattern$new(pattern = "http://foobar.com") z$add_query_params(including(list(hello = "world"))) z$matches(uri = "http://foobar.com?hello=world&bye=mars") # TRUE z$matches("http://foobar.com?bye=mars") # FALSE ## excluding z <- UriPattern$new(pattern = "http://foobar.com") z$add_query_params(excluding(list(hello = "world"))) z$matches(uri = "http://foobar.com?hello=world&bye=mars") # FALSE z$matches("http://foobar.com?bye=mars") # TRUE ## match on list keys (aka: names) only, ignore values 0 z <- UriPattern$new(pattern = "http://foobar.com") z$add_query_params(including(list(hello = NULL))) z$matches(uri = "http://foobar.com?hello=world&bye=mars") # TRUE z$matches("http://foobar.com?hello=stuff") # TRUE z$matches("http://foobar.com?bye=stuff") # FALSE } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) pattern holder} \item{\code{regex}}{a logical} \item{\code{query_params}}{a list, or \code{NULL} if empty} \item{\code{partial}}{bool, default: \code{FALSE}} \item{\code{partial_type}}{a string, default: NULL} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-UriPattern-new}{\code{UriPattern$new()}} \item \href{#method-UriPattern-matches}{\code{UriPattern$matches()}} \item \href{#method-UriPattern-pattern_matches}{\code{UriPattern$pattern_matches()}} \item \href{#method-UriPattern-query_params_matches}{\code{UriPattern$query_params_matches()}} \item \href{#method-UriPattern-extract_query}{\code{UriPattern$extract_query()}} \item \href{#method-UriPattern-add_query_params}{\code{UriPattern$add_query_params()}} \item \href{#method-UriPattern-to_s}{\code{UriPattern$to_s()}} \item \href{#method-UriPattern-clone}{\code{UriPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{UriPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$new(pattern = NULL, regex_pattern = NULL)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) a uri, as a character string. if scheme is missing, it is added (we assume http)} \item{\code{regex_pattern}}{(character) a uri as a regex character string, see \link[base:regex]{base::regex}. if scheme is missing, it is added (we assume http)} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{UriPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-matches}{}}} \subsection{Method \code{matches()}}{ Match a uri against a pattern \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$matches(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-pattern_matches}{}}} \subsection{Method \code{pattern_matches()}}{ Match a URI \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$pattern_matches(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-query_params_matches}{}}} \subsection{Method \code{query_params_matches()}}{ Match query parameters of a URI \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$query_params_matches(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-extract_query}{}}} \subsection{Method \code{extract_query()}}{ Extract query parameters as a named list \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$extract_query(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ named list, or \code{NULL} if no query parameters } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-add_query_params}{}}} \subsection{Method \code{add_query_params()}}{ Add query parameters to the URI \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$add_query_params(query_params)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{query_params}}{(list|character) list or character} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned, updates uri pattern } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/mock_file.Rd0000644000176200001440000000075214431233520015056 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mock_file.R \name{mock_file} \alias{mock_file} \title{Mock file} \usage{ mock_file(path, payload) } \arguments{ \item{path}{(character) a file path. required} \item{payload}{(character) string to be written to the file given at \code{path} parameter. required} } \value{ a list with S3 class \code{mock_file} } \description{ Mock file } \examples{ mock_file(path = tempfile(), payload = "{\"foo\": \"bar\"}") } webmockr/man/HashCounter.Rd0000644000176200001440000000513714715656454015377 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \name{HashCounter} \alias{HashCounter} \title{HashCounter} \description{ hash with counter, to store requests, and count each time it is used } \examples{ x <- HashCounter$new() x$hash z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") x$put(z) x$hash x$get(z) x$put(z) x$get(z) } \seealso{ Other request-registry: \code{\link{RequestRegistry}}, \code{\link{request_registry}()} } \concept{request-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{hash}}{(list) a list for internal use only, with elements \code{key}, \code{sig}, and \code{count}} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HashCounter-put}{\code{HashCounter$put()}} \item \href{#method-HashCounter-get}{\code{HashCounter$get()}} \item \href{#method-HashCounter-clone}{\code{HashCounter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HashCounter-put}{}}} \subsection{Method \code{put()}}{ Register a request by it's key \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HashCounter$put(req_sig)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req_sig}}{an object of class \code{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers request and iterates internal counter } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HashCounter-get}{}}} \subsection{Method \code{get()}}{ Get a request by key \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HashCounter$get(req_sig)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req_sig}}{an object of class \code{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ (integer) the count of how many times the request has been made } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HashCounter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HashCounter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/Response.Rd0000644000176200001440000002336014752052374014740 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Response.R \name{Response} \alias{Response} \title{Response} \description{ custom webmockr http response class } \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() # raw body x$set_body(charToRaw("hello world")) x x$get_body() x$set_exception("exception") x x$get_exception() } } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{url}}{(character) a url} \item{\code{body}}{(various) list, character, etc} \item{\code{content}}{(various) response content/body} \item{\code{request_headers}}{(list) a named list} \item{\code{response_headers}}{(list) a named list} \item{\code{options}}{(character) list} \item{\code{status_code}}{(integer) an http status code} \item{\code{exception}}{(character) an exception message} \item{\code{should_timeout}}{(logical) should the response timeout?} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-Response-new}{\code{Response$new()}} \item \href{#method-Response-print}{\code{Response$print()}} \item \href{#method-Response-set_url}{\code{Response$set_url()}} \item \href{#method-Response-get_url}{\code{Response$get_url()}} \item \href{#method-Response-set_request_headers}{\code{Response$set_request_headers()}} \item \href{#method-Response-get_request_headers}{\code{Response$get_request_headers()}} \item \href{#method-Response-set_response_headers}{\code{Response$set_response_headers()}} \item \href{#method-Response-get_respone_headers}{\code{Response$get_respone_headers()}} \item \href{#method-Response-set_body}{\code{Response$set_body()}} \item \href{#method-Response-get_body}{\code{Response$get_body()}} \item \href{#method-Response-set_status}{\code{Response$set_status()}} \item \href{#method-Response-get_status}{\code{Response$get_status()}} \item \href{#method-Response-set_exception}{\code{Response$set_exception()}} \item \href{#method-Response-get_exception}{\code{Response$get_exception()}} \item \href{#method-Response-clone}{\code{Response$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{Response} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$new(options = list())}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{options}}{(list) a list of options} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{Response} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{Response} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_url}{}}} \subsection{Method \code{set_url()}}{ set the url for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_url(url)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{url}}{(character) a url} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets url } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_url}{}}} \subsection{Method \code{get_url()}}{ get the url for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_url()}\if{html}{\out{
}} } \subsection{Returns}{ (character) a url } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_request_headers}{}}} \subsection{Method \code{set_request_headers()}}{ set the request headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_request_headers(headers, capitalize = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{(list) named list} \item{\code{capitalize}}{(logical) whether to capitalize first letters of each header; default: \code{TRUE}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets request headers on the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_request_headers}{}}} \subsection{Method \code{get_request_headers()}}{ get the request headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_request_headers()}\if{html}{\out{
}} } \subsection{Returns}{ (list) request headers, a named list } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_response_headers}{}}} \subsection{Method \code{set_response_headers()}}{ set the response headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_response_headers(headers, capitalize = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{(list) named list} \item{\code{capitalize}}{(logical) whether to capitalize first letters of each header; default: \code{TRUE}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets response headers on the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_respone_headers}{}}} \subsection{Method \code{get_respone_headers()}}{ get the response headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_respone_headers()}\if{html}{\out{
}} } \subsection{Returns}{ (list) response headers, a named list } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_body}{}}} \subsection{Method \code{set_body()}}{ set the body of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_body(body, disk = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{body}}{(various types)} \item{\code{disk}}{(logical) whether its on disk; default: \code{FALSE}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets body on the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_body}{}}} \subsection{Method \code{get_body()}}{ get the body of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_body()}\if{html}{\out{
}} } \subsection{Returns}{ various } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_status}{}}} \subsection{Method \code{set_status()}}{ set the http status of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_status(status)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{status}}{(integer) the http status} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets the http status of the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_status}{}}} \subsection{Method \code{get_status()}}{ get the http status of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_status()}\if{html}{\out{
}} } \subsection{Returns}{ (integer) the http status } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_exception}{}}} \subsection{Method \code{set_exception()}}{ set an exception \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_exception(exception)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{exception}}{(character) an exception string} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets an exception } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_exception}{}}} \subsection{Method \code{get_exception()}}{ get the exception, if set \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_exception()}\if{html}{\out{
}} } \subsection{Returns}{ (character) an exception } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/MethodPattern.Rd0000644000176200001440000000576214715656454015736 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{MethodPattern} \alias{MethodPattern} \title{MethodPattern} \description{ method matcher } \details{ 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") # all matches() calls should be TRUE (x <- MethodPattern$new(pattern = "any")) x$pattern x$matches(method = "post") x$matches(method = "GET") x$matches(method = "HEAD") } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) an http method} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-MethodPattern-new}{\code{MethodPattern$new()}} \item \href{#method-MethodPattern-matches}{\code{MethodPattern$matches()}} \item \href{#method-MethodPattern-to_s}{\code{MethodPattern$to_s()}} \item \href{#method-MethodPattern-clone}{\code{MethodPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{MethodPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$new(pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) a HTTP method, lowercase} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{MethodPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-matches}{}}} \subsection{Method \code{matches()}}{ test if the pattern matches a given http method \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$matches(method)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(character) a HTTP method, lowercase} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/build_crul_response.Rd0000644000176200001440000000053014113773445017176 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \name{build_crul_response} \alias{build_crul_response} \title{Build a crul response} \usage{ build_crul_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ a crul response } \description{ Build a crul response } webmockr/man/to_timeout.Rd0000644000176200001440000000102514113773445015324 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/to_timeout.R \name{to_timeout} \alias{to_timeout} \title{Set timeout as an expected return on a match} \usage{ to_timeout(.data) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set timeout as an expected return on a match } \note{ see examples in \code{\link[=stub_request]{stub_request()}} } webmockr/man/webmockr_configure.Rd0000644000176200001440000000450714752052374017016 0ustar liggesusers% 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_allow_net_connect} \alias{webmockr_disable_net_connect} \alias{webmockr_net_connect_allowed} \title{webmockr configuration} \usage{ webmockr_configure( allow_net_connect = FALSE, allow_localhost = FALSE, allow = NULL, show_stubbing_instructions = TRUE, show_body_diff = FALSE ) webmockr_configure_reset() webmockr_configuration() webmockr_allow_net_connect() webmockr_disable_net_connect(allow = NULL) webmockr_net_connect_allowed(uri = NULL) } \arguments{ \item{allow_net_connect}{(logical) Default: \code{FALSE}} \item{allow_localhost}{(logical) Default: \code{FALSE}} \item{allow}{(character) one or more URI/URL to allow (and by extension all others are not allowed)} \item{show_stubbing_instructions}{(logical) Default: \code{TRUE}. If \code{FALSE}, stubbing instructions are not shown} \item{show_body_diff}{(logical) Default: \code{FALSE}. If \code{TRUE} show's a diff of the stub's request body and the http request body. See also \code{\link[=stub_body_diff]{stub_body_diff()}} for manually comparing request and stub bodies. Under the hood the Suggested package \code{diffobj} is required to do the comparison.} \item{uri}{(character) a URI/URL as a character string - to determine whether or not it is allowed} } \description{ webmockr configuration } \section{webmockr_allow_net_connect}{ If there are stubs found for a request, even if net connections are allowed (by running \code{webmockr_allow_net_connect()}) the stubbed response will be returned. If no stub is found, and net connections are allowed, then a real HTTP request can be made. } \examples{ \dontrun{ webmockr_configure() webmockr_configure( allow_localhost = TRUE ) webmockr_configuration() webmockr_configure_reset() webmockr_allow_net_connect() webmockr_net_connect_allowed() # disable net connect for any URIs webmockr_disable_net_connect() ### gives NULL with no URI passed webmockr_net_connect_allowed() # disable net connect EXCEPT FOR given URIs webmockr_disable_net_connect(allow = "google.com") ### is a specific URI allowed? webmockr_net_connect_allowed("google.com") # show body diff webmockr_configure(show_body_diff = TRUE) } } webmockr/man/HttpLibAdapaterRegistry.Rd0000644000176200001440000000472414715656454017716 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/HttpLibAdapterRegistry.R \name{HttpLibAdapaterRegistry} \alias{HttpLibAdapaterRegistry} \title{HttpLibAdapaterRegistry} \description{ http lib adapter registry } \examples{ x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) x x$adapters x$adapters[[1]]$name } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{adapters}}{list} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HttpLibAdapaterRegistry-print}{\code{HttpLibAdapaterRegistry$print()}} \item \href{#method-HttpLibAdapaterRegistry-register}{\code{HttpLibAdapaterRegistry$register()}} \item \href{#method-HttpLibAdapaterRegistry-clone}{\code{HttpLibAdapaterRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttpLibAdapaterRegistry-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{HttpLibAdapaterRegistry} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttpLibAdapaterRegistry$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttpLibAdapaterRegistry-register}{}}} \subsection{Method \code{register()}}{ Register an http library adapter \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttpLibAdapaterRegistry$register(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{an http lib adapter, e.g., \link{CrulAdapter}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing, registers the library adapter } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttpLibAdapaterRegistry-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttpLibAdapaterRegistry$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/to_raise.Rd0000644000176200001440000000306614752052374014750 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/to_raise.R \name{to_raise} \alias{to_raise} \title{Set raise error condition} \usage{ to_raise(.data, ...) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} \item{...}{One or more HTTP exceptions from the \pkg{fauxpas} package. Run \code{grep("HTTP*", getNamespaceExports("fauxpas"), value = TRUE)} for a list of possible exceptions} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set raise error condition } \details{ The behavior in the future will be: When multiple exceptions are passed, the first is used on the first mock, the second on the second mock, and so on. Subsequent mocks use the last exception But for now, only the first exception is used until we get that fixed } \note{ see examples in \code{\link[=stub_request]{stub_request()}} } \section{Raise vs. Return}{ \code{to_raise()} always raises a stop condition, while \code{to_return(status=xyz)} only sets the status code on the returned HTTP response object. So if you want to raise a stop condition then \code{to_raise()} is what you want. But if you don't want to raise a stop condition use \code{to_return()}. Use cases for each vary. For example, in a unit test you may have a test expecting a 503 error; in this case \code{to_raise()} makes sense. In another case, if a unit test expects to test some aspect of an HTTP response object that httr, httr2, or crul typically returns, then you'll want \code{to_return()}. } webmockr/man/Adapter.Rd0000644000176200001440000002651014752052374014522 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R, R/adapter-httr.R, % R/adapter-httr2.R, R/adapter.R \name{CrulAdapter} \alias{CrulAdapter} \alias{HttrAdapter} \alias{Httr2Adapter} \alias{Adapter} \title{Adapters for Modifying HTTP Requests} \description{ \code{Adapter} is the base parent class used to implement \pkg{webmockr} support for different HTTP clients. It should not be used directly. Instead, use one of the client-specific adapters that webmockr currently provides: \itemize{ \item \code{CrulAdapter} for \pkg{crul} \item \code{HttrAdapter} for \pkg{httr} \item \code{Httr2Adapter} for \pkg{httr2} } } \details{ Note that the documented fields and methods are the same across all client-specific adapters. } \examples{ \dontrun{ if (requireNamespace("httr", quietly = TRUE)) { # library(httr) # normal httr request, works fine # real <- GET("https://httpbin.org/get") # real # with webmockr # library(webmockr) ## turn on httr mocking # httr_mock() ## now this request isn't allowed # GET("https://httpbin.org/get") ## stub the request # stub_request('get', uri = 'https://httpbin.org/get') \%>\% # wi_th( # headers = list( # 'Accept' = 'application/json, text/xml, application/xml, */*' # ) # ) \%>\% # to_return(status = 418, body = "I'm a teapot!", headers = list(a = 5)) ## now the request succeeds and returns a mocked response # (res <- GET("https://httpbin.org/get")) # res$status_code # rawToChar(res$content) # allow real requests while webmockr is loaded # webmockr_allow_net_connect() # webmockr_net_connect_allowed() # GET("https://httpbin.org/get?animal=chicken") # webmockr_disable_net_connect() # webmockr_net_connect_allowed() # GET("https://httpbin.org/get?animal=chicken") # httr_mock(FALSE) } } } \section{Super class}{ \code{\link[webmockr:Adapter]{webmockr::Adapter}} -> \code{CrulAdapter} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-CrulAdapter-clone}{\code{CrulAdapter$clone()}} } } \if{html}{\out{
Inherited methods
}} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CrulAdapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{CrulAdapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } \section{Super class}{ \code{\link[webmockr:Adapter]{webmockr::Adapter}} -> \code{HttrAdapter} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HttrAdapter-clone}{\code{HttrAdapter$clone()}} } } \if{html}{\out{
Inherited methods
}} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttrAdapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttrAdapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } \section{Super class}{ \code{\link[webmockr:Adapter]{webmockr::Adapter}} -> \code{Httr2Adapter} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-Httr2Adapter-clone}{\code{Httr2Adapter$clone()}} } } \if{html}{\out{
Inherited methods
}} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Httr2Adapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Httr2Adapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-Adapter-new}{\code{Adapter$new()}} \item \href{#method-Adapter-enable}{\code{Adapter$enable()}} \item \href{#method-Adapter-disable}{\code{Adapter$disable()}} \item \href{#method-Adapter-handle_request}{\code{Adapter$handle_request()}} \item \href{#method-Adapter-remove_stubs}{\code{Adapter$remove_stubs()}} \item \href{#method-Adapter-clone}{\code{Adapter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-new}{}}} \subsection{Method \code{new()}}{ Create a new Adapter object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$new()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-enable}{}}} \subsection{Method \code{enable()}}{ Enable the adapter \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$enable(quiet = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{quiet}}{(logical) suppress messages? default: \code{FALSE}} } \if{html}{\out{
}} } \subsection{Returns}{ \code{TRUE}, invisibly } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-disable}{}}} \subsection{Method \code{disable()}}{ Disable the adapter \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$disable(quiet = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{quiet}}{(logical) suppress messages? default: \code{FALSE}} } \if{html}{\out{
}} } \subsection{Returns}{ \code{FALSE}, invisibly } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-handle_request}{}}} \subsection{Method \code{handle_request()}}{ All logic for handling a request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$handle_request(req)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req}}{a request} } \if{html}{\out{
}} } \subsection{Returns}{ various outcomes } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-remove_stubs}{}}} \subsection{Method \code{remove_stubs()}}{ Remove all stubs \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$remove_stubs()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; removes all request stubs } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/to_return_-defunct.Rd0000644000176200001440000000036614113773445016751 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{to_return_} \alias{to_return_} \title{This function is defunct.} \usage{ to_return_(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/RequestPattern.Rd0000644000176200001440000001263414752656551016141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{RequestPattern} \alias{RequestPattern} \title{RequestPattern class} \description{ class handling all request matchers } \examples{ \dontrun{ (x <- RequestPattern$new(method = "get", uri = "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 = "http://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() ## query params included in url, not separately (x <- RequestPattern$new( method = "get", uri = "https://httpbin.org/get?stuff=things" )) x$to_s() x$query_params # just headers (via setting method=any & uri_regex=.+) headers <- list( "User-Agent" = "Apple", "Accept-Encoding" = "gzip, deflate", "Accept" = "application/json, text/xml, application/xml, */*" ) x <- RequestPattern$new( method = "any", uri_regex = ".+", headers = headers ) x$to_s() rs <- RequestSignature$new( method = "any", uri = "http://foo.bar", options = list(headers = headers) ) rs x$matches(rs) # body x <- RequestPattern$new( method = "post", uri = "httpbin.org/post", body = list(y = crul::upload(system.file("CITATION"))) ) x$to_s() rs <- RequestSignature$new( method = "post", uri = "http://httpbin.org/post", options = list( body = list(y = crul::upload(system.file("CITATION"))) ) ) rs x$matches(rs) # basic auth x <- RequestPattern$new( method = "post", uri = "httpbin.org/post", basic_auth = c("user", "pass") ) x x$headers_pattern$to_s() x$to_s() rs <- RequestSignature$new( method = "post", uri = "http://httpbin.org/post", options = list(headers = prep_auth("user:pass")) ) rs x$matches(rs) # TRUE rs <- RequestSignature$new( method = "post", uri = "http://httpbin.org/post", options = list(headers = prep_auth("user:longpassword")) ) x$matches(rs) # FALSE } } \seealso{ pattern classes for HTTP method \link{MethodPattern}, headers \link{HeadersPattern}, body \link{BodyPattern}, and URI/URL \link{UriPattern} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{method_pattern}}{xxx} \item{\code{uri_pattern}}{xxx} \item{\code{body_pattern}}{xxx} \item{\code{headers_pattern}}{xxx} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-RequestPattern-new}{\code{RequestPattern$new()}} \item \href{#method-RequestPattern-matches}{\code{RequestPattern$matches()}} \item \href{#method-RequestPattern-to_s}{\code{RequestPattern$to_s()}} \item \href{#method-RequestPattern-clone}{\code{RequestPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{RequestPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$new( method, uri = NULL, uri_regex = NULL, query = NULL, body = NULL, headers = NULL, basic_auth = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{the HTTP method (any, head, options, get, post, put, patch, trace, or delete). "any" matches any HTTP method. required.} \item{\code{uri}}{(character) request URI. required or uri_regex} \item{\code{uri_regex}}{(character) request URI as regex. required or uri} \item{\code{query}}{(list) query parameters, optional} \item{\code{body}}{(list) body request, optional} \item{\code{headers}}{(list) headers, optional} \item{\code{basic_auth}}{(list) vector of length 2 (username, password), optional} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{RequestPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-matches}{}}} \subsection{Method \code{matches()}}{ does a request signature match the selected matchers? \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$matches(request_signature)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_signature}}{a \link{RequestSignature} object} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/build_httr_request.Rd0000644000176200001440000000050714113773445017050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{build_httr_request} \alias{build_httr_request} \title{Build a httr request} \usage{ build_httr_request(x) } \arguments{ \item{x}{an unexecuted httr request object} } \value{ a httr request } \description{ Build a httr request } webmockr/man/webmockr-defunct.Rd0000644000176200001440000000112114113773445016370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{webmockr-defunct} \alias{webmockr-defunct} \title{Defunct functions in \pkg{webmockr}} \description{ \itemize{ \item \code{\link[=webmockr_enable]{webmockr_enable()}}: Function removed, see \code{\link[=enable]{enable()}} \item \code{\link[=webmockr_disable]{webmockr_disable()}}: Function removed, see \code{\link[=disable]{disable()}} \item \link{to_return_}: Only \code{\link[=to_return]{to_return()}} is available now \item \link{wi_th_}: Only \code{\link[=wi_th]{wi_th()}} is available now } } webmockr/man/RequestSignature.Rd0000644000176200001440000001023214715656454016456 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestSignature.R \name{RequestSignature} \alias{RequestSignature} \title{RequestSignature} \description{ General purpose request signature builder } \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 w <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) w w$headers w$to_s() # headers and body bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( headers = list(`User-Agent` = "foobar", stuff = "things"), body = list(a = "tables") ) ) bb bb$headers bb$body bb$to_s() # with disk path f <- tempfile() bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(disk = f) ) bb bb$disk bb$to_s() } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(character) an http method} \item{\code{uri}}{(character) a uri} \item{\code{body}}{(various) request body} \item{\code{headers}}{(list) named list of headers} \item{\code{proxies}}{(list) proxies as a named list} \item{\code{auth}}{(list) authentication details, as a named list} \item{\code{url}}{internal use} \item{\code{disk}}{(character) if writing to disk, the path} \item{\code{fields}}{(various) request body details} \item{\code{output}}{(various) request output details, disk, memory, etc} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-RequestSignature-new}{\code{RequestSignature$new()}} \item \href{#method-RequestSignature-print}{\code{RequestSignature$print()}} \item \href{#method-RequestSignature-to_s}{\code{RequestSignature$to_s()}} \item \href{#method-RequestSignature-clone}{\code{RequestSignature$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{RequestSignature} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$new(method, uri, options = list())}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{the HTTP method (any, head, options, get, post, put, patch, trace, or delete). "any" matches any HTTP method. required.} \item{\code{uri}}{(character) request URI. required.} \item{\code{options}}{(list) options. optional. See Details.} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{RequestSignature} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{RequestSignature} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$print()}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-to_s}{}}} \subsection{Method \code{to_s()}}{ Request signature to a string \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a character string representation of the request signature } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/RequestRegistry.Rd0000644000176200001440000001171414752656551016332 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \name{RequestRegistry} \alias{RequestRegistry} \title{RequestRegistry} \description{ keeps track of HTTP requests } \examples{ x <- RequestRegistry$new() z1 <- RequestSignature$new("get", "http://scottchamberlain.info") z2 <- RequestSignature$new("post", "https://httpbin.org/post") x$register_request(request = z1) x$register_request(request = z1) x$register_request(request = z2) # print method to list requests x # more complex requests w <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) w$to_s() x$register_request(request = w) x # hashes, and number of times each requested x$request_signatures$hash # times_executed method pat <- RequestPattern$new( method = "get", uri = "https:/httpbin.org/get", headers = list(`User-Agent` = "foobar", stuff = "things") ) pat$to_s() x$times_executed(pat) z <- RequestPattern$new(method = "get", uri = "http://scottchamberlain.info") x$times_executed(z) w <- RequestPattern$new(method = "post", uri = "https://httpbin.org/post") x$times_executed(w) ## pattern with no matches - returns 0 (zero) pat <- RequestPattern$new( method = "get", uri = "http://recology.info/" ) pat$to_s() x$times_executed(pat) # reset the request registry x$reset() } \seealso{ \code{\link[=stub_registry]{stub_registry()}} and \link{StubRegistry} Other request-registry: \code{\link{HashCounter}}, \code{\link{request_registry}()} } \concept{request-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{request_signatures}}{a HashCounter object} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-RequestRegistry-print}{\code{RequestRegistry$print()}} \item \href{#method-RequestRegistry-reset}{\code{RequestRegistry$reset()}} \item \href{#method-RequestRegistry-register_request}{\code{RequestRegistry$register_request()}} \item \href{#method-RequestRegistry-times_executed}{\code{RequestRegistry$times_executed()}} \item \href{#method-RequestRegistry-clone}{\code{RequestRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{RequestRegistry} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-reset}{}}} \subsection{Method \code{reset()}}{ Reset the registry to no registered requests \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$reset()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; resets registry to no requests } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-register_request}{}}} \subsection{Method \code{register_request()}}{ Register a request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$register_request(request)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request}}{a character string of the request, serialized from a \code{RequestSignature$new(...)$to_s()}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers the request } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-times_executed}{}}} \subsection{Method \code{times_executed()}}{ How many times has a request been made \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$times_executed(request_pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_pattern}}{an object of class \code{RequestPattern}} } \if{html}{\out{
}} } \subsection{Details}{ if no match is found for the request pattern, 0 is returned } \subsection{Returns}{ integer, the number of times the request has been made } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/last_stub.Rd0000644000176200001440000000125714715656454015153 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/last.R \name{last_stub} \alias{last_stub} \title{Get the last stub created} \usage{ last_stub() } \value{ \code{NULL} if no stubs found; otherwise the last stub created as a \code{StubbedRequest} class } \description{ Get the last stub created } \examples{ \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # no requests stub_registry_clear() last_stub() # a stub is found stub_request("head", "https://nytimes.com") last_stub() stub_request("post", "https://nytimes.com/stories") last_stub() # cleanup stub_registry_clear() \dontshow{\}) # examplesIf} } webmockr/man/build_httr2_request.Rd0000644000176200001440000000053014715656454017136 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr2.R \name{build_httr2_request} \alias{build_httr2_request} \title{Build an httr2 request} \usage{ build_httr2_request(x) } \arguments{ \item{x}{an unexecuted httr2 request object} } \value{ a \code{httr2_request} } \description{ Build an httr2 request } webmockr/man/HeadersPattern.Rd0000644000176200001440000001045714715656454016066 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{HeadersPattern} \alias{HeadersPattern} \title{HeadersPattern} \description{ headers matcher } \details{ \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")) headers <- list( "User-Agent" = "Apple", "Accept-Encoding" = "gzip, deflate", "Accept" = "application/json, text/xml, application/xml, */*" ) (x <- HeadersPattern$new(pattern = headers)) x$to_s() x$pattern x$matches(headers) } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{a list} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HeadersPattern-new}{\code{HeadersPattern$new()}} \item \href{#method-HeadersPattern-matches}{\code{HeadersPattern$matches()}} \item \href{#method-HeadersPattern-empty_headers}{\code{HeadersPattern$empty_headers()}} \item \href{#method-HeadersPattern-to_s}{\code{HeadersPattern$to_s()}} \item \href{#method-HeadersPattern-clone}{\code{HeadersPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{HeadersPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$new(pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(list) a pattern, as a named list, must be named, e.g,. \code{list(a = 5, b = 6)}} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{HeadersPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-matches}{}}} \subsection{Method \code{matches()}}{ Match a list of headers against that stored \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$matches(headers)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{(list) named list of headers, e.g,. \code{list(a = 5, b = 6)}} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-empty_headers}{}}} \subsection{Method \code{empty_headers()}}{ Are headers empty? tests if null or length==0 \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$empty_headers(headers)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{named list of headers} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/to_return.Rd0000644000176200001440000001015014752656551015163 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/to_return.R \name{to_return} \alias{to_return} \title{Expectation for what's returned from a stubbed request} \usage{ to_return(.data, ..., .list = list(), times = 1) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} \item{...}{Comma separated list of named variables. accepts the following: \code{status}, \code{body}, \code{headers}. See Details for more.} \item{.list}{named list, has to be one of 'status', 'body', and/or 'headers'. An alternative to passing in via \code{...}. Don't pass the same thing to both, e.g. don't pass 'status' to \code{...}, and also 'status' to this parameter} \item{times}{(integer) number of times the given response should be returned; default: 1. value must be greater than or equal to 1. Very large values probably don't make sense, but there's no maximum value. See Details.} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set response status code, response body, and/or response headers } \details{ Values for status, body, and headers: \itemize{ \item status: (numeric/integer) three digit status code \item body: various: \code{character}, \code{json}, \code{list}, \code{raw}, \code{numeric}, \code{NULL}, \code{FALSE}, a file connection (other connetion types not supported), or a \code{mock_file} function call (see \code{\link[=mock_file]{mock_file()}}) \item headers: (list) a named list, must be named } response headers are returned with all lowercase names and the values are all of type character. if numeric/integer values are given (e.g., \code{to_return(headers = list(a = 10))}), we'll coerce any numeric/integer values to character. } \note{ see more examples in \code{\link[=stub_request]{stub_request()}} } \section{multiple \code{to_return()}}{ You can add more than one \code{to_return()} to a webmockr stub (including \code{\link[=to_raise]{to_raise()}}, \code{\link[=to_timeout]{to_timeout()}}). Each one is a HTTP response returned. That is, you'll match to an HTTP request based on \code{stub_request()} and \code{wi_th()}; the first time the request is made, the first response is returned; the second time the request is made, the second response is returned; and so on. Be aware that webmockr has to track number of requests (see \code{\link[=request_registry]{request_registry()}}), and so if you use multiple \code{to_return()} or the \code{times} parameter, you must clear the request registry in order to go back to mocking responses from the start again. \code{\link[=webmockr_reset]{webmockr_reset()}} clears the stub registry and the request registry, after which you can use multiple responses again (after creating your stub(s) again of course) } \section{Raise vs. Return}{ \code{to_raise()} always raises a stop condition, while \code{to_return(status=xyz)} only sets the status code on the returned HTTP response object. So if you want to raise a stop condition then \code{to_raise()} is what you want. But if you don't want to raise a stop condition use \code{to_return()}. Use cases for each vary. For example, in a unit test you may have a test expecting a 503 error; in this case \code{to_raise()} makes sense. In another case, if a unit test expects to test some aspect of an HTTP response object that httr, httr2, or crul typically returns, then you'll want \code{to_return()}. } \examples{ # first, make a stub object foo <- function() { stub_request("post", "https://httpbin.org/post") } # add status, body and/or headers foo() \%>\% to_return(status = 200) foo() \%>\% to_return(body = "stuff") foo() \%>\% to_return(body = list(a = list(b = "world"))) foo() \%>\% to_return(headers = list(a = 5)) foo() \%>\% to_return(status = 200, body = "stuff", headers = list(a = 5)) # .list - pass in a named list instead foo() \%>\% to_return(.list = list(body = list(foo = "bar"))) # multiple responses using chained `to_return()` foo() \%>\% to_return(body = "stuff") \%>\% to_return(body = "things") # many of the same response using the times parameter foo() \%>\% to_return(body = "stuff", times = 3) } webmockr/man/mocking-disk-writing.Rd0000644000176200001440000000572214752052374017204 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mocking-disk-writing.R \name{mocking-disk-writing} \alias{mocking-disk-writing} \title{Mocking writing to disk} \description{ Mocking writing to disk } \examples{ \dontrun{ # enable mocking enable() # getOption('httr2_mock') # Write to a file before mocked request # crul library(crul) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) readLines(f) ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = file(f)) ## make a request (out <- HttpClient$new("https://httpbin.org/get")$get(disk = f)) out$content readLines(out$content) # httr library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) readLines(f) ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return( body = file(f), headers = list("content-type" = "application/json") ) ## make a request ## with httr, you must set overwrite=TRUE or you'll get an errror out <- GET("https://httpbin.org/get", write_disk(f, overwrite = TRUE)) out out$content content(out, "text", encoding = "UTF-8") # httr2 library(httr2) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) readLines(f) ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return( body = file(f), headers = list("content-type" = "application/json") ) ## make a request req <- request("https://httpbin.org/get") out <- req_perform(req, path = f) out out$body out out$headers readLines(out$body) # Use mock_file to have webmockr handle file and contents # crul library(crul) f <- tempfile(fileext = ".json") ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = mock_file(f, "{\"hello\":\"mars\"}\n")) ## make a request (out <- crul::HttpClient$new("https://httpbin.org/get")$get(disk = f)) out$content readLines(out$content) # httr library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return( body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), headers = list("content-type" = "application/json") ) ## make a request out <- GET("https://httpbin.org/get", write_disk(f)) out ## view stubbed file content out$content readLines(out$content) content(out, "text", encoding = "UTF-8") # httr2 library(httr2) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return( body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), headers = list("content-type" = "application/json") ) ## make a request req <- request("https://httpbin.org/get") out <- req_perform(req, path = f) out ## view stubbed file content out$body readLines(out$body) # disable mocking disable() } } webmockr/man/httr_mock.Rd0000644000176200001440000000074514715656454015146 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{httr_mock} \alias{httr_mock} \title{Turn on \code{httr} mocking} \usage{ httr_mock(on = TRUE) } \arguments{ \item{on}{(logical) set to \code{TRUE} to turn on, and \code{FALSE} to turn off. default: \code{TRUE}} } \value{ Silently returns \code{TRUE} when enabled and \code{FALSE} when disabled. } \description{ Sets a callback that routes \code{httr} requests through \code{webmockr} } webmockr/man/last_request.Rd0000644000176200001440000000136214715656454015663 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/last.R \name{last_request} \alias{last_request} \title{Get the last HTTP request made} \usage{ last_request() } \value{ \code{NULL} if no requests registered; otherwise the last registered request made as a \code{RequestSignature} class } \description{ Get the last HTTP request made } \examples{ \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # no requests request_registry_clear() last_request() # a request is found enable() stub_request("head", "https://nytimes.com") library(crul) crul::ok("https://nytimes.com") last_request() # cleanup request_registry_clear() stub_registry_clear() \dontshow{\}) # examplesIf} } webmockr/man/httr2_mock.Rd0000644000176200001440000000074014715656454015223 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr2.R \name{httr2_mock} \alias{httr2_mock} \title{Turn on \code{httr2} mocking} \usage{ httr2_mock(on = TRUE) } \arguments{ \item{on}{(logical) \code{TRUE} to turn on, \code{FALSE} to turn off. default: \code{TRUE}} } \value{ Silently returns \code{TRUE} when enabled and \code{FALSE} when disabled. } \description{ Sets a callback that routes \code{httr2} requests through \code{webmockr} } webmockr/man/build_httr2_response.Rd0000644000176200001440000000201314715656454017302 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr2.R \name{build_httr2_response} \alias{build_httr2_response} \title{Build a httr2 response (\code{httr2_response})} \usage{ build_httr2_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ an httr2 response (\code{httr2_response}) } \description{ Build a httr2 response (\code{httr2_response}) } \examples{ \dontrun{ # x <- Httr2Adapter$new() # library(httr2) # req <- request("https://r-project.org") # req = req \%>\% req_body_json(list(x = 1, y = 2)) # #req$method <- 'POST' # stub_request("post", "https://r-project.org") \%>\% # to_return(status = 418, body = list(a = 5)) # stub = webmockr_stub_registry$request_stubs[[1]] # stub$counter$.__enclos_env__$private$total <- 1 # resp = x$.__enclos_env__$private$build_stub_response(stub) # resp = x$.__enclos_env__$private$build_response(req, resp) # resp = x$.__enclos_env__$private$add_response_sequences(stub, resp) # out # out$body # out$content } } webmockr/man/handle_stub_removal.Rd0000644000176200001440000000107414715656454017165 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/error-handling.R \name{handle_stub_removal} \alias{handle_stub_removal} \title{Handle stub removal} \usage{ handle_stub_removal(.data, code) } \arguments{ \item{.data}{an object of class \code{StubbedRequest} required} \item{code}{a code block. required} } \value{ if no error, the result of running \code{code}; if an error occurs \code{\link[=withCallingHandlers]{withCallingHandlers()}} throws a warning and then the stub is removed } \description{ Handle stub removal } \keyword{internal} webmockr/man/stub_registry_clear.Rd0000644000176200001440000000110014113773445017201 0ustar liggesusers% 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{stub_registry_clear} \usage{ stub_registry_clear() } \value{ an empty list invisibly } \description{ Clear all stubs in the stub registry } \examples{ (x <- stub_request("get", "https://httpbin.org/get")) stub_registry() stub_registry_clear() stub_registry() } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}()}, \code{\link{stub_registry}()} } \concept{stub-registry} webmockr/man/stub_registry.Rd0000644000176200001440000000165414113773445016051 0ustar liggesusers% 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 } \examples{ # make a stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = "success!", status = 200) # check the stub registry, there should be one in there stub_registry() # make another stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = "woopsy", status = 404) # check the stub registry, now there are two there stub_registry() # to clear the stub registry stub_registry_clear() } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}()}, \code{\link{stub_registry_clear}()} } \concept{stub-registry} webmockr/man/webmockr_enable-defunct.Rd0000644000176200001440000000040514113773445017702 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{webmockr_enable} \alias{webmockr_enable} \title{This function is defunct.} \usage{ webmockr_enable(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/remove_request_stub.Rd0000644000176200001440000000124714715656454017254 0ustar liggesusers% 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}()}, \code{\link{stub_registry_clear}()} } \concept{stub-registry} webmockr/man/build_httr_response.Rd0000644000176200001440000000053014113773445017212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{build_httr_response} \alias{build_httr_response} \title{Build a httr response} \usage{ build_httr_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ a httr response } \description{ Build a httr response } webmockr/man/StubCounter.Rd0000644000176200001440000000445514715656454015433 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubbedRequest.R \name{StubCounter} \alias{StubCounter} \title{StubCounter} \description{ hash with counter to store requests and count number of requests made against the stub } \examples{ x <- StubCounter$new() x x$hash x$count() z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") x$put(z) x$count() x$put(z) x$count() } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{hash}}{(list) a list for internal use only, with elements \code{key}, \code{sig}, and \code{count}} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-StubCounter-put}{\code{StubCounter$put()}} \item \href{#method-StubCounter-count}{\code{StubCounter$count()}} \item \href{#method-StubCounter-clone}{\code{StubCounter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubCounter-put}{}}} \subsection{Method \code{put()}}{ Register a request by it's key \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubCounter$put(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{an object of class \code{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers request & iterates internal counter } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubCounter-count}{}}} \subsection{Method \code{count()}}{ Get the count of number of times any matching request has been made against this stub \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubCounter$count()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubCounter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubCounter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/including.Rd0000644000176200001440000000304514715656454015124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/partial.R \name{including} \alias{including} \alias{partial} \alias{excluding} \title{Partially match request query parameters or request bodies} \usage{ including(x) excluding(x) } \arguments{ \item{x}{(list) a list; may support other classes in the future} } \value{ same as \code{x}, but with two attributes added: \itemize{ \item partial_match: always \code{TRUE} \item partial_type: the type of match, one of \code{include} or \code{exclude} } } \description{ For use inside \code{\link[=wi_th]{wi_th()}} } \section{Headers}{ Matching on headers already handles partial matching. That is, \code{wi_th(headers = list(Fruit = "pear"))} matches any request that has any request header that matches - the request can have other request headers, but those don't matter as long as there is a match. These helpers (\code{including}/\code{excluding}) are needed for query parameters and bodies because by default matching must be exact for those. } \examples{ including(list(foo = "bar")) excluding(list(foo = "bar")) # get just keys by setting values as NULL including(list(foo = NULL, bar = NULL)) # in a stub req <- stub_request("get", "https://httpbin.org/get") req ## query wi_th(req, query = list(foo = "bar")) wi_th(req, query = including(list(foo = "bar"))) wi_th(req, query = excluding(list(foo = "bar"))) ## body wi_th(req, body = list(foo = "bar")) wi_th(req, body = including(list(foo = "bar"))) wi_th(req, body = excluding(list(foo = "bar"))) # cleanup stub_registry_clear() } webmockr/man/wi_th_-defunct.Rd0000644000176200001440000000035214113773445016035 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{wi_th_} \alias{wi_th_} \title{This function is defunct.} \usage{ wi_th_(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/webmockr-package.Rd0000644000176200001440000000327014752052374016342 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr-package.R \docType{package} \name{webmockr-package} \alias{webmockr} \alias{webmockr-package} \title{webmockr: 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. Can be used for unit tests or outside of a testing context. } \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 Supports multiple HTTP libraries, including \pkg{crul}, \pkg{httr}, and \pkg{httr2} \item Integration with HTTP test caching library \pkg{vcr} \item Supports async http request mocking with \pkg{crul} only } } \examples{ library(webmockr) stub_request("get", "https://httpbin.org/get") stub_request("post", "https://httpbin.org/post") stub_registry() } \seealso{ Useful links: \itemize{ \item \url{https://github.com/ropensci/webmockr} \item \url{https://books.ropensci.org/http-testing/} \item \url{https://docs.ropensci.org/webmockr/} \item Report bugs at \url{https://github.com/ropensci/webmockr/issues} } } \author{ \strong{Maintainer}: Scott Chamberlain \email{myrmecocystus+r@gmail.com} (\href{https://orcid.org/0000-0003-1444-9135}{ORCID}) Other contributors: \itemize{ \item Aaron Wolen (\href{https://orcid.org/0000-0003-2542-2202}{ORCID}) [contributor] \item rOpenSci (019jywm96) [funder] } } \keyword{internal} webmockr/man/wi_th.Rd0000644000176200001440000001006614715656454014263 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/wi_th.R \name{wi_th} \alias{wi_th} \title{Set additional parts of a stubbed request} \usage{ wi_th(.data, ..., .list = list()) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} \item{...}{Comma separated list of named variables. accepts the following: \code{query}, \code{body}, \code{headers}, \code{basic_auth}. See Details.} \item{.list}{named list, has to be one of \code{query}, \code{body}, \code{headers} and/or \code{basic_auth}. An alternative to passing in via \code{...}. Don't pass the same thing to both, e.g. don't pass 'query' to \code{...}, and also 'query' to this parameter} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set query params, request body, request headers and/or basic_auth } \details{ \code{with} is a function in the \code{base} package, so we went with \code{wi_th} Values for query, body, headers, and basic_auth: \itemize{ \item query: (list) a named list. values are coerced to character class in the recorded stub. You can pass numeric, integer, etc., but all will be coerced to character. \item body: various, including character string, list, raw, numeric, upload (\code{\link[crul:upload]{crul::upload()}}, \code{\link[httr:upload_file]{httr::upload_file()}}, \code{\link[curl:multipart]{curl::form_file()}}, or \code{\link[curl:multipart]{curl::form_data()}} they both create the same object in the end). for the special case of an empty request body use \code{NA} instead of \code{NULL} because with \code{NULL} we can't determine if the user did not supply a body or they supplied \code{NULL} to indicate an empty body. \item headers: (list) a named list \item basic_auth: (character) a length two vector, username and password. We don't do any checking of the username/password except to detect edge cases where for example, the username/password were probably not set by the user on purpose (e.g., a URL is picked up by an environment variable). Only basic authentication supported \url{https://en.wikipedia.org/wiki/Basic_access_authentication}. } Note that there is no regex matching on query, body, or headers. They are tested for matches in the following ways: \itemize{ \item query: compare stubs and requests with \code{identical()}. this compares named lists, so both list names and values are compared \item body: varies depending on the body format (list vs. character, etc.) \item headers: compare stub and request values with \code{==}. list names are compared with \code{\%in\%}. \code{basic_auth} is included in headers (with the name Authorization) } } \note{ see more examples in \code{\link[=stub_request]{stub_request()}} } \examples{ # first, make a stub object req <- stub_request("post", "https://httpbin.org/post") # add body # list wi_th(req, body = list(foo = "bar")) # string wi_th(req, body = '{"foo": "bar"}') # raw wi_th(req, body = charToRaw('{"foo": "bar"}')) # numeric wi_th(req, body = 5) # an upload wi_th(req, body = crul::upload(system.file("CITATION"))) # wi_th(req, body = httr::upload_file(system.file("CITATION"))) # add query - has to be a named list wi_th(req, query = list(foo = "bar")) # add headers - has to be a named list wi_th(req, headers = list(foo = "bar")) wi_th(req, headers = list(`User-Agent` = "webmockr/v1", hello = "world")) # .list - pass in a named list instead wi_th(req, .list = list(body = list(foo = "bar"))) # basic authentication wi_th(req, basic_auth = c("user", "pass")) wi_th(req, basic_auth = c("user", "pass"), headers = list(foo = "bar")) # partial matching, query params ## including wi_th(req, query = including(list(foo = "bar"))) ## excluding wi_th(req, query = excluding(list(foo = "bar"))) # partial matching, body ## including wi_th(req, body = including(list(foo = "bar"))) ## excluding wi_th(req, body = excluding(list(foo = "bar"))) # basic auth ## including wi_th(req, body = including(list(foo = "bar"))) ## excluding wi_th(req, body = excluding(list(foo = "bar"))) } \seealso{ \code{\link[=including]{including()}} } webmockr/man/stub_request.Rd0000644000176200001440000001754114752052374015673 0ustar liggesusers% 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 or partial uri. \pkg{webmockr} can match uri's without the "http" scheme, but does not match if the scheme is "https". required, unless \code{uri_regex} given. See \link{UriPattern} for more. See the "uri vs. uri_regex" section} \item{uri_regex}{(character) A URI represented as regex. required, if \code{uri} not given. See examples and the "uri vs. uri_regex" section} } \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 If multiple stubs match the same request, we use the first stub. So if you want to use a stub that was created after an earlier one that matches, remove the earlier one(s). Note on \code{wi_th()}: If you pass \code{query}, values are coerced to character class in the recorded stub. You can pass numeric, integer, etc., but all will be coerced to character. See \code{\link[=wi_th]{wi_th()}} for details on request body/query/headers and \code{\link[=to_return]{to_return()}} for details on how response status/body/headers are handled } \note{ Trailing slashes are dropped from stub URIs before matching } \section{uri vs. uri_regex}{ When you use \code{uri}, we compare the URIs without query params AND also the query params themselves without the URIs. When you use \code{uri_regex} we don't compare URIs and query params; we just use your regex string defined in \code{uri_regex} as the pattern for a call to \link{grepl} } \section{Mocking writing to disk}{ See \link{mocking-disk-writing} } \section{Error handling}{ To construct stubs, one uses \code{\link[=stub_request]{stub_request()}} first - which registers the stub in the stub registry. Any additional calls to modify the stub with for example \code{\link[=wi_th]{wi_th()}} or \code{\link[=to_return]{to_return()}} can error. In those error cases we ideally want to remove (unregister) the stub because you certainly don't want a registered stub that is not exactly what you intended. When you encounter an error creating a stub you should see a warning message that the stub has been removed, for example: \if{html}{\out{
}}\preformatted{stub_request("get", "https://httpbin.org/get") \%>\% wi_th(query = mtcars) #> Error in `wi_th()`: #> ! z$query must be of class list or partial #> Run `rlang::last_trace()` to see where the error occurred. #> Warning message: #> Encountered an error constructing stub #> • Removed stub #> • To see a list of stubs run stub_registry() }\if{html}{\out{
}} } \examples{ \dontrun{ # basic stubbing stub_request("get", "https://httpbin.org/get") stub_request("post", "https://httpbin.org/post") # any method, use "any" stub_request("any", "https://httpbin.org/get") # list stubs stub_registry() # request headers stub_request("get", "https://httpbin.org/get") \%>\% wi_th(headers = list("User-Agent" = "R")) # request body stub_request("post", "https://httpbin.org/post") \%>\% wi_th(body = list(foo = "bar")) stub_registry() library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org") crul::mock() x$post("post", body = list(foo = "bar")) # 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\\\\..") # set stub an expectation to timeout stub_request("get", "https://httpbin.org/get") \%>\% to_timeout() x <- crul::HttpClient$new(url = "https://httpbin.org") res <- x$get("get") # raise exception library(fauxpas) stub_request("get", "https://httpbin.org/get") \%>\% to_raise(HTTPAccepted) stub_request("get", "https://httpbin.org/get") \%>\% to_raise(HTTPAccepted, HTTPGone) x <- crul::HttpClient$new(url = "https://httpbin.org") stub_request("get", "https://httpbin.org/get") \%>\% to_raise(HTTPBadGateway) crul::mock() x$get("get") # pass a list to .list z <- stub_request("get", "https://httpbin.org/get") wi_th(z, .list = list(query = list(foo = "bar"))) # just body stub_request("any", uri_regex = ".+") \%>\% wi_th(body = list(foo = "bar")) ## with crul library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org") crul::mock() x$post("post", body = list(foo = "bar")) x$put("put", body = list(foo = "bar")) ## with httr library(httr) httr_mock() POST("https://example.com", body = list(foo = "bar")) PUT("https://google.com", body = list(foo = "bar")) # just headers headers <- list( "Accept-Encoding" = "gzip, deflate", "Accept" = "application/json, text/xml, application/xml, */*" ) stub_request("any", uri_regex = ".+") \%>\% wi_th(headers = headers) library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org", headers = headers) crul::mock() x$post("post") x$put("put", body = list(foo = "bar")) x$get("put", query = list(stuff = 3423234L)) # many responses ## the first response matches the first to_return call, and so on stub_request("get", "https://httpbin.org/get") \%>\% to_return(status = 200, body = "foobar", headers = list(a = 5)) \%>\% to_return(status = 200, body = "bears", headers = list(b = 6)) con <- crul::HttpClient$new(url = "https://httpbin.org") con$get("get")$parse("UTF-8") con$get("get")$parse("UTF-8") ## OR, use times with to_return() to repeat the same response many times library(fauxpas) stub_request("get", "https://httpbin.org/get") \%>\% to_return(status = 200, body = "apple-pie", times = 2) \%>\% to_raise(HTTPUnauthorized) con <- crul::HttpClient$new(url = "https://httpbin.org") con$get("get")$parse("UTF-8") con$get("get")$parse("UTF-8") con$get("get")$parse("UTF-8") # partial matching ## query parameters library(httr) enable() ### matches stub_request("get", "https://hb.opencpu.org/get") \%>\% wi_th(query = including(list(fruit = "pear"))) \%>\% to_return(body = "matched on partial query!") resp <- GET("https://hb.opencpu.org/get", query = list(fruit = "pear", bread = "scone") ) rawToChar(content(resp)) ### doesn't match stub_registry_clear() stub_request("get", "https://hb.opencpu.org/get") \%>\% wi_th(query = list(fruit = "pear")) \%>\% to_return(body = "didn't match, ugh!") # GET("https://hb.opencpu.org/get", # query = list(fruit = "pear", meat = "chicken")) ## request body ### matches - including stub_request("post", "https://hb.opencpu.org/post") \%>\% wi_th(body = including(list(fruit = "pear"))) \%>\% to_return(body = "matched on partial body!") resp <- POST("https://hb.opencpu.org/post", body = list(fruit = "pear", meat = "chicken") ) rawToChar(content(resp)) ### matches - excluding stub_request("post", "https://hb.opencpu.org/post") \%>\% wi_th(body = excluding(list(fruit = "pear"))) \%>\% to_return(body = "matched on partial body!") res <- POST("https://hb.opencpu.org/post", body = list(color = "blue") ) rawToChar(content(res)) # POST("https://hb.opencpu.org/post", # body = list(fruit = "pear", meat = "chicken")) # clear all stubs stub_registry() stub_registry_clear() } } \seealso{ \code{\link[=wi_th]{wi_th()}}, \code{\link[=to_return]{to_return()}}, \code{\link[=to_timeout]{to_timeout()}}, \code{\link[=to_raise]{to_raise()}}, \code{\link[=mock_file]{mock_file()}} } webmockr/man/StubRegistry.Rd0000644000176200001440000001561714752052374015616 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubRegistry.R \name{StubRegistry} \alias{StubRegistry} \title{StubRegistry} \description{ stub registry to keep track of \link{StubbedRequest} stubs } \examples{ \dontrun{ # Make a stub 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()) 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}()}, \code{\link{stub_registry_clear}()} } \concept{stub-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{request_stubs}}{(list) list of request stubs} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-StubRegistry-print}{\code{StubRegistry$print()}} \item \href{#method-StubRegistry-register_stub}{\code{StubRegistry$register_stub()}} \item \href{#method-StubRegistry-find_stubbed_request}{\code{StubRegistry$find_stubbed_request()}} \item \href{#method-StubRegistry-request_stub_for}{\code{StubRegistry$request_stub_for()}} \item \href{#method-StubRegistry-remove_request_stub}{\code{StubRegistry$remove_request_stub()}} \item \href{#method-StubRegistry-remove_all_request_stubs}{\code{StubRegistry$remove_all_request_stubs()}} \item \href{#method-StubRegistry-is_registered}{\code{StubRegistry$is_registered()}} \item \href{#method-StubRegistry-is_stubbed}{\code{StubRegistry$is_stubbed()}} \item \href{#method-StubRegistry-clone}{\code{StubRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{StubRegistry} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-register_stub}{}}} \subsection{Method \code{register_stub()}}{ Register a stub \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$register_stub(stub)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{stub}}{an object of type \link{StubbedRequest}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers the stub } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-find_stubbed_request}{}}} \subsection{Method \code{find_stubbed_request()}}{ Find a stubbed request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$find_stubbed_request(req)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req}}{an object of class \link{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ an object of type \link{StubbedRequest}, if matched } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-request_stub_for}{}}} \subsection{Method \code{request_stub_for()}}{ Find a stubbed request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$request_stub_for(request_signature, count = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_signature}}{an object of class \link{RequestSignature}} \item{\code{count}}{(bool) iterate counter or not. default: \code{TRUE}} } \if{html}{\out{
}} } \subsection{Returns}{ logical, 1 or more } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-remove_request_stub}{}}} \subsection{Method \code{remove_request_stub()}}{ Remove a stubbed request by matching request signature \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$remove_request_stub(stub)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{stub}}{an object of type \link{StubbedRequest}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; removes the stub from the registry } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-remove_all_request_stubs}{}}} \subsection{Method \code{remove_all_request_stubs()}}{ Remove all request stubs \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$remove_all_request_stubs()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; removes all request stubs } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-is_registered}{}}} \subsection{Method \code{is_registered()}}{ Find a stubbed request from a request signature \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$is_registered(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{an object of class \link{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers the stub } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-is_stubbed}{}}} \subsection{Method \code{is_stubbed()}}{ Check if a stubbed request is in the stub registry \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$is_stubbed(stub)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{stub}}{an object of class \link{StubbedRequest}} } \if{html}{\out{
}} } \subsection{Returns}{ single boolean, \code{TRUE} or \code{FALSE} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/StubbedRequest.Rd0000644000176200001440000002217614752656551016116 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubbedRequest.R \name{StubbedRequest} \alias{StubbedRequest} \title{StubbedRequest} \description{ stubbed request class underlying \code{\link[=stub_request]{stub_request()}} } \examples{ \dontrun{ x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$method x$uri x$with(headers = list("User-Agent" = "R", apple = "good")) x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x x$to_s() # query x <- StubbedRequest$new(method = "get", uri = "httpbin.org") x$with(query = list(a = 5)) x x$to_s() ## including x <- StubbedRequest$new(method = "get", uri = "httpbin.org") x$with(query = including(list(a = 5))) x x$to_s() x$with(query = including(list(a = 5, b = 7))) x$to_s() ## excluding x <- StubbedRequest$new(method = "get", uri = "httpbin.org") x$with(query = excluding(list(a = 5))) x x$to_s() # many to_return's x <- StubbedRequest$new(method = "get", uri = "httpbin.org") x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x$to_return(status = 200, body = "bears", headers = list(b = 6)) x x$to_s() # raw body x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$to_return(status = 200, body = raw(0), headers = list(a = 5)) x$to_s() x x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$to_return( status = 200, body = charToRaw("foo bar"), headers = list(a = 5) ) x$to_s() x # basic auth x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$with(basic_auth = c("foo", "bar")) x$to_s() x # file path x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") f <- tempfile() x$to_return(status = 200, body = file(f), headers = list(a = 5)) x x$to_s() unlink(f) # to_file(): file path and payload to go into the file # payload written to file during mocked response creation x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") f <- tempfile() x$to_return( status = 200, body = mock_file(f, "{\"foo\": \"bar\"}"), headers = list(a = 5) ) x x$to_s() unlink(f) # uri_regex (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$method x$uri_regex x$to_s() # to timeout (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$to_s() x$to_timeout() x$to_s() x # to raise library(fauxpas) (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$to_s() x$to_raise(HTTPBadGateway) x$to_s() x } } \seealso{ \code{\link[=stub_request]{stub_request()}} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(xx) xx} \item{\code{uri}}{(xx) xx} \item{\code{uri_regex}}{(xx) xx} \item{\code{regex}}{a logical} \item{\code{uri_parts}}{(xx) xx} \item{\code{host}}{(xx) xx} \item{\code{query}}{(xx) xx} \item{\code{body}}{(xx) xx} \item{\code{basic_auth}}{(xx) xx} \item{\code{request_headers}}{(xx) xx} \item{\code{response_headers}}{(xx) xx} \item{\code{responses_sequences}}{(xx) xx} \item{\code{status_code}}{(xx) xx} \item{\code{counter}}{a StubCounter object} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-StubbedRequest-new}{\code{StubbedRequest$new()}} \item \href{#method-StubbedRequest-print}{\code{StubbedRequest$print()}} \item \href{#method-StubbedRequest-with}{\code{StubbedRequest$with()}} \item \href{#method-StubbedRequest-to_return}{\code{StubbedRequest$to_return()}} \item \href{#method-StubbedRequest-to_timeout}{\code{StubbedRequest$to_timeout()}} \item \href{#method-StubbedRequest-to_raise}{\code{StubbedRequest$to_raise()}} \item \href{#method-StubbedRequest-to_s}{\code{StubbedRequest$to_s()}} \item \href{#method-StubbedRequest-reset}{\code{StubbedRequest$reset()}} \item \href{#method-StubbedRequest-clone}{\code{StubbedRequest$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{StubbedRequest} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$new(method, uri = NULL, uri_regex = NULL)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{the HTTP method (any, head, get, post, put, patch, or delete). "any" matches any HTTP method. required.} \item{\code{uri}}{(character) request URI. either this or \code{uri_regex} required. \pkg{webmockr} can match uri's without the "http" scheme, but does not match if the scheme is "https". required, unless \code{uri_regex} given. See \link{UriPattern} for more.} \item{\code{uri_regex}}{(character) request URI as regex. either this or \code{uri} required} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{StubbedRequest} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{StubbedRequest} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-with}{}}} \subsection{Method \code{with()}}{ Set expectations for what's given in HTTP request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$with( query = NULL, body = NULL, headers = NULL, basic_auth = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{query}}{(list) request query params, as a named list. optional} \item{\code{body}}{(list) request body, as a named list. optional} \item{\code{headers}}{(list) request headers as a named list. optional.} \item{\code{basic_auth}}{(character) basic authentication. optional.} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets only } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_return}{}}} \subsection{Method \code{to_return()}}{ Set expectations for what's returned in HTTP response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_return(status, body, headers)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{status}}{(numeric) an HTTP status code} \item{\code{body}}{(list) response body, one of: \code{character}, \code{json}, \code{list}, \code{raw}, \code{numeric}, \code{NULL}, \code{FALSE}, or a file connection (other connection types not supported)} \item{\code{headers}}{(list) named list, response headers. optional.} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets whats to be returned } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_timeout}{}}} \subsection{Method \code{to_timeout()}}{ Response should time out \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_timeout()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_raise}{}}} \subsection{Method \code{to_raise()}}{ Response should raise an exception \code{x} \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_raise(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{(character) an exception message} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_s}{}}} \subsection{Method \code{to_s()}}{ Response as a character string \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ (character) the response as a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-reset}{}}} \subsection{Method \code{reset()}}{ Reset the counter for the stub \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$reset()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; resets stub counter to no requests } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/webmockr_crul_fetch.Rd0000644000176200001440000000050114113773445017141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \name{webmockr_crul_fetch} \alias{webmockr_crul_fetch} \title{execute a curl request} \usage{ webmockr_crul_fetch(x) } \arguments{ \item{x}{an object} } \value{ a curl response } \description{ execute a curl request } \keyword{internal} webmockr/man/webmockr_reset.Rd0000644000176200001440000000121114113773445016144 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr_reset.R \name{webmockr_reset} \alias{webmockr_reset} \title{webmockr_reset} \usage{ webmockr_reset() } \value{ nothing } \description{ Clear all stubs and the request counter } \details{ this function runs \code{\link[=stub_registry_clear]{stub_registry_clear()}} and \code{\link[=request_registry_clear]{request_registry_clear()}} - so you can run those two yourself to achieve the same thing } \examples{ # webmockr_reset() } \seealso{ \code{\link[=stub_registry_clear]{stub_registry_clear()}} \code{\link[=request_registry_clear]{request_registry_clear()}} } webmockr/DESCRIPTION0000644000176200001440000000337014752731512013603 0ustar liggesusersPackage: 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. Can be used for unit tests or outside of a testing context. Version: 2.0.0 Authors@R: c( person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus+r@gmail.com", comment = c(ORCID="0000-0003-1444-9135")), person("Aaron", "Wolen", role = "ctb", comment = c(ORCID="0000-0003-2542-2202")), person("rOpenSci", role = "fnd", comment = c(ROR = "019jywm96")) ) License: MIT + file LICENSE URL: https://github.com/ropensci/webmockr, https://books.ropensci.org/http-testing/, https://docs.ropensci.org/webmockr/ BugReports: https://github.com/ropensci/webmockr/issues Encoding: UTF-8 Language: en-US Depends: R(>= 4.1.0) Imports: curl, jsonlite, magrittr (>= 1.5), R6 (>= 2.1.3), urltools (>= 1.6.0), fauxpas, crul (>= 0.7.0), rlang, cli Suggests: testthat, xml2, vcr, httr, httr2, diffobj RoxygenNote: 7.3.2 X-schema.org-applicationCategory: Web X-schema.org-keywords: http, https, API, web-services, curl, mock, mocking, fakeweb, http-mocking, testing, testing-tools, tdd X-schema.org-isPartOf: https://ropensci.org NeedsCompilation: no Packaged: 2025-02-11 19:58:43 UTC; sckott Author: Scott Chamberlain [aut, cre] (), Aaron Wolen [ctb] (), rOpenSci [fnd] (019jywm96) Maintainer: Scott Chamberlain Repository: CRAN Date/Publication: 2025-02-11 20:30:02 UTC