webmockr/0000755000176200001440000000000015037344522012070 5ustar liggesuserswebmockr/tests/0000755000176200001440000000000015036220534013225 5ustar liggesuserswebmockr/tests/testthat/0000755000176200001440000000000015036223645015073 5ustar liggesuserswebmockr/tests/testthat/test-Response.R0000644000176200001440000000752015036220536017771 0ustar liggesusersaa <- Response$new() test_that("Response: bits are correct prior to having data", { expect_s3_class(Response, "R6ClassGenerator") expect_s3_class(aa, "Response") expect_null(aa$body) expect_null(aa$content) expect_null(aa$exception) expect_type(aa$get_body, "closure") expect_type(aa$get_exception, "closure") expect_type(aa$get_request_headers, "closure") expect_type(aa$get_respone_headers, "closure") expect_type(aa$get_status, "closure") expect_type(aa$get_url, "closure") expect_type(aa$print, "closure") expect_type(aa$set_body, "closure") expect_type(aa$set_exception, "closure") expect_type(aa$set_request_headers, "closure") expect_type(aa$set_response_headers, "closure") expect_type(aa$set_status, "closure") expect_type(aa$set_url, "closure") expect_null(aa$should_timeout, "closure") 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.cran.dev")) aa$set_status(404) aa$set_body("hello world") aa$set_exception("exception") expect_s3_class(aa, "Response") expect_null(aa$should_timeout) expect_type(aa$request_headers, "list") expect_named(aa$request_headers, "Content-Type") expect_type(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_type(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.cran.dev") 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_type(aa$body, "raw") expect_type(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_type(aa$body, "raw") expect_type(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_type(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.rda0000644000176200001440000000041515036220536020475 0ustar liggesusersQMK1E[zPC/X(^J6fMnnK{3% 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.R0000644000176200001440000000204315027274165020365 0ustar liggesusersstub_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_s3_class(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_type(aa$responses_sequences, "list") expect_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(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.R0000644000176200001440000001072515036223645021233 0ustar liggesusersenable(quiet = TRUE) 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_type(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_type(out$content, "character") expect_equal(attr(out$content, "type"), "file") expect_type(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_type(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_s3_class(out$content, "path") expect_equal(attr(out$content, "class"), "path") expect_type(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_type(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_s3_class(out$body, "httr2_path") expect_equal(attr(out$body, "class"), "httr2_path") expect_type(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_type(out$content, "character") expect_match(out$content, "json") expect_type(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_s3_class(out$content, "path") expect_match(out$content, "json") expect_type(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.cran.dev/get") out <- req_perform(req, path = f) # out <- GET(hb("/get"), write_disk(f)) ## view stubbed file content expect_s3_class(out$body, "httr2_path") expect_match(out$body, "json") expect_type(readLines(out$body), "character") expect_true(any(grepl("foo", readLines(out$body)))) # cleanup unlink(f) stub_registry_clear() }) webmockr/tests/testthat/test-StubbedRequest.R0000644000176200001440000001442515036220536021136 0ustar liggesuserstest_that("StubbedRequest: works", { expect_s3_class(StubbedRequest, "R6ClassGenerator") aa <- StubbedRequest$new(method = "get", uri = "https://hb.cran.dev/get") expect_s3_class(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_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(aa$uri, "character") expect_equal(aa$uri, "https://hb.cran.dev/get") expect_type(aa$uri_parts, "list") expect_equal(aa$uri_parts$domain, "hb.cran.dev") expect_equal(aa$uri_parts$path, "get") expect_type(aa$to_s, "closure") expect_equal(aa$to_s(), "GET: https://hb.cran.dev/get") # with expect_type(aa$with, "closure") expect_null(aa$query) aa$with(query = list(foo = "bar")) expect_type(aa$query, "list") expect_named(aa$query, "foo") expect_equal( aa$to_s(), "GET: https://hb.cran.dev/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.cran.dev/get with query params foo=bar, stuff=567" ) # to_return expect_type(aa$to_return, "closure") expect_null(aa$body) aa$to_return( status = 404, body = list(hello = "world"), headers = list(a = 5) ) expect_type(aa$responses_sequences, "list") expect_type(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.ocran.dev/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.ocran.dev/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.ocran.dev/get" )$method, "any" ) expect_equal( StubbedRequest$new( method = "get", uri = "https:/hb.ocran.dev/get" )$method, "get" ) expect_equal( StubbedRequest$new( method = "head", uri = "https:/hb.ocran.dev/get" )$method, "head" ) expect_equal( StubbedRequest$new( method = "post", uri = "https:/hb.ocran.dev/get" )$method, "post" ) expect_equal( StubbedRequest$new( method = "put", uri = "https:/hb.ocran.dev/get" )$method, "put" ) expect_equal( StubbedRequest$new( method = "patch", uri = "https:/hb.ocran.dev/get" )$method, "patch" ) expect_equal( StubbedRequest$new( method = "delete", uri = "https:/hb.ocran.dev/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.cran.dev") 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.R0000644000176200001440000000403715036226674021243 0ustar liggesusersenable(quiet = TRUE) webmockr_reset() test_that("to_return: then", { skip_on_cran() 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", { skip_on_cran() 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(quiet = TRUE) webmockr/tests/testthat/helper-webmockr.R0000644000176200001440000000132115036220536020275 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.cran.dev" hb <- function(x = NULL) if (is.null(x)) base_url else paste0(base_url, x) webmockr/tests/testthat/test-flipswitch.R0000644000176200001440000000443015036220536020344 0ustar liggesuserstest_that("flipswitch in default state", { expect_type(webmockr_lightswitch, "environment") expect_type(webmockr_lightswitch$httr, "logical") }) test_that("flipswitch - turn on with 'enable'", { skip_if_not_installed("httr") skip_if_not_installed("httr2") aa <- enable(quiet = TRUE) expect_type(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(quiet = TRUE) # enable one pkg aa <- enable("crul", quiet = TRUE) expect_type(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(quiet = TRUE) # 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, quiet = TRUE), "unused argument") expect_error(disable(bee = 5, quiet = TRUE), "unused argument") expect_error( enable(adapter = "stuff", quiet = TRUE), "adapter must be one of" ) expect_error( disable(adapter = "stuff", quiet = TRUE), "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(quiet = TRUE) 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") }) test_that("can enable and disable quietly", { local_mocked_bindings(is_installed = function(pkg) pkg != "crul") expect_snapshot({ enable(quiet = TRUE) disable(quiet = TRUE) }) expect_snapshot({ enable("crul", quiet = TRUE) disable("crul", quiet = TRUE) }) }) 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.R0000644000176200001440000000262215036220536017551 0ustar liggesuserstest_that("Adapter class can't be instantiated", { expect_s3_class(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") }) test_that("show_body_diff configuration setting", { webmockr_configure(show_body_diff = TRUE) withr::defer(webmockr_configure(show_body_diff = FALSE)) library(httr, warn.conflicts = FALSE) enable(adapter = "httr", quiet = TRUE) stub_request("get", "https://hb.cran.dev/post") %>% wi_th(body = list(apple = "green")) expect_snapshot( POST("https://hb.cran.dev/post", body = list(apple = "red")), error = TRUE ) }) test_that("show_body_diff configuration setting - > 1 stub", { webmockr_configure(show_body_diff = TRUE) withr::defer(webmockr_configure(show_body_diff = FALSE)) library(httr, warn.conflicts = FALSE) enable(adapter = "httr", quiet = TRUE) stub_request("get", "https://hb.cran.dev/post") %>% wi_th(body = list(apple = "green")) stub_request("get", "https://hb.cran.dev/post") %>% wi_th(body = list(pear = "purple")) expect_snapshot( POST("https://hb.cran.dev/post", body = list(apple = "red")), error = TRUE ) }) webmockr/tests/testthat/test-onload.R0000644000176200001440000000142215027274360017446 0ustar liggesuserstest_that("onload: http_lib_adapter_registry", { expect_s3_class(http_lib_adapter_registry, "HttpLibAdapaterRegistry") expect_s3_class(http_lib_adapter_registry, "R6") expect_equal( sort(ls(envir = http_lib_adapter_registry)), c("adapters", "clone", "print", "register") ) expect_type(http_lib_adapter_registry$adapters, "list") expect_s3_class( http_lib_adapter_registry$adapters[[1]], "CrulAdapter" ) expect_s3_class( http_lib_adapter_registry$adapters[[2]], "HttrAdapter" ) expect_s3_class( http_lib_adapter_registry$adapters[[3]], "Httr2Adapter" ) expect_type(http_lib_adapter_registry$clone, "closure") expect_type(http_lib_adapter_registry$print, "closure") expect_type(http_lib_adapter_registry$register, "closure") }) webmockr/tests/testthat/test-stub_requests_crul.R0000644000176200001440000000732415036220536022132 0ustar liggesuserstest_that("stub_request works well: get requests", { skip_on_cran() library(crul, warn.conflicts = FALSE) stub_registry_clear() enable(adapter = "crul") withr::defer(disable(adapter = "crul")) # 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_s3_class(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_s3_class(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)) }) test_that("stub_request works well: post requests", { skip_on_cran() library(crul, warn.conflicts = FALSE) stub_registry_clear() enable(adapter = "crul") withr::defer(disable(adapter = "crul")) # 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_s3_class(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.R0000644000176200001440000001352315036220536021501 0ustar liggesuserstest_that("include/exclude", { # keys and values works aa <- including(list(foo = "bar")) expect_output(print(aa), "") expect_s3_class(aa, "partial") expect_type(unclass(aa), "list") expect_equal(length(aa), 1) expect_named(aa, "foo") expect_true(attr(aa, "partial_match")) expect_type(attr(aa, "partial_type"), "character") expect_equal(attr(aa, "partial_type"), "include") bb <- excluding(list(foo = "bar")) expect_output(print(bb), "") expect_s3_class(bb, "partial") expect_type(unclass(bb), "list") expect_equal(length(bb), 1) expect_named(bb, "foo") expect_true(attr(bb, "partial_match")) expect_type(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_s3_class(cc, "partial") expect_type(unclass(cc), "list") expect_equal(length(cc), 2) }) skip_if_not_installed("httr") library(httr) test_that("include query parameters", { enable(adapter = "httr", quiet = TRUE) on.exit({ disable(adapter = "httr", quiet = TRUE) }) ## matches stub_request("get", "https://hb.cran.dev/get") %>% wi_th(query = including(list(fruit = "pear"))) %>% to_return(body = "matched on including partial query!") resp_matched <- GET( "https://hb.cran.dev/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.cran.dev/get", query = list(meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("exclude query parameters", { enable(adapter = "httr", quiet = TRUE) on.exit({ disable(adapter = "httr", quiet = TRUE) }) ## matches stub_request("get", "https://hb.cran.dev/get") %>% wi_th(query = excluding(list(fruit = "pear"))) %>% to_return(body = "matched on excluding partial query!") resp_matched <- GET( "https://hb.cran.dev/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.cran.dev/get", query = list(fruit = "pear")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("include query parameters, just keys", { enable(adapter = "httr", quiet = TRUE) on.exit({ disable(adapter = "httr", quiet = TRUE) }) ## matches stub_request("get", "https://hb.cran.dev/get") %>% wi_th(query = including(list(fruit = NULL))) %>% to_return(body = "matched on including key!") resp_matched <- GET( "https://hb.cran.dev/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.cran.dev/get", query = list(meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("exclude query parameters, just keys", { enable(adapter = "httr", quiet = TRUE) on.exit({ disable(adapter = "httr", quiet = TRUE) }) ## matches stub_request("get", "https://hb.cran.dev/get") %>% wi_th(query = excluding(list(fruit = NULL))) %>% to_return(body = "matched on excluding key!") resp_matched <- GET( "https://hb.cran.dev/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.cran.dev/get", query = list(fruit = "pineapple")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("include request body", { enable(adapter = "httr", quiet = TRUE) on.exit({ disable(adapter = "httr", quiet = TRUE) }) ## matches stub_request("post", "https://hb.cran.dev/post") %>% wi_th(body = including(list(fruit = "pear"))) %>% to_return(body = "matched on including partial body!") resp_matched <- POST( "https://hb.cran.dev/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.cran.dev/post", query = list(meat = "chicken")), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) test_that("exclude request body", { enable(adapter = "httr", quiet = TRUE) on.exit({ disable(adapter = "httr", quiet = TRUE) }) ## matches stub_request("post", "https://hb.cran.dev/post") %>% wi_th(body = excluding(list(fruit = "pear"))) %>% to_return(body = "matched on excluding partial body!") resp_matched <- POST( "https://hb.cran.dev/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.cran.dev/post", body = list(fruit = "pear", meat = "chicken") ), "Real HTTP connections are disabled" ) # cleanup stub_registry_clear() }) webmockr/tests/testthat/httr2_obj.rda0000644000176200001440000000031015036220536017446 0ustar liggesusers]P @\"zB- yi;e=mpA`q&D ZUd2/I?Z"r6W|GMjX?GyIkT&7i0TzokXq;EKX:kEU4NϫTt+ο/Pٻ5:tDwebmockr/tests/testthat/test-HashCounter.R0000644000176200001440000000711115027274165020421 0ustar liggesusers#' Tests for HashCounter class test_that("HashCounter: structure", { expect_s3_class(HashCounter, "R6ClassGenerator") x <- HashCounter$new() expect_s3_class(x, "HashCounter") expect_type(x$clone, "closure") expect_type(x$get, "closure") expect_type(x$put, "closure") expect_type(x$hash, "list") expect_length(x$hash, 0) # New instance has empty hash }) test_that("HashCounter: initialization", { # Test initial state x <- HashCounter$new() expect_identical(x$hash, list()) # Test that clone creates a proper duplicate y <- x$clone() expect_s3_class(y, "HashCounter") expect_identical(y$hash, x$hash) # Ensure they are independent objects a <- RequestSignature$new(method = "get", uri = hb("/get")) x$put(a) expect_length(x$hash, 1) expect_length(y$hash, 0) }) test_that("HashCounter: works as expected with basic operations", { x <- HashCounter$new() a <- RequestSignature$new(method = "get", uri = hb("/get")) b <- RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/") # First put x$put(a) expect_length(x$hash, 1) expect_equal(x$hash[[a$to_s()]]$count, 1) expect_equal(x$get(a), 1) # Second put of same request - counter should increment x$put(a) expect_length(x$hash, 1) expect_equal(x$hash[[a$to_s()]]$count, 2) expect_equal(x$get(a), 2) # Put different request x$put(b) expect_length(x$hash, 2) expect_equal(x$hash[[b$to_s()]]$count, 1) expect_equal(x$get(b), 1) # Multiple puts of second request x$put(b) x$put(b) expect_length(x$hash, 2) expect_equal(x$hash[[b$to_s()]]$count, 3) expect_equal(x$get(b), 3) # Original request count should still be 2 expect_equal(x$get(a), 2) }) test_that("HashCounter: get returns 0 for non-existing requests", { x <- HashCounter$new() a <- RequestSignature$new(method = "get", uri = hb("/get")) b <- RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/") # Put one request x$put(a) expect_equal(x$get(a), 1) # Get count for non-existing request expect_equal(x$get(b), 0) }) test_that("HashCounter: stores unique requests by signature", { x <- HashCounter$new() # These have different signatures a1 <- RequestSignature$new(method = "get", uri = hb("/get")) a2 <- RequestSignature$new(method = "get", uri = hb("/get?foo=bar")) a3 <- RequestSignature$new(method = "post", uri = hb("/get")) # Put all requests x$put(a1) x$put(a2) x$put(a3) # Each should have its own entry expect_length(x$hash, 3) expect_equal(x$get(a1), 1) expect_equal(x$get(a2), 1) expect_equal(x$get(a3), 1) # Getting one more time shouldn't change anything expect_equal(x$get(a1), 1) expect_length(x$hash, 3) }) test_that("HashCounter: internal hash structure is correct", { x <- HashCounter$new() a <- RequestSignature$new(method = "get", uri = hb("/get")) x$put(a) # Check the internal hash structure key <- a$to_s() expect_true(key %in% names(x$hash)) expect_type(x$hash[[key]], "list") expect_named(x$hash[[key]], c("key", "sig", "count")) expect_equal(x$hash[[key]]$key, key) expect_s3_class(x$hash[[key]]$sig, "RequestSignature") expect_equal(x$hash[[key]]$count, 1) }) test_that("HashCounter fails well", { x <- HashCounter$new() # Missing arguments expect_error(x$get(), '\"req_sig\" is missing') expect_error(x$put(), '\"req_sig\" is missing') # Wrong argument types expect_error( x$get("not a request signature"), "must be of class RequestSignature" ) expect_error(x$put(list()), "must be of class RequestSignature") expect_error(x$put(42), "must be of class RequestSignature") }) webmockr/tests/testthat/test-CrulAdapter.R0000644000176200001440000001134715036220536020403 0ustar liggesusersaa <- CrulAdapter$new() test_that("CrulAdapter bits are correct", { skip_on_cran() expect_s3_class(CrulAdapter, "R6ClassGenerator") expect_s3_class(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_type(aa$disable, "closure") expect_type(aa$enable, "closure") expect_type(aa$handle_request, "closure") expect_type(aa$remove_stubs, "closure") expect_type(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", { skip_on_cran() load("crul_obj.rda") crul_obj$url$handle <- curl::new_handle() res <- CrulAdapter$new() # with webmockr message invisible(stub_request("get", "http://localhost:9000/get")) aa <- res$handle_request(crul_obj) expect_s3_class(res, "CrulAdapter") expect_s3_class(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_s3_class(res, "CrulAdapter") expect_s3_class(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_type(aa$response_headers, "list") expect_named(aa$response_headers, "user-agent") expect_equal(length(aa$response_headers_all), 1) expect_type(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_type(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_type(aa$response_headers_all, "list") expect_type(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", quiet = TRUE)) enable(adapter = "crul", quiet = TRUE) 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.R0000644000176200001440000002137715036220536020423 0ustar liggesusersskip_if_not_installed("httr") suppressPackageStartupMessages(library("httr", warn.conflicts = FALSE)) aa <- HttrAdapter$new() test_that("HttrAdapter bits are correct", { skip_on_cran() expect_s3_class(HttrAdapter, "R6ClassGenerator") expect_s3_class(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_type(aa$disable, "closure") expect_type(aa$enable, "closure") expect_type(aa$handle_request, "closure") expect_type(aa$remove_stubs, "closure") expect_type(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") }) # library(httr) # z <- GET(hb("/get")) # httr_obj <- z$request # save(httr_obj, file = "tests/testthat/httr_obj.rda", version = 2) # test_that("HttrAdapter date slot works", { # skip_on_cran() # # $date is of correct format # expect_output(print(x), "Date") # expect_s3_class(x$date, "POSIXct") # expect_type(format(x$date, "%Y-%m-%d %H:%M"), "character") # # $headers$date is a different format # expect_type(x$headers$date, "character") # expect_error(format(x$headers$date, "%Y-%m-%d %H:%M"), "invalid 'trim'") # }) test_that("HttrAdapter insensitive headers work, webmockr flow", { skip_on_cran() 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_type(httr::content(x), "list") expect_type(httr::content(x, "text", encoding = "UTF-8"), "character") stub_registry_clear() httr_mock(FALSE) }) test_that("HttrAdapter works", { skip_on_cran() load("httr_obj.rda") # load("tests/testthat/httr_obj.rda") res <- HttrAdapter$new() # with webmockr message invisible(stub_request("get", hb("/get"))) aa <- res$handle_request(httr_obj) expect_s3_class(res, "HttrAdapter") expect_s3_class(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_s3_class(res, "HttrAdapter") expect_s3_class(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_type(aa$headers, "list") expect_named(aa$headers, "user-agent") expect_equal(length(aa$all_headers), 1) expect_type(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_type(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_type(aa$all_headers, "list") expect_type(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() httr_mock() # httr_mock(FALSE) # sm(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 = 3) # 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_s3_class(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_s3_class(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 sm(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 suppressMessages(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() sm(webmockr_allow_net_connect()) x <- httr::POST(hb("/post"), body = list(stuff = "things")) expect_identical(httr::content(x)$form, list(stuff = "things")) suppressMessages(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() sm(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 ) suppressMessages(webmockr_disable_net_connect()) }) test_that("httr requests with JSON-encoded bodies work", { skip_on_cran() on.exit(disable(adapter = "httr", quiet = TRUE)) enable(adapter = "httr", quiet = TRUE) 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.R0000644000176200001440000000315515027274165020007 0ustar liggesusersstub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) library(fauxpas, warn.conflicts = FALSE) aa <- stub_request("get", hb("/get")) %>% to_raise(HTTPAccepted) test_that("stub_request bits are correct", { expect_s3_class(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_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(aa$uri, "character") expect_equal(aa$uri, hb("/get")) # to_raise expected stuff rr <- aa$responses_sequences[[1]] expect_true(rr$raise) expect_type(rr$exceptions, "list") expect_s3_class(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.R0000644000176200001440000000155515027274165022306 0ustar liggesusers# 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_type(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.R0000644000176200001440000003112015036220536021152 0ustar liggesuserstest_that("RequestPattern: structure is correct", { expect_s3_class(RequestPattern, "R6ClassGenerator") aa <- RequestPattern$new(method = "get", uri = hb("/get")) expect_s3_class(aa, "RequestPattern") expect_null(aa$body_pattern) expect_null(aa$headers_pattern) expect_type(aa$clone, "closure") expect_type(aa$initialize, "closure") expect_type(aa$matches, "closure") expect_s3_class(aa$method_pattern, "MethodPattern") expect_type(aa$to_s, "closure") expect_s3_class(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.cran.dev", 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_type(aa$to_s(), "character") expect_match(aa$to_s(), "GET") expect_match(aa$to_s(), "hb.cran.dev/get") }) test_that("RequestPattern: uri_regex", { x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org") expect_s3_class(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(quiet = TRUE) }) test_that("UriPattern: structure is correct", { expect_s3_class(UriPattern, "R6ClassGenerator") aa <- UriPattern$new(pattern = "http://foobar.com") expect_s3_class(aa, "UriPattern") expect_type(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_type(aa$matches(), "closure"), "argument \"uri\" is missing" ) # regex usage z <- UriPattern$new(regex_pattern = ".+ample\\..") expect_s3_class(z, "UriPattern") expect_type(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_s3_class(z, "UriPattern") expect_type(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.R0000644000176200001440000001161215027274165021360 0ustar liggesuserstest_that("RequestRegistry: structure", { expect_s3_class(RequestRegistry, "R6ClassGenerator") aa <- RequestRegistry$new() expect_s3_class(aa, "RequestRegistry") expect_type(aa$clone, "closure") expect_type(aa$print, "closure") expect_type(aa$register_request, "closure") expect_type(aa$times_executed, "closure") expect_null(aa$request) expect_s3_class(aa$request_signatures, "HashCounter") expect_type(aa$reset, "closure") }) 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" ) expect_output( print(aa), "2 times" ) # 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') expect_error(x$times_executed(), '`request_pattern` is required') expect_error( x$times_executed("not a request pattern"), "`request_pattern` must be of class 'RequestPattern'" ) }) test_that("RequestRegistry: times_executed works correctly", { x <- RequestRegistry$new() # Create request signatures get_sig <- RequestSignature$new( method = "get", uri = "http://example.org/get" ) post_sig <- RequestSignature$new( method = "post", uri = "http://example.org/post" ) complex_sig <- RequestSignature$new( method = "get", uri = "http://example.org/complex", options = list( headers = list(`User-Agent` = "test-agent", Accept = "application/json") ) ) # Register them different numbers of times x$register_request(get_sig) x$register_request(get_sig) x$register_request(post_sig) x$register_request(complex_sig) x$register_request(complex_sig) x$register_request(complex_sig) # Create matching patterns get_pattern <- RequestPattern$new( method = "get", uri = "http://example.org/get" ) post_pattern <- RequestPattern$new( method = "post", uri = "http://example.org/post" ) complex_pattern <- RequestPattern$new( method = "get", uri = "http://example.org/complex", headers = list(`User-Agent` = "test-agent") ) non_matching_pattern <- RequestPattern$new( method = "get", uri = "http://example.org/nonexistent" ) # Test times_executed returns correct counts expect_equal(x$times_executed(get_pattern), 2) expect_equal(x$times_executed(post_pattern), 1) expect_equal(x$times_executed(complex_pattern), 3) expect_equal(x$times_executed(non_matching_pattern), 0) }) test_that("RequestRegistry: print method works with empty registry", { x <- RequestRegistry$new() expect_output(print(x), "") expect_output(print(x), "Registered Requests") }) test_that("RequestRegistry: initialization and cloning", { x <- RequestRegistry$new() # Register a request sig <- RequestSignature$new(method = "get", uri = "http://example.org") x$register_request(sig) # Clone and verify independent instances y <- x$clone() expect_s3_class(y, "RequestRegistry") # Add to original, clone should remain unchanged x$register_request(sig) expect_equal( x$times_executed(RequestPattern$new( method = "get", uri = "http://example.org" )), 2 ) expect_equal( y$times_executed(RequestPattern$new( method = "get", uri = "http://example.org" )), 2 ) }) test_that("RequestRegistry: supports complex request signatures", { x <- RequestRegistry$new() # Create a complex request signature with headers, query params, and body complex_sig <- RequestSignature$new( method = "post", uri = "http://example.org/api?version=1", options = list( headers = list( `Content-Type` = "application/json", Authorization = "Bearer token" ), body = '{"key":"value"}' ) ) x$register_request(complex_sig) # Test matching with various patterns full_pattern <- RequestPattern$new( method = "post", uri = "http://example.org/api?version=1", headers = list(`Content-Type` = "application/json"), body = '{"key":"value"}' ) partial_pattern <- RequestPattern$new( method = "post", uri = "http://example.org/api" ) wrong_method_pattern <- RequestPattern$new( method = "get", uri = "http://example.org/api?version=1" ) expect_equal(x$times_executed(full_pattern), 1) expect_equal(x$times_executed(partial_pattern), 0) expect_equal(x$times_executed(wrong_method_pattern), 0) }) webmockr/tests/testthat/test-HttpLibAdapaterRegistry.R0000644000176200001440000000341015027274360022732 0ustar liggesuserstest_that("HttpLibAdapaterRegistry: structure", { expect_s3_class(HttpLibAdapaterRegistry, "R6ClassGenerator") aa <- HttpLibAdapaterRegistry$new() expect_s3_class(aa, "HttpLibAdapaterRegistry") expect_null(aa$adapters) expect_type(aa$clone, "closure") expect_type(aa$print, "closure") expect_type(aa$register, "closure") 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_s3_class(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_s3_class(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_s3_class(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.R0000644000176200001440000001011215036226554020161 0ustar liggesuserstest_that("uri_regex with crul", { skip_on_cran() stub_request("get", uri_regex = "hb.cran.dev/.+") %>% to_return(body = list(foo = "bar")) library(crul, warn.conflicts = FALSE) enable(adapter = "crul", quiet = TRUE) suppressMessages(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_s3_class(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.cran.dev/.+") %>% to_return(body = list(foo = "bar")) library(httr, warn.conflicts = FALSE) enable(adapter = "httr", quiet = TRUE) 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_s3_class(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.cran.dev/.+") %>% to_return(body = list(foo = "bar")) library(httr2, warn.conflicts = FALSE) enable(adapter = "httr2", quiet = TRUE) 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_s3_class(res, "httr2_response") expect_true(grepl(res$url, file.path(url, z), ignore.case = TRUE)) }) ) }) stub_registry_clear() webmockr/tests/testthat/test-wi_th.R0000644000176200001440000002173615036226640017314 0ustar liggesuserstest_that("wi_th: with just headers", { aa <- stub_request("get", hb("/get")) %>% wi_th(headers = list("User-Agent" = "R")) expect_s3_class(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$query) expect_type(aa$request_headers, "list") expect_null(aa$response) expect_null(aa$response_headers) expect_null(aa$responses_sequences) expect_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(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_type(aa$query, "list") expect_type(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_type(aa$body, "list") expect_output(print(aa), "body \\(class: list\\): foo=bar") bb <- stub_request("post", hb("/post")) %>% wi_th(body = '{"foo": "bar"}') expect_type(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_type(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_type(dd$body, "double") expect_output(print(dd), "body \\(class: numeric\\): 5") ee <- stub_request("post", hb("/post")) %>% wi_th(body = crul::upload(system.file("CITATION"))) expect_s3_class(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_type(ff$body, "list") expect_s3_class(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, warn.conflicts = FALSE) enable("httr", quiet = TRUE) # works w/ numeric stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = 30)) expect_s3_class(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_s3_class(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_s3_class(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_s3_class(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_s3_class( 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_s3_class(GET("https://google.com?per_page=30"), "response") }) test_that("wi_th handles HEADERS with varied input classes", { stub_registry_clear() library(httr, warn.conflicts = FALSE) enable("httr", quiet = TRUE) # works w/ numeric stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30)) expect_s3_class(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_s3_class(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_s3_class(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_s3_class(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_s3_class(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_s3_class(GET("https://x.com", add_headers(foo = 30)), "response") }) disable("httr", quiet = TRUE) test_that("wi_th basic_auth, crul", { skip_on_cran() # crul library(crul, warn.conflicts = FALSE) enable("crul", quiet = TRUE) 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_s3_class(con$get(), "HttpResponse") # ignores auth type con$auth <- crul::auth("user", "passwd", "digest") expect_s3_class(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", quiet = TRUE) }) test_that("wi_th basic_auth, httr", { library(httr, warn.conflicts = FALSE) enable("httr", quiet = TRUE) # pass stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth = c("user", "passwd")) expect_s3_class( GET("https://x.com", authenticate("user", "passwd")), "response" ) # ignores auth type expect_s3_class( GET("https://x.com", authenticate("user", "passwd", type = "digest")), "response" ) expect_s3_class( 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", quiet = TRUE) }) test_that("wi_th basic_auth, httr2", { skip_if_not_installed("httr2") library(httr2, warn.conflicts = FALSE) enable("httr2", quiet = TRUE) # 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_s3_class(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", "nomatch") # FIXME: this should fail # expect_no_error( # req_perform(req2) # ) expect_error( req_perform(req2), "Unregistered" ) disable("httr2", quiet = TRUE) }) # cleanup stub_registry_clear() test_that("wi_th_: defunct", { expect_error(wi_th_(), "wi_th", class = "error") }) webmockr/tests/testthat/test-within_test_that_blocks.R0000644000176200001440000000315415036226623023113 0ustar liggesuserssuppressPackageStartupMessages(library("httr", warn.conflicts = FALSE)) test_that("httr: without pipe", { httr_mock() enable(quiet = TRUE) 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_s3_class(res, "response") expect_type(content(res), "list") expect_named(content(res), "foo") expect_equal(content(res)$foo, "bar") disable(quiet = TRUE) httr_mock(FALSE) }) test_that("httr: with pipe", { enable(quiet = TRUE) 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_s3_class(res, "response") expect_type(content(res), "list") expect_named(content(res), "foo") expect_equal(content(res)$foo, "bar") disable(quiet = TRUE) }) unloadNamespace("httr") test_that("crul works", { skip_on_cran() enable(quiet = TRUE) 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_s3_class(res, "HttpResponse") expect_type(res$parse("UTF-8"), "character") expect_type(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(quiet = TRUE) }) webmockr/tests/testthat/test-StubRegistry.R0000644000176200001440000000561215027274165020650 0ustar liggesusersaa <- StubRegistry$new() test_that("StubRegistry: bits are correct prior to having data", { expect_s3_class(StubRegistry, "R6ClassGenerator") expect_s3_class(aa, "StubRegistry") expect_type(aa$request_stubs, "list") expect_equal(length(aa$request_stubs), 0) expect_null(aa$stub) expect_type(aa$find_stubbed_request, "closure") expect_type(aa$is_registered, "closure") expect_type(aa$print, "closure") expect_type(aa$register_stub, "closure") expect_type(aa$remove_all_request_stubs, "closure") expect_type(aa$remove_request_stub, "closure") expect_type(aa$request_stub_for, "closure") # expect_type(aa$response_for_request, "closure") }) 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_type(aa$register_stub(stub = stub1), "list") expect_type(aa$register_stub(stub = stub2), "list") expect_s3_class(aa, "StubRegistry") # request stubs now length 2 expect_type(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_type(res, "list") expect_s3_class(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_type(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_type(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_type(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" ) }) webmockr/tests/testthat/test-Httr2Adapter.R0000644000176200001440000001535415036220536020503 0ustar liggesusersskip_if_not_installed("httr2") library("httr2") aa <- Httr2Adapter$new() test_that("Httr2Adapter bits are correct", { skip_on_cran() expect_s3_class(Httr2Adapter, "R6ClassGenerator") expect_s3_class(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_type(aa$disable, "closure") expect_type(aa$enable, "closure") expect_type(aa$handle_request, "closure") expect_type(aa$remove_stubs, "closure") expect_type(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") }) # library(httr2) # z <- request(hb("/get")) %>% req_perform() # httr2_obj <- z$request # save(httr2_obj, file = "tests/testthat/httr2_obj.rda", version = 2) test_that("Httr2Adapter works", { skip_on_cran() load("httr2_obj.rda") # load("tests/testthat/httr2_obj.rda") res <- Httr2Adapter$new() # with webmockr message invisible(stub_request("get", hb("/get"))) aa <- res$handle_request(httr2_obj) expect_s3_class(res, "Httr2Adapter") expect_s3_class(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_s3_class(res, "Httr2Adapter") expect_s3_class(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() httr_mock() # httr_mock(FALSE) # sm(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_s3_class(x, "httr2_response") 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 = 3) # load("tests/testthat/httr2_obj_auth.rda") load("httr2_obj_auth.rda") zz <- Httr2Adapter$new() z <- zz$handle_request(httr2_obj_auth) expect_s3_class(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() enable(quiet = TRUE) 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 suppressMessages(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 sm(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(quiet = TRUE) 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) sm(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")) suppressMessages(webmockr_disable_net_connect()) }) disable(quiet = TRUE) test_that("httr2 requests with nested list bodies work", { skip_on_cran() enable(quiet = TRUE) # 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() sm(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 ) suppressMessages(webmockr_disable_net_connect()) }) webmockr/tests/testthat/test-pluck_body.R0000644000176200001440000000430215027274360020325 0ustar liggesuserstest_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_type(pluck_body(crul_body_upload_list), "list") # upload not in a list load("crul_body_upload_no_list.rda") expect_type(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_type(pluck_body(httr_body_upload_list), "list") # upload not in a list load("httr_body_upload_no_list.rda") expect_type(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.R0000644000176200001440000000172015036226604021204 0ustar liggesusersstub_registry_clear() request_registry_clear() enable(quiet = TRUE) test_that("webmockr_reset works", { skip_on_cran() # 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(quiet = TRUE) webmockr/tests/testthat/test-auth_handling.R0000644000176200001440000000271715036227025021003 0ustar liggesusers# from https://github.com/ropensci/webmockr/issues/108 # httr stub_registry()$remove_all_request_stubs() skip_if_not_installed("httr") suppressPackageStartupMessages(library("httr", warn.conflicts = FALSE)) enable("httr", quiet = TRUE) test_that("auth handling: httr", { stub_request("get", "http://stuff.com") # auth well-formed expect_s3_class( GET("http://stuff.com", authenticate("adf", "adf")), "response" ) # user name invalid according to RFC, but we can't know that expect_s3_class( 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(quiet = TRUE) stub_registry()$remove_all_request_stubs() skip_if_not_installed("crul") library("crul") enable("crul", quiet = TRUE) test_that("auth handling: crul", { skip_on_cran() stub_request("get", "http://stuff.com") # auth well-formed x <- HttpClient$new("http://stuff.com") x$auth <- auth("adf", "adf") expect_s3_class(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_s3_class(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(quiet = TRUE) 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.R0000644000176200001440000000367215036226745021245 0ustar liggesuserstest_that("to_return: setting body behaves correctly", { skip_on_cran() enable(quiet = TRUE) 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_type(z$content, "raw") expect_type(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_type(z$content, "raw") expect_type(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_type(z$content, "raw") expect_type(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_type(z$content, "raw") expect_type(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_type(z$content, "raw") expect_type(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/_snaps/0000755000176200001440000000000015036220536016352 5ustar liggesuserswebmockr/tests/testthat/_snaps/flipswitch.md0000644000176200001440000000027115036227220021045 0ustar liggesusers# can enable and disable quietly Code enable(quiet = TRUE) disable(quiet = TRUE) --- Code enable("crul", quiet = TRUE) disable("crul", quiet = TRUE) webmockr/tests/testthat/_snaps/Adapter.md0000644000176200001440000000435115036227217020262 0ustar liggesusers# show_body_diff configuration setting Code POST("https://hb.cran.dev/post", body = list(apple = "red")) Condition Error: ! Real HTTP connections are disabled. ! Unregistered request: i POST: https://hb.cran.dev/post with body {apple: red} with headers {Accept: application/json, text/xml, application/xml, */*} You can stub this request with the following snippet: stub_request('post', uri = 'https://hb.cran.dev/post') %>% wi_th( headers = list('Accept' = 'application/json, text/xml, application/xml, */*'), body = list(apple="red") ) registered request stubs: GET: https://hb.cran.dev/post with body {"apple":"green"} Body diff: < stub$body > request_s.. @@ 1,3 @@ @@ 1,3 @@ $apple $apple < [1] "green" > [1] "red" ============================================================ # show_body_diff configuration setting - > 1 stub Code POST("https://hb.cran.dev/post", body = list(apple = "red")) Condition Error: ! Real HTTP connections are disabled. ! Unregistered request: i POST: https://hb.cran.dev/post with body {apple: red} with headers {Accept: application/json, text/xml, application/xml, */*} You can stub this request with the following snippet: stub_request('post', uri = 'https://hb.cran.dev/post') %>% wi_th( headers = list('Accept' = 'application/json, text/xml, application/xml, */*'), body = list(apple="red") ) registered request stubs: GET: https://hb.cran.dev/post with body {"apple":"green"} GET: https://hb.cran.dev/post with body {"apple":"green"} GET: https://hb.cran.dev/post with body {"pear":"purple"} Body diff: i diffs: >1 stub found, showing diff with least differences < stub$body > request_s.. @@ 1,3 @@ @@ 1,3 @@ $apple $apple < [1] "green" > [1] "red" ============================================================ webmockr/tests/testthat/httr_obj.rda0000644000176200001440000000051615036220536017374 0ustar liggesusers]QN0t!$\sRvZqCb#z\IId͌0BGnQ4!lC}4a\rOm:;_;ЙR;B%fr'YFۧMhY:lXVmaYi}pV 4U<ϖȜ r\7O*/+|kQ}JmyQ n^guWC],Ju}LâB;nzf?+K^NEYT O\ڈ.xFw.G(ÀZYYwebmockr/tests/testthat/test-RequestSignature.R0000644000176200001440000000333715027274360021513 0ustar liggesuserstest_that("RequestSignature: works", { expect_s3_class(RequestSignature, "R6ClassGenerator") aa <- RequestSignature$new(method = "get", uri = hb("/get")) expect_s3_class(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_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(aa$uri, "character") expect_equal(aa$uri, hb("/get")) expect_type(aa$to_s, "closure") 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_type(aa$method, "character") expect_type(aa$uri, "character") expect_type(aa$headers, "list") expect_type(aa$body, "list") expect_type(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(quiet = TRUE) x <- request_registry() expect_s3_class(x, "RequestRegistry") expect_type(x$clone, "closure") expect_type(x$print, "closure") expect_type(x$register_request, "closure") expect_null(x$request) expect_s3_class(x$request_signatures, "HashCounter") expect_type(x$reset, "closure") expect_type(x$request_signatures$hash, "list") expect_match(names(x$request_signatures$hash), "GET") expect_type(x$request_signatures$hash[[1]]$count, "double") }) webmockr/tests/testthat/test-stub_body_diff.R0000644000176200001440000000321715036231465021157 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.cran.dev/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", { skip_on_cran() request_registry_clear() stub_registry_clear() enable(quiet = TRUE) 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", { skip_on_cran() request_registry_clear() stub_registry_clear() enable(quiet = TRUE) stub_request("post", "https://hb.cran.dev/post") %>% wi_th(body = list(apple = "green")) library(crul, warn.conflicts = FALSE) expect_error( HttpClient$new("https://hb.cran.dev")$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.R0000644000176200001440000000062015036227002020673 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", { skip_on_cran() request_registry_clear() enable(quiet = TRUE) stub_request("head", "https://nytimes.com") crul::ok("https://nytimes.com") last_request() expect_s3_class(last_request(), "RequestSignature") }) webmockr/tests/testthat/test-to_return.R0000644000176200001440000001625515036226726020230 0ustar liggesusersstub_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_s3_class(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(aa$uri, "character") expect_equal(aa$uri, hb("/get")) # to_return expected stuff expect_type(aa$response_headers, "list") expect_named(aa$response_headers, "a") expect_equal(aa$response_headers$a, 5) expect_type(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(quiet = TRUE) test_that("to_return (response) headers are all lowercase, crul", { skip_on_cran() stub <- stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = "baz")) cli <- crul::HttpClient$new(url = hb()) x <- cli$get("get") expect_type(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_type(x$headers, "list") expect_named(x$headers, "foo-bar") }) disable(quiet = TRUE) stub_registry_clear() enable(quiet = TRUE) 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_s3_class(x$headers, "httr2_headers") expect_named(x$headers, "foo-bar") }) disable(quiet = TRUE) stub_registry_clear() enable(quiet = TRUE) 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_s3_class(x$headers, "httr2_headers") }) disable(quiet = TRUE) stub_registry_clear() enable(quiet = TRUE) test_that("to_return response header values are all character, crul", { skip_on_cran() cli <- crul::HttpClient$new(url = hb()) stub_request(uri = hb("/get")) %>% to_return(headers = list("Foo-Bar" = 10)) x <- cli$get("get") expect_type(x$response_headers, "list") expect_named(x$response_headers, "foo-bar") expect_type(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_type(z$response_headers, "list") expect_named(z$response_headers, letters[1:5]) invisible( vapply(z$response_headers, function(z) expect_type(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_type(x$headers, "list") expect_named(x$headers, "foo-bar") expect_type(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_type(z$headers, "list") expect_named(z$headers, letters[1:5]) invisible( vapply(z$headers, function(z) expect_type(z, "character"), "") ) expect_equal(z$headers$c, "2344.342342") expect_equal(z$headers$e, "blue") }) disable(quiet = TRUE) enable(quiet = TRUE) 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_s3_class(x$headers, "httr2_headers") expect_named(x$headers, "foo-bar") expect_type(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_s3_class(z$headers, "httr2_headers") expect_named(z$headers, letters[1:5]) invisible( vapply(z$headers, function(z) expect_type(z, "character"), "") ) expect_equal(z$headers$c, "2344.342342") expect_equal(z$headers$e, "blue") }) disable(quiet = TRUE) 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(quiet = TRUE) 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(quiet = TRUE) webmockr/tests/testthat/test-zutils.R0000644000176200001440000001431415036231510017516 0ustar liggesuserstest_that("normalize_uri", { # prunes trailing slash expect_type(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" ) }) test_that("net_connect_explicit_allowed", { aa <- net_connect_explicit_allowed( allowed = "example.com", uri = "http://example.com" ) expect_type(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" ) }) 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( sm(webmockr_net_connect_allowed(mtcars)), "class character or list" ) }) 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_type(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_type( 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" ) }) 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(sm(webmockr_net_connect_allowed())) # errors when an argument passed expect_error(sm(webmockr_allow_net_connect(5)), "unused argument") }) test_that("show_stubbing_instructions", { skip_on_cran() enable(quiet = TRUE) x <- crul::HttpClient$new("https://hb.cran.dev/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(quiet = TRUE) }) test_that("webmockr_configuration", { expect_s3_class(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") }) 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") }) test_that("webmockr_disable", { expect_error(webmockr_disable(), "disable", class = "error") }) test_that("webmockr_enable", { expect_error(webmockr_enable(), "enable", class = "error") }) 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) }) 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) }) test_that("query_mapper", { expect_type(query_mapper, "closure") 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.rda0000644000176200001440000000057015036220536020415 0ustar liggesusers]QN0퀉#jL|nbe7ğ{3ݑRmq} $ =z啷6p=`@8`DZ<`&U"]N["iѡ.T]!!$0("!cS`&(҄`mG;vY:g1DÎ~3*:VTzYz:OW^©3@Sx D󵛸jy5*ZڢHF:(xMs:*䦗@}1HIjȣ-O$ 21p'5*s[s2*cf|*%#ʅѭF} dd47rVʢt$%qQRwebmockr/tests/testthat/test-stub_request.R0000644000176200001440000000246215027274165020727 0ustar liggesusersstub_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_s3_class(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_type(aa$method, "character") expect_equal(aa$method, "get") expect_type(aa$uri, "character") expect_equal(aa$uri, hb("/get")) expect_type(aa$print, "closure") expect_output(aa$print(), "") expect_type(aa$to_return, "closure") expect_error(aa$to_return(), "argument \"body\" is missing") expect_type(aa$to_s, "closure") expect_equal(aa$to_s(), sprintf("GET: %s", hb("/get"))) expect_type(aa$with, "closure") expect_null(aa$with()) expect_type(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/MD50000644000176200001440000002031615037344522012402 0ustar liggesusers0873b034df1d650d7dc5520bcf313b6d *DESCRIPTION aed2f6fd7c66d41e23923b84acb5f26b *LICENSE 01566435ac6ce43c1a4cafd6423039fb *NAMESPACE 2a6ec8b40422ef0983fb12fe7f7d53a1 *NEWS.md 6a286f62c9edfea083bc72b9d080b3a4 *R/HttpLibAdapterRegistry.R 262e5886ecc1f9952872d39fdb8c4e0c *R/RequestPattern.R 9b6e5057419f12edc77aff2690f1ef8b *R/RequestRegistry.R d4f52d5eb9858ae8993962394e6d9595 *R/RequestSignature.R e983d21ac204c7f28ce685e41db389a0 *R/Response.R 4536221abbcd5e804056fd94a7fe7fc4 *R/StubRegistry.R 4a3e4e6a6691591b14e8c8b7d4ebe079 *R/StubbedRequest.R f3922aa35a0eff6ae743f00f67164d25 *R/adapter-crul.R b37471d7db080f3990c8b955033a3cac *R/adapter-httr.R c117e9771bad201b5fe40084ddcf4f26 *R/adapter-httr2.R 152781e491ab1651a663fe770faa0369 *R/adapter.R c106024d861656a99ed8fae3c1620c94 *R/defunct.R 64ed19689c22021a6a97f1b3e21d57dd *R/error-handling.R 3986ed099dcd5d4ba0d645d669bdcb80 *R/flipswitch.R 34e03368d6a9504c6d10597ef2b224a1 *R/headers.R 1c957057e7bb4cc4ab94871d4fcbec9d *R/last.R cb69b3d0c23dce6e20b1f66ce91aed19 *R/mock_file.R 416575dd4dac7722e8c4623a85a19cc3 *R/mocking-disk-writing.R 58c0d470ed1db51c40c7bcb8e7a45e19 *R/onload.R a308e4812eec1f3098429bbc705e4298 *R/partial.R f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/pipe.R 20b0e67dd701837f86e81811d2192dc3 *R/pluck_body.R aa12d9f41853fcaa472a38155289fb4f *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 ab958c8456bc5180bfce088c42cf52ea *R/stub_request.R fff775614a69af3cc43423ddc5781b69 *R/to_raise.R 6f2eb608f809d8a148841178809bdcf0 *R/to_return.R dca6a47767b6cb027f9fffa4fee1d6e5 *R/to_timeout.R 0b8f19fd9fb12b2bc45d74431b306a8d *R/webmockr-opts.R 71f26e6af650f20e90f2747dc6009c64 *R/webmockr-package.R 4aca567a1967f684b74a9ea5be84d7ff *R/webmockr_reset.R c93fe0a954e4d418f5bafe11f703206f *R/wi_th.R 30359a79caf4e27a809cb7ee3beb9ca0 *R/zzz.R bfab6207f448fab82e6cd42ebc3abbf2 *inst/ignore/adapter-httr.R c2dad18498a5fbbfa1ad2b9618072bcb *inst/ignore/sockets.R ab6a831601b90555c1a4aa3e48b753cf *man/Adapter.Rd f03ca638cc936efa9e042917cb0e6ca5 *man/BodyPattern.Rd 7d9f2a80625b85c28d5f4543e1f5545d *man/HashCounter.Rd 6790b9bf283b18978915affea5b2e1e7 *man/HeadersPattern.Rd cb30665c62220bb4831eb21c1379e87d *man/HttpLibAdapaterRegistry.Rd 13f3749d9458920df72c5eb06470544d *man/MethodPattern.Rd 523ad2505d00791fa5f721c217127b0c *man/RequestPattern.Rd b027ba4ea5d42d52eb16cd0720c458de *man/RequestRegistry.Rd 4d17b27f733be4314fae8c7f2420edcd *man/RequestSignature.Rd 1ef81b91d28539ed5c767260d914a14d *man/Response.Rd fae0fbae1e671647caaba747c3c18ea4 *man/StubCounter.Rd 35c757acd72be9e6a68efc0d91835ef7 *man/StubRegistry.Rd ad867d10b5711a86dbb7c6b1b85356bc *man/StubbedRequest.Rd 4e3759ee59c4c8de3b2654a533fb9288 *man/UriPattern.Rd 256d5dd447132cc4c2eb8a74350bb7d2 *man/build_crul_request.Rd c3c7e0f34d25023e481d7d91721fefa6 *man/build_crul_response.Rd bdd1cd27f8f6db7b6c5f8534acdd708f *man/build_httr2_request.Rd 0aaf5a95f9dea9f1dcbc28cecc04e56e *man/build_httr2_response.Rd fa4df46b3da6c0adaee5ac3746fb0b92 *man/build_httr_request.Rd 8395b0c7d22b91fb092a7957df22d4f3 *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 65df9c7db877e533a01663abb373c156 *man/mocking-disk-writing.Rd e17f41e959fd90a1736ad0fc8ee7ff81 *man/pipe.Rd 2c5fd8e7ce58b72529f593e5d33fcf09 *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 979231df2024bfeab8e3b8617b5ad533 *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 2926d73aaf138c661f879667ecfd8d02 *man/webmockr-package.Rd 9d55dd7209f6ed3e1cc4792c2271add6 *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 4605ec295f9e21a215201da4d01154bc *tests/testthat/_snaps/Adapter.md 6eb1ca179c6aea8c4abd99c2bd101983 *tests/testthat/_snaps/flipswitch.md 9b69fa7ce58021b08f11de7c6412b32e *tests/testthat/crul_body_upload_list.rda 9b6c5be18b4fc24baf77fdff0b7af1d0 *tests/testthat/crul_body_upload_no_list.rda 43e9a3a2f19d982c0919de0490556d0c *tests/testthat/crul_obj.rda 2254413c198bfa587e794d9f4cf000f0 *tests/testthat/helper-webmockr.R f91e040f80f9ebcc4a6d91fe9ce02539 *tests/testthat/httr2_obj.rda 20f50cfc65b05a96db38bd47a7c1763a *tests/testthat/httr2_obj_auth.rda eb5571d890cfb38097090fe789ef84e1 *tests/testthat/httr_body_upload_list.rda b11125facccee9440f7cf052fdaa33b3 *tests/testthat/httr_body_upload_no_list.rda 6c3591898e524a9329b4ee62995e5383 *tests/testthat/httr_obj.rda cbaf1b631bcba2f94d25523ef553defc *tests/testthat/httr_obj_auth.rda 90cac7fdfd03a4af3cccc4f173040663 *tests/testthat/test-Adapter.R 505d9334facee0baef9e8e7a3c4d4d98 *tests/testthat/test-CrulAdapter.R 3ee155b9fdce7e9c1ffdbebe4e8e527a *tests/testthat/test-HashCounter.R 7da7d50984d6bf20ceb7eff60d70e93a *tests/testthat/test-HttpLibAdapaterRegistry.R 9f1b95cc89ad03bfad8b48a8bfdbd821 *tests/testthat/test-Httr2Adapter.R ac39febfc285807f69a05e3cbc351f0e *tests/testthat/test-HttrAdapter.R 42cf38d133dcbd1e9f8487fede70d35f *tests/testthat/test-RequestPattern.R c0319c8d3259568a5579bf2d14e76318 *tests/testthat/test-RequestRegistry.R 1f7f32fe4fef06c0996360af4bd9e929 *tests/testthat/test-RequestSignature.R b59d3562ee6d886d276bf0e19bd74372 *tests/testthat/test-Response.R 5e581cafee435cf80ce888a99aa0f456 *tests/testthat/test-StubRegistry.R cb102170d0a47856a9d0857a8c2fd0a8 *tests/testthat/test-StubbedRequest.R 7950dbf78e6ef033281f9d8b32cead31 *tests/testthat/test-auth_handling.R 27735bb57d9c2091ee25bbf022156432 *tests/testthat/test-flipswitch.R 86ad861425307a4625c3924b6136cc94 *tests/testthat/test-last_request.R 57f9b85948ec1415a74a64f170154aeb *tests/testthat/test-last_stub.R c9ea4ba6283b639214b6234ff3871cdd *tests/testthat/test-onload.R 407c528bd362a324b1914887c61c348c *tests/testthat/test-partial_matching.R 0ee87d41b3d1e1f0f0843be30e569de4 *tests/testthat/test-pluck_body.R fe3ed34d7ee41a1954686023912db8cb *tests/testthat/test-remove_request_stub.R 749f5111a6aff8bf8c3f6430add367ad *tests/testthat/test-request_registry.R 058a8ec241a405141db3abfaec087c6e *tests/testthat/test-stub_body_diff.R 4687cf08771ba431aa6beca6e8974d99 *tests/testthat/test-stub_registry.R 38b80c7e135609bad4f2912eefc1daa4 *tests/testthat/test-stub_request.R 919ab4e9efe168b0bb9f4fa6e4972a86 *tests/testthat/test-stub_requests_crul.R a92db4ec281930a604f374f00dc10f10 *tests/testthat/test-to_raise.R b9da1166f2bb2eac9ec5e45e2b7504a7 *tests/testthat/test-to_return.R 77e2dc164cc0878e37a5f61037ad6832 *tests/testthat/test-to_return_body.R e67a3e9494472b2f0af2e4e0c95504d8 *tests/testthat/test-to_return_then.R eb39ccb7490e097815d74a0a1529ad02 *tests/testthat/test-to_timeout.R aed28f1ac30d752ac45e336715960d2f *tests/testthat/test-uri_regex.R 5fe9677794c8c01e24493237024562e9 *tests/testthat/test-webmockr_reset.R ed32b579e6789196068854563071b9bb *tests/testthat/test-wi_th.R c837340715c773c5510f728197c4184a *tests/testthat/test-within_test_that_blocks.R e162b7a6464a4c26488086c52f5d8ab7 *tests/testthat/test-writing-to-disk.R a29d1eacd8e684a02c18c1e6ecb776b9 *tests/testthat/test-zutils.R webmockr/R/0000755000176200001440000000000015036234175012272 5ustar liggesuserswebmockr/R/to_raise.R0000644000176200001440000000361114777263712014235 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.R0000644000176200001440000000567115036220536015103 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 #' @keywords internal #' @param req a request #' @param resp a response #' @return an httr2 response (`httr2_response`) 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 #' @keywords internal #' @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) { options(httr2_mock = function(req) Httr2Adapter$new()$handle_request(req)) } else { options(httr2_mock = NULL) } invisible(on) } #' @rdname Adapter #' @export #' @keywords internal 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, fetch_request = function(request) httr2::req_perform(request) ) ) webmockr/R/StubRegistry.R0000644000176200001440000001200415027276417015065 0ustar liggesusers#' @title StubRegistry #' @description stub registry to keep track of [StubbedRequest] stubs #' @keywords internal #' @family stub-registry 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.R0000644000176200001440000000674315036232337015152 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 #' # 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() #' #' # 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.R0000644000176200001440000000025315027276417015133 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.R0000644000176200001440000001153415027274165015220 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 #' 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) #' #' # cleanup #' webmockr_configure_reset() 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.R0000644000176200001440000002506715027540706015370 0ustar liggesusers#' @title StubCounter #' @description hash with counter to store requests and count number #' of requests made against the stub #' @keywords internal 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()] #' @keywords internal #' @seealso [stub_request()] 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.R0000644000176200001440000001420115036220536013244 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)]] } webmockr/R/HttpLibAdapterRegistry.R0000644000176200001440000000203615027274165017021 0ustar liggesusers#' @title HttpLibAdapaterRegistry #' @description http lib adapter registry #' @keywords internal 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.R0000644000176200001440000000727615036220536015024 0ustar liggesusers#' Build a httr response #' @export #' @keywords internal #' @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 #' @keywords internal #' @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 #' @keywords internal 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, 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.R0000644000176200001440000000614315036220536014571 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 (!is_installed(adapter)) { if (!quiet) { 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 (!is_installed(pkgname)) { if (!quiet) { 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 (!is_installed(adapter)) { if (!quiet) { 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 (!is_installed(pkgname)) { if (!quiet) { message(pkgname, " not installed, skipping disable") } FALSE } else { # if instaled, disable z$disable(quiet) } }, logical(1) )) } } webmockr/R/webmockr-package.R0000644000176200001440000000155415036220536015620 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} #' - 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 cli cli_abort ansi_collapse format_error cat_line #' @importFrom fauxpas HTTPRequestTimeout #' @importFrom R6 R6Class #' @importFrom rlang abort warn check_installed is_list is_function is_error #' caller_arg try_fetch caller_env is_installed has_name ## 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.R0000644000176200001440000001313615027274165014222 0ustar liggesusers#' @title Response #' @description custom webmockr http response class #' @export #' @keywords internal #' @examples #' (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.R0000644000176200001440000000660715036223645015607 0ustar liggesusers#' @title HashCounter #' @description hash with counter, to store requests, and count each time #' it is used #' @keywords internal #' @family request-registry 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 #' @keywords internal #' @family request-registry #' @seealso [stub_registry()] and [StubRegistry] 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) { if (missing(request_pattern)) { cli_abort("{.arg request_pattern} is required") } if (!inherits(request_pattern, "RequestPattern")) { cli_abort("{.arg request_pattern} must be of class 'RequestPattern'") } if (is_empty(self$request_signatures$hash)) { return(0) } 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.R0000644000176200001440000001000315027276417014435 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.R0000644000176200001440000002471015036220536014035 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. #' @keywords internal 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) 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 private$mock(on = FALSE) resp <- private$fetch_request(req) private$mock(on = TRUE) # request is not in cache and connections are not allowed } else { # 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.R0000644000176200001440000000637715036233755016475 0ustar liggesusers#' Mocking writing to disk #' #' @name mocking-disk-writing #' @examplesIf interactive() #' # enable mocking #' enable() #' #' # 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) #' stub_registry_clear() #' #' # 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") #' stub_registry_clear() #' #' # 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$headers #' readLines(out$body) #' stub_registry_clear() #' #' # 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) #' stub_registry_clear() #' #' # 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") #' stub_registry_clear() #' #' # 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) #' stub_registry_clear() #' #' # disable mocking #' disable() NULL webmockr/R/wi_th.R0000644000176200001440000001152415027276417013537 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.R0000644000176200001440000001246215036223645015734 0ustar liggesusers#' @title RequestSignature #' @description General purpose request signature builder #' @export #' @keywords internal #' @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.R0000644000176200001440000004671415027617111015412 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] 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 #' @keywords internal #' @details Matches regardless of case. e.g., POST will match to post 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 #' @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")` 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) self_pattern_for_matching <- headers_flatten(self$pattern) headers <- headers_flatten(headers) out <- c() for (i in seq_along(self_pattern_for_matching)) { out[i] <- names(self_pattern_for_matching)[i] %in% names(headers) && self_pattern_for_matching[[i]] == headers[[names(self_pattern_for_matching)[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 #' @keywords internal 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 #' @keywords internal 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) } # adapted from httr2:::headers_flatten # headers_flatten(req$headers) headers_flatten <- function(x) { is_redacted <- wm_is_redacted(x) out <- vector("list", length(x)) names(out) <- names(x) out[!is_redacted] <- lapply(x[!is_redacted], paste, collapse = ",") out[is_redacted] <- lapply(x[is_redacted], rlang::wref_value) out[is_redacted] <- lapply(out[is_redacted], function(x) { if (!is.null(x)) { paste(x, collapse = ",") } }) Filter(length, out) } wm_is_redacted <- function(x) { if (rlang::is_weakref(x)) { return(TRUE) } if (is.list(x)) { vapply(x, rlang::is_weakref, logical(1)) } else { rlang::is_weakref(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.R0000644000176200001440000000526115036220536015000 0ustar liggesusers#' Build a crul response #' @export #' @keywords internal #' @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 #' @keywords internal #' @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 ) ) } crul_mock <- function(on = TRUE) { check_installed("crul") if (on) { options(crul_mock = function(req) { webmockr::CrulAdapter$new()$handle_request(req) }) } else { options(crul_mock = NULL) } invisible(on) } #' @rdname Adapter #' @export #' @keywords internal 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)) } ) ) webmockr/R/pluck_body.R0000644000176200001440000000320115036220536014540 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. #' #' @param x an unexecuted crul, httr *or* httr2 request object #' @export #' @keywords internal #' @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 ( has_name(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) && (!has_name(x$options, "postfieldsize_large") || x$options$postfieldsize_large == 0L) && (!has_name(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/headers.R0000644000176200001440000000270514777263766014057 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/NAMESPACE0000644000176200001440000000350515036223645013313 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(print,mock_file) S3method(print,partial) S3method(print,webmockr_config) export("%>%") export(CrulAdapter) export(Httr2Adapter) export(HttrAdapter) export(RequestPattern) export(RequestSignature) export(Response) export(build_crul_response) export(build_httr2_request) export(build_httr2_response) 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(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,has_name) importFrom(rlang,is_empty) importFrom(rlang,is_error) importFrom(rlang,is_function) importFrom(rlang,is_installed) 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.md0000644000176200001440000004406315036224416013173 0ustar liggesuserswebmockr (2.2.0) ========= ## MINOR IMPROVEMENTS * webmockr is no longer integrated with vcr; the two packages used to depend on one another, but no longer do. this should not impact your usage of `webmockr` (#149) (#150) * better implementation of quiet in `enable()`/`disable()` (#146) thanks @hadley * eliminate partial match warnings (#147) thanks @hadley webmockr (2.1.0) ========= ## MINOR IMPROVEMENTS * Many previously exported R6 classes that are internal use only are no longer exported. `RequestPattern` is still exported in this version, but will not be in the next version * Improve how httr2 mocking is set (#114) thanks @hadley * Correctly check that vcr is loaded, not attached (#142) thanks @hadley * Update tests to use testthat edition 3, and run in parallel * Moved `crul` from Imports to Suggests. replace use of a `crul` function with an equivalent from `curl` so `crul` is truly not needed to run `wemockr` unless using `crul` webmockr 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/0000755000176200001440000000000015036223645012644 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.Rd0000644000176200001440000000130215027274165015265 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. } \keyword{internal} webmockr/man/BodyPattern.Rd0000644000176200001440000000541615027274165015377 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 } \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.Rd0000644000176200001440000000053215027274165017032 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 } \keyword{internal} 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.Rd0000644000176200001440000001276015027274165015241 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 } \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.Rd0000644000176200001440000000472215027274165015366 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 } \seealso{ Other request-registry: \code{\link{RequestRegistry}}, \code{\link{request_registry}()} } \concept{request-registry} \keyword{internal} \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.Rd0000644000176200001440000002336715027274165014747 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{ (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() } \keyword{internal} \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.Rd0000644000176200001440000000532015027274165015714 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 } \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.Rd0000644000176200001440000000055315027274165017203 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 } \keyword{internal} 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.Rd0000644000176200001440000000454115027274165017014 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{ 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) # cleanup webmockr_configure_reset() } webmockr/man/HttpLibAdapaterRegistry.Rd0000644000176200001440000000456715027274165017713 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 } \keyword{internal} \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.Rd0000644000176200001440000002443015027274165014521 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. } \keyword{internal} \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.Rd0000644000176200001440000000675415027617241016134 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 } \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.Rd0000644000176200001440000000053215027274165017046 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 } \keyword{internal} 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.Rd0000644000176200001440000001025515036223645016450 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() } \keyword{internal} \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.Rd0000644000176200001440000000747015027274165016327 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 } \seealso{ \code{\link[=stub_registry]{stub_registry()}} and \link{StubRegistry} Other request-registry: \code{\link{HashCounter}}, \code{\link{request_registry}()} } \concept{request-registry} \keyword{internal} \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.Rd0000644000176200001440000000055315027274165017133 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 } \keyword{internal} webmockr/man/HeadersPattern.Rd0000644000176200001440000000722615027274165016056 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")} } \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.Rd0000644000176200001440000000631015036233770017173 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{ \dontshow{if (interactive()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} # enable mocking enable() # 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) stub_registry_clear() # 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") stub_registry_clear() # 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$headers readLines(out$body) stub_registry_clear() # 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) stub_registry_clear() # 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") stub_registry_clear() # 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) stub_registry_clear() # disable mocking disable() \dontshow{\}) # examplesIf} } 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.Rd0000644000176200001440000000067315027274165017304 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}) } \keyword{internal} 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.Rd0000644000176200001440000000055315027274165017217 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 } \keyword{internal} webmockr/man/StubCounter.Rd0000644000176200001440000000423115027274165015413 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 } \keyword{internal} \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.Rd0000644000176200001440000000317515036220536016337 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 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.Rd0000644000176200001440000000725415036232440015661 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{ # 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() # 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.Rd0000644000176200001440000001470715027274165015615 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 } \seealso{ Other stub-registry: \code{\link{remove_request_stub}()}, \code{\link{stub_registry}()}, \code{\link{stub_registry_clear}()} } \concept{stub-registry} \keyword{internal} \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.Rd0000644000176200001440000001577515027274165016116 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()}} } \seealso{ \code{\link[=stub_request]{stub_request()}} } \keyword{internal} \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/DESCRIPTION0000644000176200001440000000353415037344522013603 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.2.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, rlang, cli Suggests: testthat (>= 3.0.0), xml2, crul, httr, httr2, diffobj, withr RoxygenNote: 7.3.2 Config/testthat/edition: 3 Config/testthat/parallel: true 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-07-17 17:53:01 UTC; sckott Author: Scott Chamberlain [aut, cre] (ORCID: ), Aaron Wolen [ctb] (ORCID: ), rOpenSci [fnd] (ROR: ) Maintainer: Scott Chamberlain Repository: CRAN Date/Publication: 2025-07-21 05:00:02 UTC