webmockr/0000755000176200001440000000000014023430252012056 5ustar liggesuserswebmockr/NAMESPACE0000644000176200001440000000251614022760004013301 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(print,mock_file) S3method(print,webmockr_config) export("%>%") export(Adapter) export(BodyPattern) export(CrulAdapter) export(HashCounter) export(HeadersPattern) export(HttpLibAdapaterRegistry) export(HttrAdapter) export(MethodPattern) export(RequestPattern) export(RequestRegistry) export(RequestSignature) export(Response) export(StubRegistry) export(StubbedRequest) export(UriPattern) export(build_crul_request) export(build_crul_response) export(build_httr_request) export(build_httr_response) export(disable) export(enable) export(enabled) export(httr_mock) export(mock_file) export(pluck_body) export(remove_request_stub) export(request_registry) export(request_registry_clear) 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(base64enc,base64encode) importFrom(crul,mock) importFrom(fauxpas,HTTPRequestTimeout) importFrom(magrittr,"%>%") webmockr/LICENSE0000644000176200001440000000005713665341057013104 0ustar liggesusersYEAR: 2020 COPYRIGHT HOLDER: Scott Chamberlain webmockr/man/0000755000176200001440000000000014022530740012633 5ustar liggesuserswebmockr/man/enable.Rd0000644000176200001440000000210014022530740014341 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' or 'httr'. 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{ \code{enable()} enables \pkg{webmockr} for all adapters. \code{disable()} disables \pkg{webmockr} for all adapters. \code{enabled()} answers whether \pkg{webmockr} is enabled for a given adapter } webmockr/man/HashCounter.Rd0000644000176200001440000000476313665341057015374 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \name{HashCounter} \alias{HashCounter} \title{HashCounter} \description{ hash with counter, to store requests, and count each time it is used } \examples{ x <- HashCounter$new() x$hash z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") x$put(z) x$hash x$get(z) x$put(z) x$get(z) } \seealso{ Other request-registry: \code{\link{RequestRegistry}}, \code{\link{request_registry}()} } \concept{request-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{hash}}{(list) a list for internal use only, with elements \code{key}, \code{sig}, and \code{count}} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-put}{\code{HashCounter$put()}} \item \href{#method-get}{\code{HashCounter$get()}} \item \href{#method-clone}{\code{HashCounter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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/stub_request.Rd0000644000176200001440000001254614022751552015665 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.} \item{uri_regex}{(character) A URI represented as regex. required, if \code{uri} not given. See examples} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub. } \description{ Stub an http request } \details{ Internally, this calls \link{StubbedRequest} which handles the logic See \code{\link[=stub_registry]{stub_registry()}} for listing stubs, \code{\link[=stub_registry_clear]{stub_registry_clear()}} for removing all stubs and \code{\link[=remove_request_stub]{remove_request_stub()}} for removing specific stubs 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 } \section{Matching URI's}{ \itemize{ \item Trailing slashes are dropped from stub URIs before matching \item Query parameters are dropped from stub URIs before matching; URIs are compared without query parameters } } \section{Mocking writing to disk}{ See \link{mocking-disk-writing} } \examples{ \dontrun{ # basic stubbing stub_request("get", "https://httpbin.org/get") stub_request("post", "https://httpbin.org/post") # any method, use "any" stub_request("any", "https://httpbin.org/get") # list stubs stub_registry() # request headers stub_request("get", "https://httpbin.org/get") \%>\% wi_th(headers = list('User-Agent' = 'R')) # request body stub_request("post", "https://httpbin.org/post") \%>\% wi_th(body = list(foo = 'bar')) stub_registry() library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org") crul::mock() x$post('post', body = list(foo = 'bar')) # add expectation with to_return stub_request("get", "https://httpbin.org/get") \%>\% wi_th( query = list(hello = "world"), headers = list('User-Agent' = 'R')) \%>\% to_return(status = 200, body = "stuff", headers = list(a = 5)) # list stubs again stub_registry() # regex stub_request("get", uri_regex = ".+ample\\\\..") # set stub an expectation to timeout stub_request("get", "https://httpbin.org/get") \%>\% to_timeout() x <- crul::HttpClient$new(url = "https://httpbin.org") res <- x$get('get') # raise exception library(fauxpas) stub_request("get", "https://httpbin.org/get") \%>\% to_raise(HTTPAccepted) stub_request("get", "https://httpbin.org/get") \%>\% to_raise(HTTPAccepted, HTTPGone) x <- crul::HttpClient$new(url = "https://httpbin.org") stub_request("get", "https://httpbin.org/get") \%>\% to_raise(HTTPBadGateway) crul::mock() x$get('get') # pass a list to .list z <- stub_request("get", "https://httpbin.org/get") wi_th(z, .list = list(query = list(foo = "bar"))) # just body stub_request("any", uri_regex = ".+") \%>\% wi_th(body = list(foo = 'bar')) ## with crul library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org") crul::mock() x$post('post', body = list(foo = 'bar')) x$put('put', body = list(foo = 'bar')) ## with httr library(httr) httr_mock() POST('https://example.com', body = list(foo = 'bar')) PUT('https://google.com', body = list(foo = 'bar')) # just headers headers <- list( 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*') stub_request("any", uri_regex = ".+") \%>\% wi_th(headers = headers) library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org", headers = headers) crul::mock() x$post('post') x$put('put', body = list(foo = 'bar')) x$get('put', query = list(stuff = 3423234L)) # many responses ## the first response matches the first to_return call, and so on stub_request("get", "https://httpbin.org/get") \%>\% to_return(status = 200, body = "foobar", headers = list(a = 5)) \%>\% to_return(status = 200, body = "bears", headers = list(b = 6)) con <- crul::HttpClient$new(url = "https://httpbin.org") con$get("get")$parse("UTF-8") con$get("get")$parse("UTF-8") ## OR, use times with to_return() to repeat the same response many times library(fauxpas) stub_request("get", "https://httpbin.org/get") \%>\% to_return(status = 200, body = "apple-pie", times = 2) \%>\% to_raise(HTTPUnauthorized) con <- crul::HttpClient$new(url = "https://httpbin.org") con$get("get")$parse("UTF-8") con$get("get")$parse("UTF-8") con$get("get")$parse("UTF-8") # 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/build_crul_response.Rd0000644000176200001440000000053013145163224017166 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \name{build_crul_response} \alias{build_crul_response} \title{Build a crul response} \usage{ build_crul_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ a crul response } \description{ Build a crul response } webmockr/man/to_timeout.Rd0000644000176200001440000000102513241473156015321 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/to_raise.Rd0000644000176200001440000000305614022732411014732 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 or crul typically returns, then you'll want \code{to_return()}. } webmockr/man/pluck_body.Rd0000644000176200001440000000125013665341057015270 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 \emph{or} httr request object} } \value{ one of the following: \itemize{ \item \code{NULL} if the request is not associated with a body \item \code{NULL} if an upload is used not in a list \item list containing the multipart-encoded body \item character vector with the JSON- or raw-encoded body, or upload form file } } \description{ Returns an appropriate representation of the data contained within a request body based on its encoding. } webmockr/man/RequestPattern.Rd0000644000176200001440000001123313705632634016124 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{RequestPattern} \alias{RequestPattern} \title{RequestPattern class} \description{ class handling all request matchers } \examples{ \dontrun{ (x <- RequestPattern$new(method = "get", uri = "httpbin.org/get")) x$body_pattern x$headers_pattern x$method_pattern x$uri_pattern x$to_s() # make a request signature rs <- RequestSignature$new(method = "get", uri = "http://httpbin.org/get") # check if it matches x$matches(rs) # regex uri (x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org")) x$uri_pattern x$uri_pattern$to_s() x$to_s() # uri with query parameters (x <- RequestPattern$new( method = "get", uri = "https://httpbin.org/get", query = list(foo = "bar") )) x$to_s() ## query params included in url, not separately (x <- RequestPattern$new( method = "get", uri = "https://httpbin.org/get?stuff=things" )) x$to_s() x$query_params # just headers (via setting method=any & uri_regex=.+) headers <- list( 'User-Agent' = 'Apple', 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*') x <- RequestPattern$new( method = "any", uri_regex = ".+", headers = headers) x$to_s() rs <- RequestSignature$new(method = "any", uri = "http://foo.bar", options = list(headers = headers)) rs x$matches(rs) # body x <- RequestPattern$new(method = "post", uri = "httpbin.org/post", body = list(y = crul::upload(system.file("CITATION")))) x$to_s() rs <- RequestSignature$new(method = "post", uri = "http://httpbin.org/post", options = list( body = list(y = crul::upload(system.file("CITATION"))))) rs x$matches(rs) } } \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-new}{\code{RequestPattern$new()}} \item \href{#method-matches}{\code{RequestPattern$matches()}} \item \href{#method-to_s}{\code{RequestPattern$to_s()}} \item \href{#method-clone}{\code{RequestPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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 )}\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} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{RequestPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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.Rd0000644000176200001440000000050713415716025017043 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{build_httr_request} \alias{build_httr_request} \title{Build a httr request} \usage{ build_httr_request(x) } \arguments{ \item{x}{an unexecuted httr request object} } \value{ a httr request } \description{ Build a httr request } webmockr/man/UriPattern.Rd0000644000176200001440000001723013733453474015242 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{UriPattern} \alias{UriPattern} \title{UriPattern} \description{ uri matcher } \examples{ # trailing slash (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://foobar.com") # TRUE z$matches("http://foobar.com/") # TRUE # without scheme ## matches http by default: does not match https by default (z <- UriPattern$new(pattern = "foobar.com")) z$matches("http://foobar.com") # TRUE z$matches("http://foobar.com/") # TRUE z$matches("https://foobar.com") # FALSE z$matches("https://foobar.com/") # FALSE ## to match https, you'll have to give the complete url (z <- UriPattern$new(pattern = "https://foobar.com")) z$matches("https://foobar.com/") # TRUE z$matches("http://foobar.com/") # FALSE # default ports (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://foobar.com:80") # TRUE z$matches("http://foobar.com:80/") # TRUE z$matches("http://foobar.com:443") # TRUE z$matches("http://foobar.com:443/") # TRUE # user info - FIXME, not sure we support this yet (z <- UriPattern$new(pattern = "http://foobar.com")) z$matches("http://user:pass@foobar.com") # regex (z <- UriPattern$new(regex_pattern = ".+ample\\\\..")) z$matches("http://sample.org") # TRUE z$matches("http://example.com") # TRUE z$matches("http://tramples.net") # FALSE # add query parameters (z <- UriPattern$new(pattern = "http://foobar.com")) z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) z z$pattern z$matches("http://foobar.com?pizza=cheese&cheese=cheddar") # TRUE z$matches("http://foobar.com?pizza=cheese&cheese=swiss") # FALSE # query parameters in the uri (z <- UriPattern$new(pattern = "https://httpbin.org/get?stuff=things")) z$add_query_params() # have to run this method to gather query params z$matches("https://httpbin.org/get?stuff=things") # TRUE z$matches("https://httpbin.org/get?stuff2=things") # FALSE # regex add query parameters (z <- UriPattern$new(regex_pattern = "https://foobar.com/.+/order")) z$add_query_params(list(pizza = "cheese")) z z$pattern z$matches("https://foobar.com/pizzas/order?pizza=cheese") # TRUE z$matches("https://foobar.com/pizzas?pizza=cheese") # FALSE # query parameters in the regex uri (z <- UriPattern$new(regex_pattern = "https://x.com/.+/order?fruit=apple")) z$add_query_params() # have to run this method to gather query params z$matches("https://x.com/a/order?fruit=apple") # TRUE z$matches("https://x.com/a?fruit=apple") # FALSE # any pattern (z <- UriPattern$new(regex_pattern = "stuff\\\\.com.+")) z$regex z$pattern z$matches("http://stuff.com") # FALSE z$matches("https://stuff.com/stff") # TRUE z$matches("https://stuff.com/apple?bears=brown&bats=grey") # TRUE } \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} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{UriPattern$new()}} \item \href{#method-matches}{\code{UriPattern$matches()}} \item \href{#method-pattern_matches}{\code{UriPattern$pattern_matches()}} \item \href{#method-query_params_matches}{\code{UriPattern$query_params_matches()}} \item \href{#method-extract_query}{\code{UriPattern$extract_query()}} \item \href{#method-add_query_params}{\code{UriPattern$add_query_params()}} \item \href{#method-to_s}{\code{UriPattern$to_s()}} \item \href{#method-clone}{\code{UriPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-matches}{}}} \subsection{Method \code{matches()}}{ Match a list of headers against that stored \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-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-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-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-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-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-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/build_httr_response.Rd0000644000176200001440000000053013415716025017205 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{build_httr_response} \alias{build_httr_response} \title{Build a httr response} \usage{ build_httr_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ a httr response } \description{ Build a httr response } webmockr/man/webmockr_enable-defunct.Rd0000644000176200001440000000040513242424030017663 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/stub_registry.Rd0000644000176200001440000000165413665341057016052 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/wi_th.Rd0000644000176200001440000000641313750075253014252 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{crul::upload} or \code{httr::upload_file}, they both create the same object in the end) \item headers: (list) a named list \item basic_auth: (character) a length two vector, username and password. authentication type (basic/digest/ntlm/etc.) is ignored. that is, mocking authenciation right now does not take into account the authentication type. 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) } 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")) } webmockr/man/mocking-disk-writing.Rd0000644000176200001440000000404613665341057017203 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/mocking-disk-writing.R \name{mocking-disk-writing} \alias{mocking-disk-writing} \title{Mocking writing to disk} \description{ Mocking writing to disk } \examples{ \dontrun{ # enable mocking enable() # Write to a file before mocked request # crul library(crul) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) readLines(f) ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = file(f)) ## make a request (out <- HttpClient$new("https://httpbin.org/get")$get(disk = f)) out$content readLines(out$content) # httr library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) readLines(f) ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = file(f), headers = list('content-type' = "application/json")) ## make a request ## with httr, you must set overwrite=TRUE or you'll get an errror out <- GET("https://httpbin.org/get", write_disk(f, overwrite=TRUE)) out out$content content(out, "text", encoding = "UTF-8") # Use mock_file to have webmockr handle file and contents # crul library(crul) f <- tempfile(fileext = ".json") ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = mock_file(f, "{\"hello\":\"mars\"}\n")) ## make a request (out <- crul::HttpClient$new("https://httpbin.org/get")$get(disk = f)) out$content readLines(out$content) # httr library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", "https://httpbin.org/get") \%>\% to_return( body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), headers = list('content-type' = "application/json") ) ## make a request out <- GET("https://httpbin.org/get", write_disk(f)) out ## view stubbed file content out$content readLines(out$content) content(out, "text", encoding = "UTF-8") # disable mocking disable() } } webmockr/man/Adapter.Rd0000644000176200001440000002146314022530740014510 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R, R/adapter-httr.R, R/adapter.R \name{CrulAdapter} \alias{CrulAdapter} \alias{HttrAdapter} \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} } } \details{ Note that the documented fields and methods are the same across all client-specific adapters. } \examples{ \dontrun{ if (requireNamespace("httr", quietly = TRUE)) { # library(httr) # normal httr request, works fine # real <- GET("https://httpbin.org/get") # real # with webmockr # library(webmockr) ## turn on httr mocking # httr_mock() ## now this request isn't allowed # GET("https://httpbin.org/get") ## stub the request # stub_request('get', uri = 'https://httpbin.org/get') \%>\% # wi_th( # headers = list('Accept' = 'application/json, text/xml, application/xml, */*') # ) \%>\% # to_return(status = 418, body = "I'm a teapot!", headers = list(a = 5)) ## now the request succeeds and returns a mocked response # (res <- GET("https://httpbin.org/get")) # res$status_code # rawToChar(res$content) # allow real requests while webmockr is loaded # webmockr_allow_net_connect() # webmockr_net_connect_allowed() # GET("https://httpbin.org/get?animal=chicken") # webmockr_disable_net_connect() # webmockr_net_connect_allowed() # GET("https://httpbin.org/get?animal=chicken") # httr_mock(FALSE) } } } \section{Super class}{ \code{\link[webmockr:Adapter]{webmockr::Adapter}} -> \code{CrulAdapter} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-clone}{\code{CrulAdapter$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ \item \out{}\href{../../webmockr/html/Adapter.html#method-disable}{\code{webmockr::Adapter$disable()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-enable}{\code{webmockr::Adapter$enable()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-handle_request}{\code{webmockr::Adapter$handle_request()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-initialize}{\code{webmockr::Adapter$initialize()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-remove_stubs}{\code{webmockr::Adapter$remove_stubs()}}\out{} } \out{
} } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-clone}{\code{HttrAdapter$clone()}} } } \if{html}{ \out{
Inherited methods} \itemize{ \item \out{}\href{../../webmockr/html/Adapter.html#method-disable}{\code{webmockr::Adapter$disable()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-enable}{\code{webmockr::Adapter$enable()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-handle_request}{\code{webmockr::Adapter$handle_request()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-initialize}{\code{webmockr::Adapter$initialize()}}\out{} \item \out{}\href{../../webmockr/html/Adapter.html#method-remove_stubs}{\code{webmockr::Adapter$remove_stubs()}}\out{} } \out{
} } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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{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-new}{\code{Adapter$new()}} \item \href{#method-enable}{\code{Adapter$enable()}} \item \href{#method-disable}{\code{Adapter$disable()}} \item \href{#method-handle_request}{\code{Adapter$handle_request()}} \item \href{#method-remove_stubs}{\code{Adapter$remove_stubs()}} \item \href{#method-clone}{\code{Adapter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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-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-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.Rd0000644000176200001440000000036613665341057016752 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/wi_th_-defunct.Rd0000644000176200001440000000035213665341057016036 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.Rd0000644000176200001440000000151413665341057016342 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr.R \docType{package} \name{webmockr-package} \alias{webmockr-package} \alias{webmockr} \title{webmockr} \description{ Stubbing and setting expectations on HTTP requests } \section{Features}{ \itemize{ \item Stubbing HTTP requests at low http client lib level \item Setting and verifying expectations on HTTP requests \item Matching requests based on method, URI, headers and body \item Supports multiple HTTP libraries, including \pkg{crul} and \pkg{httr} \item Integration with HTTP test caching library \pkg{vcr} } } \examples{ library(webmockr) stub_request("get", "https://httpbin.org/get") stub_request("post", "https://httpbin.org/post") stub_registry() } \author{ Scott Chamberlain \email{myrmecocystus+r@gmail.com} Aaron Wolen } \keyword{package} webmockr/man/to_return.Rd0000644000176200001440000001013514022732411015142 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 reqeust 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 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/httr_mock.Rd0000644000176200001440000000103613665341057015131 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 httr mocking Sets a callback that routes httr request through webmockr} \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{ Turn on httr mocking Sets a callback that routes httr request through webmockr } webmockr/man/webmockr_disable-defunct.Rd0000644000176200001440000000041013242424030020034 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/Response.Rd0000644000176200001440000002253313665341057014742 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Response.R \name{Response} \alias{Response} \title{Response} \description{ custom webmockr http response class } \examples{ \dontrun{ (x <- Response$new()) x$set_url("https://httpbin.org/get") x x$set_request_headers(list('Content-Type' = "application/json")) x x$request_headers x$set_response_headers(list('Host' = "httpbin.org")) x x$response_headers x$set_status(404) x x$get_status() x$set_body("hello world") x x$get_body() # raw body x$set_body(charToRaw("hello world")) x x$get_body() x$set_exception("exception") x x$get_exception() } } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{url}}{(character) a url} \item{\code{body}}{(various) list, character, etc} \item{\code{content}}{(various) response content/body} \item{\code{request_headers}}{(list) a named list} \item{\code{response_headers}}{(list) a named list} \item{\code{options}}{(character) list} \item{\code{status_code}}{(integer) an http status code} \item{\code{exception}}{(character) an exception message} \item{\code{should_timeout}}{(logical) should the response timeout?} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{Response$new()}} \item \href{#method-print}{\code{Response$print()}} \item \href{#method-set_url}{\code{Response$set_url()}} \item \href{#method-get_url}{\code{Response$get_url()}} \item \href{#method-set_request_headers}{\code{Response$set_request_headers()}} \item \href{#method-get_request_headers}{\code{Response$get_request_headers()}} \item \href{#method-set_response_headers}{\code{Response$set_response_headers()}} \item \href{#method-get_respone_headers}{\code{Response$get_respone_headers()}} \item \href{#method-set_body}{\code{Response$set_body()}} \item \href{#method-get_body}{\code{Response$get_body()}} \item \href{#method-set_status}{\code{Response$set_status()}} \item \href{#method-get_status}{\code{Response$get_status()}} \item \href{#method-set_exception}{\code{Response$set_exception()}} \item \href{#method-get_exception}{\code{Response$get_exception()}} \item \href{#method-clone}{\code{Response$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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-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-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-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-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-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-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-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-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-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-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-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/build_crul_request.Rd0000644000176200001440000000050713145357177017040 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \name{build_crul_request} \alias{build_crul_request} \title{Build a crul request} \usage{ build_crul_request(x) } \arguments{ \item{x}{an unexecuted crul request object} } \value{ a crul request } \description{ Build a crul request } webmockr/man/request_registry.Rd0000644000176200001440000000261213665341057016560 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/webmockr-defunct.Rd0000644000176200001440000000112113665341057016371 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/stub_registry_clear.Rd0000644000176200001440000000110013665341057017202 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/pipe.Rd0000644000176200001440000000031713107235041014057 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/mock_file.Rd0000644000176200001440000000075213665341057015073 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/RequestRegistry.Rd0000644000176200001440000001133513665341057016323 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \name{RequestRegistry} \alias{RequestRegistry} \title{RequestRegistry} \description{ keeps track of HTTP requests } \examples{ x <- RequestRegistry$new() z1 <- RequestSignature$new("get", "http://scottchamberlain.info") z2 <- RequestSignature$new("post", "https://httpbin.org/post") x$register_request(request = z1) x$register_request(request = z1) x$register_request(request = z2) # print method to list requests x # more complex requests w <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) w$to_s() x$register_request(request = w) x # hashes, and number of times each requested x$request_signatures$hash # times_executed method pat <- RequestPattern$new( method = "get", uri = "https:/httpbin.org/get", headers = list(`User-Agent` = "foobar", stuff = "things") ) pat$to_s() x$times_executed(pat) z <- RequestPattern$new(method = "get", uri = "http://scottchamberlain.info") x$times_executed(z) w <- RequestPattern$new(method = "post", uri = "https://httpbin.org/post") x$times_executed(w) ## pattern with no matches - returns 0 (zero) pat <- RequestPattern$new( method = "get", uri = "http://recology.info/" ) pat$to_s() x$times_executed(pat) # reset the request registry x$reset() } \seealso{ \code{\link[=stub_registry]{stub_registry()}} and \link{StubRegistry} Other request-registry: \code{\link{HashCounter}}, \code{\link{request_registry}()} } \concept{request-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{request_signatures}}{a HashCounter object} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-print}{\code{RequestRegistry$print()}} \item \href{#method-reset}{\code{RequestRegistry$reset()}} \item \href{#method-register_request}{\code{RequestRegistry$register_request()}} \item \href{#method-times_executed}{\code{RequestRegistry$times_executed()}} \item \href{#method-clone}{\code{RequestRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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; ressets registry to no requests } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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/webmockr_configure.Rd0000644000176200001440000000431713665341057017016 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, net_http_connect_on_start = FALSE, show_stubbing_instructions = FALSE, query_values_notation = FALSE, 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{net_http_connect_on_start}{(logical) Default: \code{FALSE}. ignored for now} \item{show_stubbing_instructions}{(logical) Default: \code{FALSE}. ignored for now} \item{query_values_notation}{(logical) Default: \code{FALSE}. ignored for now} \item{show_body_diff}{(logical) Default: \code{FALSE}. ignored for now} \item{uri}{(character) a URI/URL as a character string - to determine whether or not it is allowed} } \description{ webmockr configuration } \section{webmockr_allow_net_connect}{ If there are stubs found for a request, even if net connections are allowed (by running \code{webmockr_allow_net_connect()}) the stubbed response will be returned. If no stub is found, and net connections are allowed, then a real HTTP request can be made. } \examples{ \dontrun{ webmockr_configure() webmockr_configure( allow_localhost = TRUE ) webmockr_configuration() webmockr_configure_reset() webmockr_allow_net_connect() webmockr_net_connect_allowed() # disable net connect for any URIs webmockr_disable_net_connect() ### gives NULL with no URI passed webmockr_net_connect_allowed() # disable net connect EXCEPT FOR given URIs webmockr_disable_net_connect(allow = "google.com") ### is a specific URI allowed? webmockr_net_connect_allowed("google.com") } } webmockr/man/BodyPattern.Rd0000644000176200001440000000664513665341057015405 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{BodyPattern} \alias{BodyPattern} \title{BodyPattern} \description{ body matcher } \examples{ # make a request signature bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( body = list(foo = "bar", a = 5) ) ) # make body pattern object ## FALSE z <- BodyPattern$new(pattern = list(foo = "bar")) z$pattern z$matches(bb$body) ## TRUE z <- BodyPattern$new(pattern = list(foo = "bar", a = 5)) z$pattern z$matches(bb$body) # uploads in bodies ## upload NOT in a list bb <- RequestSignature$new( method = "post", uri = "https:/httpbin.org/post", options = list(body = crul::upload(system.file("CITATION")))) bb$body z <- BodyPattern$new(pattern = crul::upload(system.file("CITATION"))) z$pattern z$matches(bb$body) ## upload in a list bb <- RequestSignature$new( method = "post", uri = "https:/httpbin.org/post", options = list(body = list(y = crul::upload(system.file("CITATION"))))) bb$body z <- BodyPattern$new(pattern = list(y = crul::upload(system.file("CITATION")))) z$pattern z$matches(bb$body) } \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-new}{\code{BodyPattern$new()}} \item \href{#method-matches}{\code{BodyPattern$matches()}} \item \href{#method-to_s}{\code{BodyPattern$to_s()}} \item \href{#method-clone}{\code{BodyPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{BodyPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-matches}{}}} \subsection{Method \code{matches()}}{ Match a list of headers against that stored \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} \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-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-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/webmockr_crul_fetch.Rd0000644000176200001440000000050113270161742017133 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/StubRegistry.Rd0000644000176200001440000001357213665341057015615 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubRegistry.R \name{StubRegistry} \alias{StubRegistry} \title{StubRegistry} \description{ stub registry to keep track of \link{StubbedRequest} stubs } \examples{ \dontrun{ # Make a stub stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") stub1$with(headers = list('User-Agent' = 'R')) stub1$to_return(status = 200, body = "foobar", headers = list()) stub1 # Make another stub stub2 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") stub2 # Put both stubs in the stub registry reg <- StubRegistry$new() reg$register_stub(stub = stub1) reg$register_stub(stub = stub2) reg reg$request_stubs } } \seealso{ Other stub-registry: \code{\link{remove_request_stub}()}, \code{\link{stub_registry_clear}()}, \code{\link{stub_registry}()} } \concept{stub-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{request_stubs}}{(list) list of request stubs} \item{\code{global_stubs}}{(list) list of global stubs} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-print}{\code{StubRegistry$print()}} \item \href{#method-register_stub}{\code{StubRegistry$register_stub()}} \item \href{#method-find_stubbed_request}{\code{StubRegistry$find_stubbed_request()}} \item \href{#method-request_stub_for}{\code{StubRegistry$request_stub_for()}} \item \href{#method-remove_request_stub}{\code{StubRegistry$remove_request_stub()}} \item \href{#method-remove_all_request_stubs}{\code{StubRegistry$remove_all_request_stubs()}} \item \href{#method-is_registered}{\code{StubRegistry$is_registered()}} \item \href{#method-clone}{\code{StubRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_signature}}{an object of class \link{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ logical, 1 or more } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-is_registered}{}}} \subsection{Method \code{is_registered()}}{ Find a stubbed request \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-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/webmockr_reset.Rd0000644000176200001440000000121113665341057016145 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/man/HttpLibAdapaterRegistry.Rd0000644000176200001440000000437413665341057017710 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/HttpLibAdapterRegistry.R \name{HttpLibAdapaterRegistry} \alias{HttpLibAdapaterRegistry} \title{HttpLibAdapaterRegistry} \description{ http lib adapter registry } \examples{ x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) x x$adapters x$adapters[[1]]$name } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{adapters}}{list} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-print}{\code{HttpLibAdapaterRegistry$print()}} \item \href{#method-register}{\code{HttpLibAdapaterRegistry$register()}} \item \href{#method-clone}{\code{HttpLibAdapaterRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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/StubbedRequest.Rd0000644000176200001440000001750713734501340016100 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubbedRequest.R \name{StubbedRequest} \alias{StubbedRequest} \title{StubbedRequest} \description{ stubbed request class underlying \code{\link[=stub_request]{stub_request()}} } \examples{ \dontrun{ x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$method x$uri x$with(headers = list('User-Agent' = 'R', apple = "good")) x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x x$to_s() # many to_return's x <- StubbedRequest$new(method = "get", uri = "httpbin.org") x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x$to_return(status = 200, body = "bears", headers = list(b = 6)) x x$to_s() # raw body x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$to_return(status = 200, body = raw(0), headers = list(a = 5)) x$to_s() x x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$to_return(status = 200, body = charToRaw("foo bar"), headers = list(a = 5)) x$to_s() x # basic auth x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") x$with(basic_auth = c("foo", "bar")) x$to_s() x # file path x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") f <- tempfile() x$to_return(status = 200, body = file(f), headers = list(a = 5)) x x$to_s() unlink(f) # to_file(): file path and payload to go into the file # payload written to file during mocked response creation x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") f <- tempfile() x$to_return(status = 200, body = mock_file(f, "{\"foo\": \"bar\"}"), headers = list(a = 5)) x x$to_s() unlink(f) # uri_regex (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$method x$uri_regex x$to_s() # to timeout (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$to_s() x$to_timeout() x$to_s() x # to raise library(fauxpas) (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) x$to_s() x$to_raise(HTTPBadGateway) x$to_s() x } } \seealso{ \code{\link[=stub_request]{stub_request()}} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(xx) xx} \item{\code{uri}}{(xx) xx} \item{\code{uri_regex}}{(xx) xx} \item{\code{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} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{StubbedRequest$new()}} \item \href{#method-print}{\code{StubbedRequest$print()}} \item \href{#method-with}{\code{StubbedRequest$with()}} \item \href{#method-to_return}{\code{StubbedRequest$to_return()}} \item \href{#method-to_timeout}{\code{StubbedRequest$to_timeout()}} \item \href{#method-to_raise}{\code{StubbedRequest$to_raise()}} \item \href{#method-to_s}{\code{StubbedRequest$to_s()}} \item \href{#method-clone}{\code{StubbedRequest$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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 connetion 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-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-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-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-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/MethodPattern.Rd0000644000176200001440000000551213665341057015720 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{MethodPattern} \alias{MethodPattern} \title{MethodPattern} \description{ method matcher } \details{ Matches regardless of case. e.g., POST will match to post } \examples{ (x <- MethodPattern$new(pattern = "post")) x$pattern x$matches(method = "post") x$matches(method = "POST") # all matches() calls should be TRUE (x <- MethodPattern$new(pattern = "any")) x$pattern x$matches(method = "post") x$matches(method = "GET") x$matches(method = "HEAD") } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) an http method} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{MethodPattern$new()}} \item \href{#method-matches}{\code{MethodPattern$matches()}} \item \href{#method-to_s}{\code{MethodPattern$to_s()}} \item \href{#method-clone}{\code{MethodPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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/HeadersPattern.Rd0000644000176200001440000001011613665341057016047 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{HeadersPattern} \alias{HeadersPattern} \title{HeadersPattern} \description{ headers matcher } \details{ \code{webmockr} normalises headers and treats all forms of same headers as equal: i.e the following two sets of headers are equal: \code{list(Header1 = "value1", content_length = 123, X_CuStOm_hEAder = "foo")} and \code{list(header1 = "value1", "Content-Length" = 123, "x-cuSTOM-HeAder" = "foo")} } \examples{ (x <- HeadersPattern$new(pattern = list(a = 5))) x$pattern x$matches(list(a = 5)) # different cases (x <- HeadersPattern$new(pattern = list(Header1 = "value1"))) x$pattern x$matches(list(header1 = "value1")) x$matches(list(header1 = "value2")) # different symbols (x <- HeadersPattern$new(pattern = list(`Hello_World` = "yep"))) x$pattern x$matches(list(`hello-world` = "yep")) x$matches(list(`hello-worlds` = "yep")) headers <- list( 'User-Agent' = 'Apple', 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*') (x <- HeadersPattern$new(pattern = headers)) x$to_s() x$pattern x$matches(headers) } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{a list} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{HeadersPattern$new()}} \item \href{#method-matches}{\code{HeadersPattern$matches()}} \item \href{#method-empty_headers}{\code{HeadersPattern$empty_headers()}} \item \href{#method-to_s}{\code{HeadersPattern$to_s()}} \item \href{#method-clone}{\code{HeadersPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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-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/RequestSignature.Rd0000644000176200001440000000771613761476642016472 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestSignature.R \name{RequestSignature} \alias{RequestSignature} \title{RequestSignature} \description{ General purpose request signature builder } \examples{ # make request signature x <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") # method x$method # uri x$uri # request signature to string x$to_s() # headers w <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) w w$headers w$to_s() # headers and body bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( headers = list(`User-Agent` = "foobar", stuff = "things"), body = list(a = "tables") ) ) bb bb$headers bb$body bb$to_s() # with disk path f <- tempfile() bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(disk = f) ) bb bb$disk bb$to_s() } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(character) an http method} \item{\code{uri}}{(character) a uri} \item{\code{body}}{(various) request body} \item{\code{headers}}{(list) named list of headers} \item{\code{proxies}}{(list) proxies as a named list} \item{\code{auth}}{(list) authentication details, as a named list} \item{\code{url}}{internal use} \item{\code{disk}}{(character) if writing to disk, the path} \item{\code{fields}}{(various) request body details} \item{\code{output}}{(various) request output details, disk, memory, etc} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-new}{\code{RequestSignature$new()}} \item \href{#method-print}{\code{RequestSignature$print()}} \item \href{#method-to_s}{\code{RequestSignature$to_s()}} \item \href{#method-clone}{\code{RequestSignature$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-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-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-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-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/remove_request_stub.Rd0000644000176200001440000000124713665341057017245 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_clear}()}, \code{\link{stub_registry}()} } \concept{stub-registry} webmockr/DESCRIPTION0000644000176200001440000000342214023430252013565 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: 0.8.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 = "https://ropensci.org") ) License: MIT + file LICENSE URL: https://github.com/ropensci/webmockr (devel) https://books.ropensci.org/http-testing/ (user manual) https://docs.ropensci.org/webmockr/ (documentation) BugReports: https://github.com/ropensci/webmockr/issues LazyData: true Encoding: UTF-8 Language: en-US Imports: curl, jsonlite, magrittr (>= 1.5), R6 (>= 2.1.3), urltools (>= 1.6.0), fauxpas, crul (>= 0.7.0), base64enc Suggests: testthat, xml2, vcr, httr RoxygenNote: 7.1.1 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: 2021-03-13 20:27:13 UTC; sckott Author: Scott Chamberlain [aut, cre] (), Aaron Wolen [ctb] (), rOpenSci [fnd] (https://ropensci.org) Maintainer: Scott Chamberlain Repository: CRAN Date/Publication: 2021-03-14 15:50:02 UTC webmockr/tests/0000755000176200001440000000000014023220041013211 5ustar liggesuserswebmockr/tests/test-all.R0000644000176200001440000000005313077016675015107 0ustar liggesuserslibrary("testthat") test_check("webmockr") webmockr/tests/testthat/0000755000176200001440000000000014023220041015051 5ustar liggesuserswebmockr/tests/testthat/test-StubbedRequest.R0000644000176200001440000001400513733453474021143 0ustar liggesuserscontext("StubbedRequest") test_that("StubbedRequest: works", { expect_is(StubbedRequest, "R6ClassGenerator") aa <- StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get") expect_is(aa, "StubbedRequest") expect_null(aa$host) expect_null(aa$query) expect_null(aa$body) expect_null(aa$request_headers) expect_null(aa$response_headers) expect_null(aa$response) expect_null(aa$response_sequences) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https:/httpbin.org/get") expect_is(aa$uri_parts, "list") expect_equal(aa$uri_parts$domain, "https") expect_equal(aa$uri_parts$path, "httpbin.org/get") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "GET: https:/httpbin.org/get") # with expect_is(aa$with, "function") expect_null(aa$query) aa$with(query = list(foo = "bar")) expect_is(aa$query, "list") expect_named(aa$query, "foo") expect_equal(aa$to_s(), "GET: https:/httpbin.org/get?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:/httpbin.org/get?foo=bar&stuff=567") # to_return expect_is(aa$to_return, "function") expect_null(aa$body) aa$to_return( status = 404, body = list(hello = "world"), headers = list(a = 5) ) expect_is(aa$responses_sequences, "list") expect_is(aa$responses_sequences[[1]]$body, "list") expect_named(aa$responses_sequences[[1]]$body, "hello") }) test_that("StubbedRequest: to_timeout", { x <- StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get") expect_false(grepl("should_timeout: TRUE", x$to_s())) x$to_timeout() expect_true(grepl("should_timeout: TRUE", x$to_s())) }) library("fauxpas") test_that("StubbedRequest: to_raise", { x <- StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get") expect_false(grepl("to_raise: HTTPBadGateway", x$to_s())) x$to_raise(HTTPBadGateway) expect_true(grepl("to_raise: HTTPBadGateway", x$to_s())) ## many exceptions x$to_raise(list(HTTPBadGateway, HTTPForbidden, HTTPInsufficientStorage)) expect_true( grepl("to_raise: HTTPBadGateway, HTTPForbidden, HTTPInsufficientStorage", x$to_s())) }) test_that("StubbedRequest: different methods work", { expect_equal( StubbedRequest$new(method = "any", uri = "https:/httpbin.org/get")$method, "any" ) expect_equal( StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get")$method, "get" ) expect_equal( StubbedRequest$new(method = "head", uri = "https:/httpbin.org/get")$method, "head" ) expect_equal( StubbedRequest$new(method = "post", uri = "https:/httpbin.org/get")$method, "post" ) expect_equal( StubbedRequest$new(method = "put", uri = "https:/httpbin.org/get")$method, "put" ) expect_equal( StubbedRequest$new(method = "patch", uri = "https:/httpbin.org/get")$method, "patch" ) expect_equal( StubbedRequest$new(method = "delete", uri = "https:/httpbin.org/get")$method, "delete" ) }) test_that("StubbedRequest fails well", { # requires uri or uri_regex expect_error(StubbedRequest$new(), "one of uri or uri_regex is required") # method not in acceptable set expect_error(StubbedRequest$new(method = "adf"), "'arg' should be one of") }) 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 = "httpbin.org") x$to_return(status = 200, body = "foobar", headers = list(a = 5)) x$to_return(status = 200, body = "bears", headers = list(b = 6)) x$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-uri_regex.R0000644000176200001440000000473014022757771020176 0ustar liggesuserscontext("uri_regex") test_that("uri_regex with crul", { stub_request("get", uri_regex = "httpbin.org/.+") %>% to_return(body = list(foo = "bar")) library(crul) enable(adapter = "crul") invisible( lapply(c('elephants', 'bears', 'leaves', 'foo', 'bar'), function(z) { expect_true(HttpClient$new("https://httpbin.org")$get(z)$success()) }) ) # more complicated regex stub_request("get", uri_regex = "[Aa].+\\.io/apple/") invisible( lapply(c('Anounce', 'apple', 'Afar', 'after'), function(z) { expect_true(HttpClient$new(sprintf("https://%s.io", z))$get("apple")$success()) expect_error(HttpClient$new(sprintf("https://%s.io", z))$get("fruit"), "Real HTTP connections are disabled") }) ) # regex to match any URL ## https://github.com/ropensci/webmockr/issues/113 ## when matching any url with `.+`, it would lead to an empty url in response ## object, at least with crul stub_request("get", uri_regex = ".+") invisible( lapply(c('Anounce', 'apple', 'Afar', 'after'), function(z) { url <- sprintf("https://%s.io", z) res <- HttpClient$new(url)$get(z) expect_is(res, "HttpResponse") expect_true(grepl(res$url, file.path(url, z), ignore.case = TRUE)) }) ) }) stub_registry_clear() test_that("uri_regex with httr", { stub_request("get", uri_regex = "httpbin.org/.+") %>% to_return(body = list(foo = "bar")) library(httr) enable(adapter = "httr") invisible( lapply(c('elephants', 'bears', 'leaves', 'foo', 'bar'), function(z) { expect_false(http_error(GET(file.path("https://httpbin.org", z)))) }) ) # more complicated regex stub_request("get", uri_regex = "[Aa].+\\.io/apple/") invisible( lapply(c('Anounce', 'apple', 'Afar', 'after'), function(z) { expect_false(http_error(GET(sprintf("https://%s.io/apple", z)))) expect_error(GET(sprintf("https://%s.io/fruit", z)), "Real HTTP connections are disabled") }) ) # regex to match any URL ## https://github.com/ropensci/webmockr/issues/113 ## when matching any url with `.+`, it would lead to an empty url in response ## object, at least with crul stub_request("get", uri_regex = ".+") invisible( lapply(c('Anounce', 'apple', 'Afar', 'after'), function(z) { url <- sprintf("https://%s.io", z) res <- GET(url, path = z) expect_is(res, "response") expect_true(grepl(res$url, file.path(url, z), ignore.case = TRUE)) }) ) }) stub_registry_clear() webmockr/tests/testthat/test-to_return.R0000644000176200001440000001120513665341057020217 0ustar liggesuserscontext("to_return: works as expected") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) aa <- stub_request("get", "https://httpbin.org/get") %>% to_return(status = 200, body = "stuff", headers = list(a = 5)) test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https://httpbin.org/get") # to_return expected stuff expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "a") expect_equal(aa$response_headers$a, 5) expect_is(aa$responses_sequences, "list") expect_identical( sort(names(aa$responses_sequences[[1]])), sort(c("status", "body", "headers", "body_raw", "timeout", "raise", "exceptions")) ) expect_equal(aa$responses_sequences[[1]]$status, 200) expect_equal(aa$responses_sequences[[1]]$body, "stuff") }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(to_return(), "argument \".data\" is missing") expect_error(to_return(5), ".data must be of class StubbedRequest") zzz <- stub_request("get", "https://httpbin.org/get") # status expect_error(to_return(zzz, status = "foo"), "must be of class numeric") # headers expect_error(to_return(zzz, headers = list(5, 6)), "'headers' must be a named list") expect_error(to_return(zzz, headers = list(a = 5, 6)), "'headers' must be a named list") expect_error(to_return(zzz, .list = 4), ".list must be of class list") }) stub_registry_clear() enable() context("to_return: response headers returned all lowercase") test_that("to_return (response) headers are all lowercase, crul", { stub <- stub_request(uri = "http://httpbin.org/get") %>% to_return(headers = list("Foo-Bar" = "baz")) cli <- crul::HttpClient$new(url = "http://httpbin.org/") x <- cli$get("get") expect_is(x$response_headers, "list") expect_named(x$response_headers, "foo-bar") }) stub_registry_clear() test_that("to_return (response) headers are all lowercase, httr", { loadNamespace("httr") stub <- stub_request(uri = "http://httpbin.org/get") %>% to_return(headers = list("Foo-Bar" = "baz")) x <- httr::GET("http://httpbin.org/get") expect_is(x$headers, "list") expect_named(x$headers, "foo-bar") }) disable() stub_registry_clear() enable() context("to_return: response header values are all character") test_that("to_return response header values are all character, crul", { cli <- crul::HttpClient$new(url = "http://httpbin.org/") stub_request(uri = "http://httpbin.org/get") %>% to_return(headers = list("Foo-Bar" = 10)) x <- cli$get("get") expect_is(x$response_headers, "list") expect_named(x$response_headers, "foo-bar") expect_is(x$response_headers$`foo-bar`, "character") expect_equal(x$response_headers$`foo-bar`, "10") stub_registry_clear() stub_request(uri = "http://httpbin.org/get") %>% to_return(headers = list( a = 10, b = 234233434, c = 2344.342342, d = "brown", e = as.factor("blue") )) z <- cli$get("get") expect_is(z$response_headers, "list") expect_named(z$response_headers, letters[1:5]) invisible( vapply(z$response_headers, function(z) expect_is(z, "character"), "") ) expect_equal(z$response_headers$c, "2344.342342") expect_equal(z$response_headers$e, "blue") }) stub_registry_clear() test_that("to_return response header values are all character, httr", { loadNamespace("httr") stub_request(uri = "http://httpbin.org/get") %>% to_return(headers = list("Foo-Bar" = 10)) x <- httr::GET("http://httpbin.org/get") expect_is(x$headers, "list") expect_named(x$headers, "foo-bar") expect_is(x$headers$`foo-bar`, "character") expect_equal(x$headers$`foo-bar`, "10") stub_registry_clear() stub_request(uri = "http://httpbin.org/get") %>% to_return(headers = list( a = 10, b = 234233434, c = 2344.342342, d = "brown", e = as.factor("blue") )) z <- httr::GET("http://httpbin.org/get") expect_is(z$headers, "list") expect_named(z$headers, letters[1:5]) invisible( vapply(z$headers, function(z) expect_is(z, "character"), "") ) expect_equal(z$headers$c, "2344.342342") expect_equal(z$headers$e, "blue") }) disable() context("to_return_: defunct") test_that("to_return_: defunct", { expect_error(to_return_(), "to_return", class = "error") }) webmockr/tests/testthat/httr_obj_auth.rda0000644000176200001440000000055713665341057020432 0ustar liggesusers‹]Q]OÂ0-Û`²(1ñìÁø@`‚1áŘh|7>ð¶tãÅmýø¯ýj»­dnÉ]{OϽ=÷ôíy½ÖBÈAî ‡Wo=GÿzÈCC½^í¥ä1K1Qr{£A_Çu‹ä¾¾¼w ;]WŠÆfMh1¾Ã 4šFx˘N¹¾¸]5#e™Ñ”HÊ |¬˜„NŸòl¶Ï*`ŒÇµý‚ä :ROi ¥Ô»Ÿ:3ƒ×aÝf4IÏðCt¿Œf!ŸVÙ2Z„Æ<–Ñ\óF¦æñÙ¯ÝÃ×S­ª©PPÁU…ÎoCõêP àd…l€ cTåqÓËÊãÆ¦æx­)ª—è>W?͈°8 xyäTBœCÎøWƒjl«ŠÔZ·ü§Ô·öå ÷Ìêpµ)gI@6À…åm)d›ù¬4}m˜ÉbÉ> °t¦d©d}©k/=;ÉáS8û€_€@©webmockr/tests/testthat/test-zutils.R0000644000176200001440000001401513665341060017524 0ustar liggesuserscontext("util fxns: normalize_uri") test_that("normalize_uri", { # prunes trailing slash expect_is(normalize_uri("example.com/"), "character") expect_match(normalize_uri("example.com/"), "example.com") # prunes ports 80 and 443 expect_match(normalize_uri("example.com:80"), "example.com") expect_match(normalize_uri("example.com:443"), "example.com") # escapes special characters expect_match(normalize_uri("example.com/foo/bar"), "example.com/foo%2Fbar") expect_match(normalize_uri("example.com/foo+bar"), "example.com/foo%2Bbar") expect_match(normalize_uri("example.com/foo*bar"), "example.com/foo%2Abar") }) context("util fxns: net_connect_explicit_allowed") test_that("net_connect_explicit_allowed", { aa <- net_connect_explicit_allowed( allowed = "example.com", uri = "http://example.com") expect_is(aa, "logical") expect_equal(length(aa), 1) # works with lists expect_true( net_connect_explicit_allowed( list("example.com", "foobar.org"), "example.com" ) ) expect_false( net_connect_explicit_allowed( list("example.com", "foobar.org"), "stuff.io" ) ) # no uri passed, returns FALSE expect_false(net_connect_explicit_allowed("google.com")) # empty character string uri passed, returns FALSE expect_false(net_connect_explicit_allowed("google.com", "")) # no allowed passed, errors expect_error(net_connect_explicit_allowed(), "argument \"allowed\" is missing") }) context("util fxns: webmockr_net_connect_allowed") test_that("webmockr_net_connect_allowed", { # works with character strings expect_false(webmockr_net_connect_allowed("example.com")) expect_false(webmockr_net_connect_allowed("http://example.com")) expect_false(webmockr_net_connect_allowed("https://example.com")) # no uri passed, returns FALSE expect_false(webmockr_net_connect_allowed()) # nonense passed, returns FALSE expect_false(webmockr_net_connect_allowed("")) expect_false(webmockr_net_connect_allowed("asdfadfafsd")) # errors when of wrong class expect_error(webmockr_net_connect_allowed(mtcars), "uri must be of class character, list") }) context("util fxns: webmockr_disable_net_connect") test_that("webmockr_disable_net_connect", { # nothing passed expect_null(sm(webmockr_disable_net_connect())) expect_message(webmockr_disable_net_connect(), "net connect disabled") # single uri passed expect_message(webmockr_disable_net_connect("google.com"), "net connect disabled") expect_is(sm(webmockr_disable_net_connect("google.com")), "character") expect_equal(sm(webmockr_disable_net_connect("google.com")), "google.com") # many uri's passed expect_message(webmockr_disable_net_connect(c("google.com", "nytimes.com")), "net connect disabled") expect_is(sm(webmockr_disable_net_connect(c("google.com", "nytimes.com"))), "character") expect_equal(sm(webmockr_disable_net_connect(c("google.com", "nytimes.com"))), c("google.com", "nytimes.com")) # errors when of wrong class expect_error(webmockr_disable_net_connect(5), "allow must be of class character") expect_error(webmockr_disable_net_connect(mtcars), "allow must be of class character") }) context("util fxns: webmockr_allow_net_connect") test_that("webmockr_allow_net_connect", { # first call, sets to TRUE, and returns message # nothing passed expect_message(z <- webmockr_allow_net_connect(), "net connect allowed") expect_true(z) # check if net collect allowed afterwards, should be TRUE expect_true(webmockr_net_connect_allowed()) # errors when an argument passed expect_error(webmockr_allow_net_connect(5), "unused argument") }) context("util fxns: webmockr_configuration") test_that("webmockr_configuration", { expect_is(webmockr_configuration(), "webmockr_config") expect_named( webmockr_configuration(), c('show_stubbing_instructions', 'show_body_diff', 'query_values_notation', 'allow', 'net_http_connect_on_start', 'allow_net_connect', 'allow_localhost') ) # errors when an argument passed expect_error(webmockr_configuration(5), "unused argument") }) context("util fxns: webmockr_configure_reset") test_that("webmockr_configure_reset", { # webmockr_configure_reset does the same thing as webmockr_configure expect_identical(webmockr_configure(), webmockr_configure_reset()) # errors when an argument passed expect_error(webmockr_configure_reset(5), "unused argument") }) context("util fxns: defunct") test_that("webmockr_disable", { expect_error(webmockr_disable(), "disable", class = "error") }) test_that("webmockr_enable", { expect_error(webmockr_enable(), "enable", class = "error") }) context("util fxns: hdl_lst") test_that("hdl_lst works", { expect_equal(hdl_lst(NULL), "") expect_equal(hdl_lst(character(0)), "") expect_equal(hdl_lst(raw(0)), "") expect_equal(hdl_lst(raw(5)), "raw bytes, length: 5") expect_error(hdl_lst(), "argument \"x\" is missing") expect_equal(hdl_lst(list(foo = "bar")), "foo=bar") expect_equal(hdl_lst(list(foo = "5")), "foo=5") expect_equal(hdl_lst(list(foo = "5", bar = "a")), "foo=5, bar=a") expect_equal(hdl_lst(1.5), 1.5) }) context("util fxns: hdl_lst2") test_that("hdl_lst2 works", { expect_equal(hdl_lst2(NULL), "") expect_equal(hdl_lst2(character(0)), "") expect_equal(hdl_lst2(raw(5)), "") expect_equal(hdl_lst2(charToRaw("hello")), "hello") expect_error(hdl_lst2(), "argument \"x\" is missing") expect_equal(hdl_lst2(list(foo = "bar")), "foo=\"bar\"") expect_equal(hdl_lst2(list(foo = 5)), "foo=5") expect_equal(hdl_lst2(list(foo = 5, bar = "a")), "foo=5, bar=\"a\"") expect_equal(hdl_lst2(list(foo = "bar", stuff = FALSE)), "foo=\"bar\", stuff=FALSE") expect_equal(hdl_lst2(1.5), 1.5) }) context("query_mapper") test_that("query_mapper", { expect_is(query_mapper, "function") expect_null(query_mapper(NULL)) expect_equal(query_mapper(5), 5) expect_equal(query_mapper('aaa'), 'aaa') expect_equal(query_mapper(mtcars), mtcars) }) webmockr/tests/testthat/httr_obj.rda0000644000176200001440000000050313665341057017400 0ustar liggesusers‹]Q±NÃ05NKh„RÖ LU‰ !±!ØC·ÊM®iJbû,ÊÏŽWm†³}ÏÏ÷îß_wÑ""„P )¡=¨]NÈ€Œì~¶ATK¹ÚŒmÚ¸<¸Þ^?zЕ}Rë'Æš}UˆDªœå€Vä6ãu])ÇB ¶ÕRLc„²]UNãÃ;Lؤ×ÙPð tOûô9M¡¶Rä· :væŽY×e±J*ÙcòpŸÌbuã²y2»ì6±¨åEî‹FšþuuhWgd4(žƒÀËΪ×wCëu˜–\ë^±óoU ,+¨¤úé°‹[‘6£hKµzãàFfþW¬}KÀ3PÚóÖ”™ÏBY7u}qƒ›%ÊOž. Ö[ÑÀ‹z¡‚/zo÷ÞŸsHOwebmockr/tests/testthat/test-flipswitch.R0000644000176200001440000000317113665341057020355 0ustar liggesuserscontext("flipswitch (enable/disable)") test_that("flipswitch in default state", { expect_is(webmockr_lightswitch, "environment") expect_is(webmockr_lightswitch$crul, "logical") expect_false(webmockr_lightswitch$crul) }) test_that("flipswitch - turn on with 'enable'", { aa <- enable() expect_is(aa, "logical") expect_equal(length(aa), 2) expect_true(all(aa)) expect_true(webmockr_lightswitch$crul) skip_if_not_installed("httr") expect_true(webmockr_lightswitch$httr) }) test_that("flipswitch - turn on with 'enable' - one pkg", { # disable all disable() # enable one pkg aa <- enable('crul') expect_is(aa, "logical") expect_equal(length(aa), 1) expect_true(aa) expect_true(webmockr_lightswitch$crul) skip_if_not_installed("httr") expect_false(webmockr_lightswitch$httr) }) test_that("flipswitch - turn off with 'disable'", { aa <- disable() # all are FALSE expect_true(!all(aa)) expect_false(webmockr_lightswitch$crul) skip_if_not_installed("httr") expect_false(webmockr_lightswitch$httr) }) test_that("enable and disable fail well", { expect_error(enable(wasp = 5), "unused argument") expect_error(disable(bee = 5), "unused argument") expect_error(enable(adapter = 'stuff'), "adapter must be one of") expect_error(disable(adapter = 'stuff'), "adapter must be one of") # FIXME: not sure how to test when pkg not installed # inside of test suite }) test_that("enabled works", { # disable all disable() expect_false(enabled()) expect_false(enabled('crul')) expect_false(enabled('httr')) expect_error(enabled('foobar'), "'adapter' must be in the set") }) webmockr/tests/testthat/test-remove_request_stub.R0000644000176200001440000000165413665341057022307 0ustar liggesuserscontext("remove_request_stub") # clear stubs before starting stub_registry_clear() test_that("remove_request_stub", { # no stubs at beginning expect_equal(length(stub_registry()$request_stubs), 0) # make a stub x <- stub_request("get", "https://httpbin.org/get") # no there's a stub expect_equal(length(stub_registry()$request_stubs), 1) # remove the stub w <- remove_request_stub(x) expect_is(w, "list") expect_equal(length(w), 0) # no there's no stubs expect_equal(length(stub_registry()$request_stubs), 0) }) test_that("remove_request_stub: removes the stub upon an error", { # no stubs at beginning stub_registry_clear() expect_equal(length(stub_registry()$request_stubs), 0) expect_error( stub_request("post", uri = "https://httpbin.org/post") %>% to_return(body = 5) ) expect_equal(length(stub_registry()$request_stubs), 0) stub_registry_clear() }) request_registry_clear() webmockr/tests/testthat/test-webmockr_reset.R0000644000176200001440000000170113665341060021203 0ustar liggesuserscontext("webmockr_reset") stub_registry_clear() request_registry_clear() enable() test_that("webmockr_reset works", { # before any stubs creatd expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) expect_null(webmockr_reset()) expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) # after a stub creatd stub_request("get", "https://scottchamberlain.info") crul::HttpClient$new("https://scottchamberlain.info")$get() expect_equal(length(stub_registry()$request_stubs), 1) expect_equal(length(request_registry()$request_signatures$hash), 1) webmockr_reset() expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) }) test_that("webmockr_reset fails well", { expect_error(webmockr_reset(4), "unused argument") }) disable() webmockr/tests/testthat/httr_body_upload_list.rda0000644000176200001440000000065713665341057022174 0ustar liggesusers‹mRMOÜ05ÉB´«ªBB•8æÐ‚˜…m+qCT•PAÛây“ÉÆàÄÆ‚üù¶v—­Åaâ™ñóÌ{3Y~8›=ÌBŠ÷"ÅÖDö³ƒ&hjÏOµÖ2_ó²Ë`œ”9£J#ØËÄÚþxrwûkäm¡.0vçš¶—,¸«mãN‰ŒDSÞâGÅÛãTëƯ ;N·ïúÄ> ˆî¶¤4ß», ¶úmÛô7õ(@ÞຖDvø‡´…^¸|Rx™U>À÷ •m¯ðyö/Aq# P˜¯ÖD¾º^]®®oµg½ÁmÒÑŸùÁ ¢kïëN@(®`D…⦗M^Qƒ¾ÿ*{ÐN·%>ýÙ²/Œdø[öe‘¦ò¤ÙyêÖŽçÙ"›;Ãàœ½KjH²VÿÓÓ/Ø5vÖO|ü³âðñ‡I5ä 4\vcîã«L[¸¿£/ñn@×¼£ØÒݤRÚy\E•>J¸pu}8#F×¹æOÐz87ZPösK$<xSøÎ0‡ Gwebmockr/tests/testthat/test-pluck_body.R0000644000176200001440000000431513665341057020335 0ustar liggesuserscontext("pluck_body") test_that("pluck_body: crul", { # prep objects # con <- crul::HttpClient$new("https://httpbin.org") # upload_list <- list(y = crul::upload(system.file("CITATION"))) # b <- con$post("post", body = upload_list) # crul_body_upload_list <- b$request # crul_body_upload_list$url$handle <- NULL # save(crul_body_upload_list, # file = "tests/testthat/crul_body_upload_list.rda", version = 2) # upload_no_list <- crul::upload(system.file("CITATION")) # d <- con$post("post", body = upload_no_list) # crul_body_upload_no_list <- d$request # crul_body_upload_no_list$url$handle <- NULL # save(crul_body_upload_no_list, # file = "tests/testthat/crul_body_upload_no_list.rda", version = 2) # upload in a list load("crul_body_upload_list.rda") expect_is(pluck_body(crul_body_upload_list), "list") # upload not in a list load("crul_body_upload_no_list.rda") expect_is(pluck_body(crul_body_upload_no_list), "character") expect_match(pluck_body(crul_body_upload_no_list), "file size") }) test_that("pluck_body: httr", { # prep objects # upload_list <- list(y = httr::upload_file(system.file("CITATION"))) # b <- httr::POST("https://httpbin.org/post", body = upload_list) # httr_body_upload_list <- b$request # save(httr_body_upload_list, # file = "tests/testthat/httr_body_upload_list.rda", version = 2) # upload_no_list <- httr::upload_file(system.file("CITATION")) # d <- httr::POST("https://httpbin.org/post", body = upload_no_list) # httr_body_upload_no_list <- d$request # save(httr_body_upload_no_list, # file = "tests/testthat/httr_body_upload_no_list.rda", version = 2) # upload in a list load("httr_body_upload_list.rda") expect_is(pluck_body(httr_body_upload_list), "list") # upload not in a list load("httr_body_upload_no_list.rda") expect_is(pluck_body(httr_body_upload_no_list), "character") expect_match(pluck_body(httr_body_upload_no_list), "file size") }) test_that("pluck_body fails well", { expect_error(pluck_body(5), "not a valid") expect_error(pluck_body(mtcars), "not a valid") expect_error(pluck_body(FALSE), "not a valid") expect_error(pluck_body(list(url="adf", method=3, options=5)), "not a valid") }) webmockr/tests/testthat/test-StubRegistry.R0000644000176200001440000000622513665341057020652 0ustar liggesuserscontext("StubRegistry") aa <- StubRegistry$new() test_that("StubRegistry: bits are correct prior to having data", { expect_is(StubRegistry, "R6ClassGenerator") expect_is(aa, "StubRegistry") expect_is(aa$global_stubs, "list") expect_equal(length(aa$global_stubs), 0) expect_is(aa$request_stubs, "list") expect_equal(length(aa$request_stubs), 0) expect_null(aa$stub) expect_is(aa$find_stubbed_request, "function") expect_is(aa$is_registered, "function") expect_is(aa$print, "function") expect_is(aa$register_stub, "function") expect_is(aa$remove_all_request_stubs, "function") expect_is(aa$remove_request_stub, "function") expect_is(aa$request_stub_for, "function") # expect_is(aa$response_for_request, "function") }) test_that("StubRegistry: bits are correct after having data", { stub1 <- StubbedRequest$new(method = "get", uri = "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 = "https://httpbin.org") aa <- StubRegistry$new() expect_is(aa$register_stub(stub = stub1), "list") expect_is(aa$register_stub(stub = stub2), "list") expect_is(aa, "StubRegistry") # global stubs are still empty expect_is(aa$global_stubs, "list") expect_equal(length(aa$global_stubs), 0) # request stubs now length 2 expect_is(aa$request_stubs, "list") expect_equal(length(aa$request_stubs), 2) expect_null(aa$stub) # find_stubbed_request req1 <- RequestSignature$new( method = "get", uri = "http://api.crossref.org", options = list( headers = list('User-Agent' = 'R') ) ) res <- aa$find_stubbed_request(req = req1) expect_is(res, "list") expect_is(res[[1]], "StubbedRequest") expect_equal(res[[1]]$uri, "http://api.crossref.org") # is_registered expect_true(aa$is_registered(x = req1)) # request_stub_for matches <- aa$request_stub_for(request_signature = req1) expect_is(matches, "logical") expect_equal(matches, c(TRUE, FALSE)) # response_for_request ## FIXME - internal function not made yet # expect_error(aa$response_for_request(request_signature = req1), # "could not find function") # remove_request_stub res <- aa$remove_request_stub(stub = stub1) expect_is(res, "list") expect_equal(length(res), 1) # remove_all_request_stubs ## add another first aa$register_stub(stub = stub1) res <- aa$remove_all_request_stubs() expect_is(res, "list") expect_equal(length(res), 0) }) test_that("StubRegistry fails well", { # fill ins ome data first stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") aa <- StubRegistry$new() aa$register_stub(stub = stub1) expect_error(aa$find_stubbed_request(), "argument \"req\" is missing") expect_error(aa$is_registered(), "argument \"x\" is missing") expect_error(aa$register_stub(), "argument \"stub\" is missing") expect_error(aa$remove_request_stub(), "argument \"stub\" is missing") expect_error(aa$request_stub_for(), "argument \"request_signature\" is missing") # expect_error(aa$response_for_request(), "argument \"request_signature\" is missing") }) webmockr/tests/testthat/httr_body_upload_no_list.rda0000644000176200001440000000257413665341057022670 0ustar liggesusers‹íXmoÛ6¦%YŽí4ov’&C€l(: h¤vM×aȇu+Ö! †~3d›ŽµÊ’ª$Ù¾ìì?î?t_† ÉxÒQ¦)ÉqÚ Ý0¸Ð"wÇçŽä}õò“ÆË!D!ª®Ee?5…ý«ÔY{{EA§ëõÏ;±ïxV¿ãzÇ#BÔ¯1Yôµï^|,õ ?üÜ4¡íÚ®á'¦ï e%ñê=°|ß±{Vd{®ùcè¹÷w#z™g#çþ®8–tÜ3ïá¼F¢å;–íJÑW]kDC ‡»ÑŸözÔðkñ™çFÔöŽÏ}ʾ/RQ`qš´;ŽÝíÅc>1ïvƒ½äkßx´ 0™}ã!”ÌIDSÑüý-DƒY·»œ›_ ¤S/xšGÆ€˜?Ð d`‡æ#ãSóˆ†^ôhh:8«k…Ô|vxüôøðÅ·’í\B”K)šoECþ;JŸL\ϱÂP2[xÁ¨3°ž§uÄùbÜdÒFŒ _MÛx×q 6“ºfø ì„U’)ü»hj}dE½¡aÒÄLA§nÏëSì½Z­šDüË8R^-ÌÒÇŠ[Z¡g~@Ã$‡nŸž³ÝdºZu\aÚ¥\}}ƒ;õêWfØVi‹¨ràºÛ=’­û§¼$Ã0Ò„ãß 3ØB›ˆÔ]’ì‹DL/3YűM„j’Ìä# vmÃÜ&èæl£ý6ö}Èäc´ÛF`£ˆeÉôÕBÛëh»6A·#Äø™#÷c[¤¸@+?“qaþŽƒEŠŠ=4+%š5;4ÜØqÈDÅë—¨vA ·ÌÊ¥d^)1¯4ŠWÒVK´ÕÀ:—µ¢)­ ƒ=R¼‰Õ®-ÇS-' VÿË uŽhy%¿axIIJh ú¤÷UÛZIt•Iq¡DQw¨{Ž扰6ŠR,‡;Kêë%^Ùqï…´º" %FÔ99ôg©y½´ó&ý´©[Òæý*¶é9E6y? lì+.(]Ô¿¡ë!Ñõ°Úfg韧‚°¾Aßì{‹/H~kØêiÿ6ï¯_Îú ÆÏËì6»’]…Œï1E—ÆU\ÿ,rKå)ÂS¿Š²&H{ŠÀ¶‰²&ÉâX®…[uÍÈ‚š±A HàÄn˜>öµ`|`S§|¸ã0Ö%p N†2³5~–h4ôú¼þUçgõù`ô–륦ù çƒkþÙ°âh؉¼W”G£{qäÇQ ìxS`L9J® cd@ʘ”«z ‹C\‘ÀŠ’õRwSÞZfv™£Ø]Ý׬zw&^g²73ðÔÂzÕ -}#ærÖ¿“·µÿÔ³d.«¹—H>°$?’óWºÉ飨‰lß r¸fÕ"±ÁLþ"陳`_Â>mâ‚ó`ÇîbN ή6Ô®«¦t %ã3œM~þrsç·³€v¦ü]ÇîÚ<ÃÕ”i'ØJxÏÙ7™³ï9ûΖ'û•ãš³ï9û&söýeßp•=öiœüÄ! ¬êFéz—×?µ5ö•ÅÉùÜâi`G´3¢#/8ç-íËœd÷ü¿ñý\ü ´Í!£!webmockr/tests/testthat/test-HashCounter.R0000644000176200001440000000201313665341057020416 0ustar liggesuserscontext("HashCounter") test_that("HashCounter: structure", { expect_is(HashCounter, "R6ClassGenerator") x <- HashCounter$new() expect_is(x, "HashCounter") expect_is(x$clone, "function") expect_is(x$get, "function") expect_is(x$put, "function") expect_is(x$hash, "list") }) test_that("HashCounter: works as expected", { x <- HashCounter$new() a <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") b <- RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/") x$put(a) expect_length(x$hash, 1) expect_equal(x$hash[[a$to_s()]]$count, 1) x$put(a) expect_length(x$hash, 1) expect_equal(x$hash[[a$to_s()]]$count, 2) x$put(b) expect_length(x$hash, 2) expect_equal(x$hash[[b$to_s()]]$count, 1) x$put(b) x$put(b) expect_length(x$hash, 2) expect_equal(x$hash[[b$to_s()]]$count, 3) }) test_that("HashCounter fails well", { x <- HashCounter$new() expect_error(x$get(), '\"req_sig\" is missing') expect_error(x$put(), '\"req_sig\" is missing') }) webmockr/tests/testthat/test-auth_handling.R0000644000176200001440000000247713750077333021014 0ustar liggesusers# from https://github.com/ropensci/webmockr/issues/108 # httr stub_registry()$remove_all_request_stubs() skip_if_not_installed("httr") library("httr") enable("httr") test_that("auth handling: httr", { stub_request("get", "http://stuff.com") # auth well-formed expect_is( GET("http://stuff.com", authenticate("adf", "adf")), "response" ) # user name invalid according to RFC, but we can't know that expect_is( GET("http://stuff.com", authenticate("foo:bar", "adf")), "response" ) # malformed: url as username expect_error( GET("http://stuff.com", authenticate("http://", "foo.com")) ) }) # crul disable() stub_registry()$remove_all_request_stubs() skip_if_not_installed("crul") library("crul") enable("crul") test_that("auth handling: httr", { stub_request("get", "http://stuff.com") # auth well-formed x <- HttpClient$new("http://stuff.com") x$auth <- auth("adf", "adf") expect_is(x$get(), "HttpResponse") # user name invalid according to RFC, but we can't know that y <- HttpClient$new("http://stuff.com") y$auth <- auth("foo:bar", "adf") expect_is(y$get(), "HttpResponse") # malformed: url as username z <- HttpClient$new("http://stuff.com") z$auth <- auth("http://", "foo.com") expect_error(z$get()) }) stub_registry()$remove_all_request_stubs() disable() webmockr/tests/testthat/test-Response.R0000644000176200001440000000752413665341057020005 0ustar liggesuserscontext("Response") aa <- Response$new() test_that("Response: bits are correct prior to having data", { expect_is(Response, "R6ClassGenerator") expect_is(aa, "Response") expect_null(aa$body, "function") expect_null(aa$content, "function") expect_null(aa$exception, "function") expect_is(aa$get_body, "function") expect_is(aa$get_exception, "function") expect_is(aa$get_request_headers, "function") expect_is(aa$get_respone_headers, "function") expect_is(aa$get_status, "function") expect_is(aa$get_url, "function") expect_is(aa$print, "function") expect_is(aa$set_body, "function") expect_is(aa$set_exception, "function") expect_is(aa$set_request_headers, "function") expect_is(aa$set_response_headers, "function") expect_is(aa$set_status, "function") expect_is(aa$set_url, "function") expect_null(aa$should_timeout, "function") expect_null(aa$request_headers) expect_null(aa$response_headers) expect_null(aa$response_headers_all) expect_equal(aa$status_code, 200) expect_null(aa$url) expect_null(aa$name) }) test_that("Response: bits are correct after having data", { aa <- Response$new() aa$set_url("https://httpbin.org/get") aa$set_request_headers(list('Content-Type' = "application/json")) aa$set_response_headers(list('Host' = "httpbin.org")) aa$set_status(404) aa$set_body("hello world") aa$set_exception("exception") expect_is(aa, "Response") expect_null(aa$should_timeout) expect_is(aa$request_headers, "list") expect_named(aa$request_headers, "Content-Type") expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "Host") # 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, "https://httpbin.org/get") expect_null(aa$name) expect_equal(aa$body, "hello world") expect_is(aa$content, "raw") expect_equal(aa$exception, "exception") expect_equal(aa$get_body(), "hello world") expect_equal(aa$get_exception(), "exception") expect_equal(aa$get_request_headers()[[1]], "application/json") expect_equal(aa$get_respone_headers()[[1]], "httpbin.org") expect_equal(aa$get_status(), 404) expect_equal(aa$get_url(), "https://httpbin.org/get") expect_output(aa$print(), "") expect_output(aa$print(), "headers") expect_output(aa$print(), "request headers") # set_body: char gets converted to raw in $content aa$set_body(body = "stuff") expect_is(aa$body, "character") expect_is(aa$content, "raw") expect_length(aa$content, 5) # set_body: raw remains as raw in $content aa$set_body(body = charToRaw("stuff")) expect_is(aa$body, "raw") expect_is(aa$content, "raw") expect_length(aa$content, 5) # set_body: other types return raw(0) in $content aa$set_body(body = NULL) expect_null(aa$body) expect_is(aa$content, "raw") expect_length(aa$content, 0) aa$set_exception(exception = "stop, wait, listen") expect_equal(aa$exception, "stop, wait, listen") aa$set_request_headers(headers = list(a = "howdy")) expect_equal(aa$request_headers[[1]], "howdy") aa$set_response_headers(headers = list(b = 6)) expect_equal(aa$get_respone_headers()[[1]], "6") aa$set_status(status = 410) expect_equal(aa$status_code, 410) aa$set_url(url = "foobar.com") expect_equal(aa$url, "foobar.com") }) test_that("Response fails well", { expect_error(aa$set_body(), "argument \"body\" is missing") # body must be length 1 expect_error(aa$set_body(letters), "is not TRUE") expect_error(aa$set_exception(), "argument \"exception\" is missing") expect_error(aa$set_request_headers(), "argument \"headers\" is missing") expect_error(aa$set_response_headers(), "argument \"headers\" is missing") expect_error(aa$set_status(), "argument \"status\" is missing") expect_error(aa$set_url(), "argument \"url\" is missing") }) webmockr/tests/testthat/test-writing-to-disk.R0000644000176200001440000000570613733436664021247 0ustar liggesuserscontext("mock writing to disk") enable() test_that("Write to a file before mocked request: crul", { skip_on_cran() library(crul) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) expect_is(readLines(f), "character") expect_match(readLines(f), "world") ## make the stub stub_request("get", "https://httpbin.org/get") %>% to_return(body = file(f)) ## make a request out <- HttpClient$new("https://httpbin.org/get")$get(disk = f) expect_is(out$content, "character") expect_equal(attr(out$content, "type"), "file") expect_is(readLines(out$content), "character") expect_match(readLines(out$content), "hello") # cleanup unlink(f) stub_registry_clear() }) test_that("Write to a file before mocked request: httr", { skip_on_cran() library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## write something to the file cat("{\"hello\":\"world\"}\n", file = f) expect_is(readLines(f), "character") expect_match(readLines(f), "world") ## make the stub stub_request("get", "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)) content(out) expect_is(out$content, "path") expect_equal(attr(out$content, "class"), "path") expect_is(readLines(out$content), "character") expect_match(readLines(out$content), "hello") # cleanup unlink(f) stub_registry_clear() }) test_that("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", "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 expect_is(out$content, "character") expect_match(out$content, "json") expect_is(readLines(out$content), "character") expect_true(any(grepl("hello", readLines(out$content)))) # cleanup unlink(f) stub_registry_clear() }) test_that("Use mock_file to have webmockr handle file and contents: httr", { skip_on_cran() library(httr) ## make a temp file f <- tempfile(fileext = ".json") ## make the stub stub_request("get", "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)) ## view stubbed file content expect_is(out$content, "path") expect_match(out$content, "json") expect_is(readLines(out$content), "character") expect_true(any(grepl("foo", readLines(out$content)))) # cleanup unlink(f) stub_registry_clear() }) webmockr/tests/testthat/test-stub_registry.R0000644000176200001440000000275213665341057021112 0ustar liggesuserscontext("stub_registry") test_that("stub_registry: works", { # before any stubs creatd expect_output(print(stub_registry()), "Registered Stubs") expect_equal(length(stub_registry()$request_stubs), 0) # after a stub creatd stub_request("get", "https://scottchamberlain.info") expect_equal(length(stub_registry()$request_stubs), 1) expect_match(stub_registry()$request_stubs[[1]]$to_s(), "GET: https://scottchamberlain.info") # stub with body stub_request('post', uri = 'https://httpbin.org/post') %>% 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(), "POST: https://httpbin.org/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", "https://httpbin.org/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-b-no-cassette-in-use.R0000644000176200001440000000106613665341057022044 0ustar liggesuserscontext("no_cassette_in_use") test_that("no cassette in use behaves as expected", { skip_if_not_installed("vcr") library("vcr") dir <- tempdir() invisible(vcr_configure(dir = dir)) crul::mock() x <- crul::HttpClient$new(url = "https://httpbin.org") # when no cassette in use, we get expected vcr error expect_error( x$get("get"), "There is currently no cassette in use" ) # cleanup unlink(file.path(vcr_configuration()$dir, "turtle.yml")) # reset configuration vcr_configure_reset() # unload vcr unloadNamespace("vcr") }) webmockr/tests/testthat/test-to_timeout.R0000644000176200001440000000212313665341060020357 0ustar liggesuserscontext("to_timeout") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) aa <- stub_request("get", "https://httpbin.org/get") %>% to_timeout() test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_null(aa$response_headers) expect_is(aa$responses_sequences, "list") expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https://httpbin.org/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), ".data must be of class StubbedRequest") }) # cleanup stub_registry_clear() webmockr/tests/testthat/helper-webmockr.R0000644000176200001440000000102513272757522020310 0ustar liggesuserssm <- function(x) suppressMessages(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 } webmockr/tests/testthat/test-stub_request.R0000644000176200001440000000253513665341057020731 0ustar liggesuserscontext("stub_request") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) aa <- stub_request("get", "https://httpbin.org/get") test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$query) expect_null(aa$request_headers) expect_null(aa$response) expect_null(aa$response_headers) expect_null(aa$responses_sequences) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https://httpbin.org/get") expect_is(aa$print, "function") expect_output(aa$print(), "") expect_is(aa$to_return, "function") expect_error(aa$to_return(), "argument \"body\" is missing") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "GET: https://httpbin.org/get") expect_is(aa$with, "function") expect_null(aa$with()) expect_is(aa$uri_parts, "list") }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(stub_request(), "one of uri or uri_regex is required") expect_error(stub_request(method = "stuff", "adf"), "'arg' should be one of") }) webmockr/tests/testthat/test-within_test_that_blocks.R0000644000176200001440000000317613665341060023116 0ustar liggesuserscontext("within test_that blocks: httr") library("httr") test_that("httr: without pipe", { httr_mock() enable() dat_json <- '{"foo":"bar"}' stub <- stub_request("get", uri = "https://httpbin.org/get") to_return(stub, body = dat_json, headers = list("Content-Type" = "application/json; charset=utf-8") ) res <- GET("https://httpbin.org/get") expect_true(inherits(res, "response")) expect_is(content(res), "list") expect_named(content(res), "foo") expect_equal(content(res)$foo, "bar") disable() httr_mock(FALSE) }) test_that("httr: with pipe", { enable() dat_json <- '{"foo":"bar"}' stub <- stub_request("get", uri = "https://httpbin.org/get") %>% to_return(body = dat_json, headers = list("Content-Type" = "application/json; charset=utf-8")) res <- GET("https://httpbin.org/get") expect_true(inherits(res, "response")) expect_is(content(res), "list") expect_named(content(res), "foo") expect_equal(content(res)$foo, "bar") disable() }) unloadNamespace("httr") context("within test_that blocks: crul") test_that("crul works", { enable() dat_json <- '{"foo":"bar"}' stub <- stub_request("get", uri = "https://httpbin.org/get") to_return(stub, body = dat_json, headers = list("Content-Type" = "application/json; howdy") ) res <- crul::HttpClient$new("https://httpbin.org")$get("get") expect_true(inherits(res, "HttpResponse")) expect_is(res$parse("UTF-8"), "character") expect_is(jsonlite::fromJSON(res$parse("UTF-8")), "list") expect_named(jsonlite::fromJSON(res$parse("UTF-8")), "foo") expect_equal(jsonlite::fromJSON(res$parse("UTF-8"))$foo, "bar") disable() }) webmockr/tests/testthat/test-CrulAdapter.R0000644000176200001440000001364213665341057020413 0ustar liggesuserscontext("CrulAdapter") aa <- CrulAdapter$new() test_that("CrulAdapter bits are correct", { skip_on_cran() expect_is(CrulAdapter, "R6ClassGenerator") expect_is(aa, "CrulAdapter") expect_null(aa$build_crul_request) # pulled out of object, so should be NULL expect_null(aa$build_crul_response) # pulled out of object, so should be NULL expect_is(aa$disable, "function") expect_is(aa$enable, "function") expect_is(aa$handle_request, "function") expect_is(aa$remove_stubs, "function") expect_is(aa$name, "character") expect_equal(aa$name, "CrulAdapter") }) test_that("CrulAdapter behaves correctly", { skip_on_cran() expect_message(aa$enable(), "CrulAdapter enabled!") expect_message(aa$disable(), "CrulAdapter disabled!") }) test_that("build_crul_request/response fail well", { skip_on_cran() expect_error(build_crul_request(), "argument \"x\" is missing") expect_error(build_crul_response(), "argument \"resp\" is missing") }) test_that("CrulAdapter: works when vcr is loaded but no cassette is inserted", { skip_on_cran() skip_if_not_installed("vcr") webmockr::enable(adapter = "crul") on.exit({ webmockr::disable(adapter = "crul") unloadNamespace("vcr") }) stub_request("get", "https://httpbin.org/get") library("vcr") # works when no cassette is loaded cli <- crul::HttpClient$new("https://httpbin.org") expect_silent(x <- cli$get("get")) expect_is(x, "HttpResponse") # works when empty cassette is loaded vcr::vcr_configure(dir = tempdir()) vcr::insert_cassette("empty") expect_silent(x <- cli$get("get")) vcr::eject_cassette("empty") expect_is(x, "HttpResponse") }) context("CrulAdapter - with real data") test_that("CrulAdapter works", { skip_on_cran() skip_if_not_installed('vcr') load("crul_obj.rda") crul_obj$url$handle <- curl::new_handle() res <- CrulAdapter$new() # with vcr message library(vcr) expect_error( res$handle_request(crul_obj), "There is currently no cassette in use" ) # with webmockr message # unload vcr unloadNamespace("vcr") expect_error( res$handle_request(crul_obj), "Real HTTP connections are disabled.\nUnregistered request:\n GET: http://localhost:9000/get\n\nYou can stub this request with the following snippet:\n\n stub_request\\('get', uri = 'http://localhost:9000/get'\\)\n============================================================" ) invisible(stub_request("get", "http://localhost:9000/get")) aa <- res$handle_request(crul_obj) expect_is(res, "CrulAdapter") expect_is(aa, "HttpResponse") expect_equal(aa$method, "get") expect_equal(aa$url, "http://localhost:9000/get") # no response headers expect_equal(length(aa$response_headers), 0) expect_equal(length(aa$response_headers_all), 0) # with headers # clear registry stub_registry_clear() # stub with headers x <- stub_request("get", "http://localhost:9000/get") x <- to_return(x, headers = list('User-Agent' = 'foo-bar')) aa <- res$handle_request(crul_obj) expect_is(res, "CrulAdapter") expect_is(aa, "HttpResponse") expect_equal(aa$method, "get") expect_equal(aa$url, "http://localhost:9000/get") # has response_headers and response_headers_all expect_equal(length(aa$response_headers), 1) expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "user-agent") expect_equal(length(aa$response_headers_all), 1) expect_is(aa$response_headers_all, "list") expect_named(aa$response_headers_all, NULL) expect_named(aa$response_headers_all[[1]], "user-agent") # stub with redirect headers my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" x <- stub_request("get", my_url) x <- to_return(x, status = 302, headers = list( status = 302, location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" ) ) crul_obj$url$url <- my_url res <- CrulAdapter$new() aa <- res$handle_request(crul_obj) expect_equal(aa$method, "get") expect_equal(aa$url, my_url) expect_equal(aa$status_code, 302) # has response_headers and response_headers_all expect_equal(length(aa$response_headers), 2) expect_is(aa$response_headers, "list") expect_equal(sort(names(aa$response_headers)), c('location', 'status')) expect_equal(length(aa$response_headers_all), 1) expect_equal(length(aa$response_headers_all[[1]]), 2) expect_is(aa$response_headers_all, "list") expect_is(aa$response_headers_all[[1]], "list") expect_named(aa$response_headers_all, NULL) expect_equal(sort(names(aa$response_headers_all[[1]])), c('location', 'status')) ## FIXME: ideally can test multiple redirect headers, e.g. like this: # x <- stub_request("get", "https://doi.org/10.1007/978-3-642-40455-9_52-1") # x <- to_return(x, headers = list( # list( # status = 'HTTP/1.1 302 ', # location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" # ), # list( # status = 'HTTP/1.1 301 Moved Permanently', # location = "https://link.springer.com/10.1007/978-3-642-40455-9_52-1" # ), # list( # status = 'HTTP/1.1 302 Found', # location = "https://link.springer.com/referenceworkentry/10.1007%2F978-3-642-40455-9_52-1" # ), # list( # status = 'HTTP/1.1 200 OK' # ) # )) }) test_that("crul requests with JSON-encoded bodies work", { skip_on_cran() on.exit(disable(adapter = "crul")) enable(adapter = "crul") body <- list(foo = "bar") url <- "https://httpbin.org" 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_is(res, "HttpResponse") # encoded but modified body fails expect_error( cli$post("post", body = list(foo = "bar1"), encode = "json"), "Unregistered request" ) # unencoded body fails expect_error( cli$post("post", body = body), "Unregistered request" ) }) webmockr/tests/testthat/test-to_return_body.R0000644000176200001440000000367313665341060021240 0ustar liggesuserscontext("to_return: response body types behave correctly for crul pkg") test_that("to_return: setting body behaves correctly", { enable() stub_registry_clear() # character aa <- stub_request("get", "https://google.com") %>% to_return(body = '{"foo":"bar"}') z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), '{"foo":"bar"}') stub_registry_clear() # cleanup # list bb <- stub_request("get", "https://google.com") %>% to_return(body = list(foo = "bar")) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), '{"foo":"bar"}') stub_registry_clear() # cleanup # NULL cc <- stub_request("get", "https://google.com") %>% to_return(body = NULL) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), "") stub_registry_clear() # cleanup # FALSE dd <- stub_request("get", "https://google.com") %>% to_return(body = FALSE) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), "") stub_registry_clear() # cleanup # raw ee <- stub_request("get", "https://google.com") %>% to_return(body = charToRaw('{"foo":"bar"}')) z <- crul::HttpClient$new(url = "https://google.com")$get() expect_is(z$content, "raw") expect_is(z$parse("UTF-8"), "character") expect_equal(z$parse("UTF-8"), '{"foo":"bar"}') stub_registry_clear() # cleanup }) test_that("to_return: setting body with wrong type errors well", { ## ERRORS when not of right type expect_error( stub_request("get", "https://google.com") %>% to_return(body = TRUE), "Unknown type of `body`" ) }) webmockr/tests/testthat/test-to_return_then.R0000644000176200001440000000410413665341060021227 0ustar liggesuserscontext("to_return: then") enable() webmockr_reset() test_that("to_return: then", { stub <- stub_request("get", "https://httpbin.org/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 = "https://httpbin.org/") x1 <- cli$get("get", query = list(stuff="things")) x2 <- cli$get("get", query = list(stuff="things")) x3 <- cli$get("get", query = list(stuff="things")) # first should have foobar expect_equal(x1$parse("UTF-8"), "foobar") # second should have bears expect_equal(x2$parse("UTF-8"), "bears") # third should have bears again, and so on expect_equal(x3$parse("UTF-8"), "bears") }) webmockr_reset() test_that("to_return: webmockr_reset allows multiple requests to start from beginning", { stub <- stub_request("get", "https://httpbin.org/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 = "https://httpbin.org/") 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", "https://httpbin.org/get?stuff=things") to_return(stub, status = 200, body = "foobar", headers = list(a = 5)) to_return(stub, status = 200, body = "bears", headers = list(b = 6)) w1 <- cli$get("get", query = list(stuff="things")) w2 <- cli$get("get", query = list(stuff="things")) expect_equal(w1$parse("UTF-8"), "foobar") expect_equal(w2$parse("UTF-8"), "bears") }) webmockr_reset() disable() webmockr/tests/testthat/test-HttrAdapter.R0000644000176200001440000002447613665341057020436 0ustar liggesuserscontext("HttrAdapter") skip_if_not_installed("httr") library("httr") aa <- HttrAdapter$new() test_that("HttrAdapter bits are correct", { skip_on_cran() expect_is(HttrAdapter, "R6ClassGenerator") expect_is(aa, "HttrAdapter") expect_null(aa$build_httr_request) # pulled out of object, so should be NULL expect_null(aa$build_httr_response) # pulled out of object, so should be NULL expect_is(aa$disable, "function") expect_is(aa$enable, "function") expect_is(aa$handle_request, "function") expect_is(aa$remove_stubs, "function") expect_is(aa$name, "character") expect_equal(aa$name, "HttrAdapter") }) test_that("HttrAdapter behaves correctly", { skip_on_cran() expect_message(aa$enable(), "HttrAdapter enabled!") expect_message(aa$disable(), "HttrAdapter disabled!") }) test_that("build_httr_request/response fail well", { skip_on_cran() expect_error(build_httr_request(), "argument \"x\" is missing") expect_error(build_httr_response(), "argument \"req\" is missing") }) test_that("HttrAdapter: works when vcr is loaded but no cassette is inserted", { skip_on_cran() skip_if_not_installed("vcr") webmockr::enable(adapter = "httr") on.exit({ webmockr::disable(adapter = "httr") unloadNamespace("vcr") }) stub_request("get", "https://httpbin.org/get") library("vcr") # works when no cassette is loaded expect_silent(x <- httr::GET("https://httpbin.org/get")) expect_is(x, "response") # # works when empty cassette is loaded vcr::vcr_configure(dir = tempdir()) vcr::insert_cassette("empty") expect_silent(x <- httr::GET("https://httpbin.org/get")) vcr::eject_cassette("empty") expect_is(x, "response") }) # library(httr) # z <- GET("https://httpbin.org/get") # httr_obj <- z$request # save(httr_obj, file = "tests/testthat/httr_obj.rda") context("HttrAdapter: date slot") test_that("HttrAdapter date slot works", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") path <- file.path(tempdir(), "foobar") vcr::vcr_configure(dir = path) vcr::use_cassette("test-date", httr::GET("https://httpbin.org/get")) # list.files(path) # readLines(file.path(path, "test-date.yml")) vcr::insert_cassette("test-date") x <- httr::GET("https://httpbin.org/get") # $date is of correct format expect_output(print(x), "Date") expect_is(x$date, "POSIXct") expect_is(format(x$date, "%Y-%m-%d %H:%M"), "character") # $headers$date is a different format expect_is(x$headers$date, "character") expect_error(format(x$headers$date, "%Y-%m-%d %H:%M"), "invalid 'trim'") vcr::eject_cassette("test-date") # cleanup unlink(path, recursive = TRUE) }) context("HttrAdapter: insensitive headers, webmockr flow") test_that("HttrAdapter insensitive headers work, webmockr flow", { skip_on_cran() unloadNamespace("vcr") httr_mock() stub_registry_clear() invisible(stub_request("get", uri = "https://httpbin.org/get") %>% to_return( body = list(foo = "bar"), headers = list("Content-Type" = "application/json") )) x <- httr::GET("https://httpbin.org/get") expect_equal(x$headers[["content-type"]], "application/json") expect_is(httr::content(x), "list") expect_is(httr::content(x, "text", encoding = "UTF-8"), "character") stub_registry_clear() httr_mock(FALSE) }) context("HttrAdapter: insensitive headers, vcr flow") test_that("HttrAdapter insensitive headers work, vcr flow", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") path <- file.path(tempdir(), "helloworld") vcr::vcr_configure(dir = path) vcr::use_cassette("test-date", GET("https://httpbin.org/get")) vcr::insert_cassette("test-date") x <- httr::GET("https://httpbin.org/get") expect_equal(x$headers[["content-type"]], "application/json") expect_is(httr::content(x), "list") expect_is(httr::content(x, "text", encoding = "UTF-8"), "character") vcr::eject_cassette("test-date") # cleanup unlink(path, recursive = TRUE) }) context("HttrAdapter: works with real data") test_that("HttrAdapter works", { skip_on_cran() skip_if_not_installed("vcr") load("httr_obj.rda") # load("tests/testthat/httr_obj.rda") res <- HttrAdapter$new() # with vcr message library("vcr") expect_error( res$handle_request(httr_obj), "There is currently no cassette in use" ) # with webmockr message # unload vcr unloadNamespace("vcr") expect_error( res$handle_request(httr_obj), "Real HTTP connections are disabled.\nUnregistered request:\n GET: https://httpbin.org/get" ) invisible(stub_request("get", "https://httpbin.org/get")) aa <- res$handle_request(httr_obj) expect_is(res, "HttrAdapter") expect_is(aa, "response") expect_equal(aa$request$method, "GET") expect_equal(aa$url, "https://httpbin.org/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", "https://httpbin.org/get") x <- to_return(x, headers = list("User-Agent" = "foo-bar")) aa <- res$handle_request(httr_obj) expect_is(res, "HttrAdapter") expect_is(aa, "response") expect_equal(aa$request$method, "GET") expect_equal(aa$url, "https://httpbin.org/get") # has headers and all_headers expect_equal(length(aa$headers), 1) expect_is(aa$headers, "list") expect_named(aa$headers, "user-agent") expect_equal(length(aa$all_headers), 1) expect_is(aa$all_headers, "list") expect_named(aa$all_headers, NULL) expect_named(aa$all_headers[[1]], c("status", "version", "headers")) # stub with redirect headers my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" x <- stub_request("get", my_url) x <- to_return(x, status = 302, headers = list( status = 302, location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" ) ) httr_obj$url <- my_url res <- HttrAdapter$new() aa <- res$handle_request(httr_obj) expect_equal(aa$request$method, "GET") expect_equal(aa$url, my_url) expect_equal(aa$status_code, 302) # has headers and all_headers expect_equal(length(aa$headers), 2) expect_is(aa$headers, "list") expect_equal(sort(names(aa$headers)), c("location", "status")) expect_equal(length(aa$all_headers), 1) expect_equal(length(aa$all_headers[[1]]), 3) expect_is(aa$all_headers, "list") expect_is(aa$all_headers[[1]], "list") expect_named(aa$all_headers, NULL) expect_equal(sort(names(aa$all_headers[[1]])), c("headers", "status", "version")) }) test_that("HttrAdapter works with httr::authenticate", { skip_on_cran() unloadNamespace("vcr") httr_mock() # httr_mock(FALSE) # webmockr_allow_net_connect() stub_registry_clear() # stub_registry() # request_registry() z <- stub_request("get", uri = "https://httpbin.org/basic-auth/foo/bar") %>% to_return( body = list(foo = "bar"), headers = list("Content-Type" = "application/json") ) # x <- httr::GET("https://httpbin.org/basic-auth/foo/bar", httr::authenticate("foo", "bar")) # httr_obj_auth <- x$request # save(httr_obj_auth, file = "tests/testthat/httr_obj_auth.rda", version = 2) # load("tests/testthat/httr_obj_auth.rda") # httr::content(x) # mocked httr requests with auth work # before the fixes in HttrAdapter: a real request through webmockr would # not work with authenticate x <- httr::GET("https://httpbin.org/basic-auth/foo/bar", httr::authenticate("foo", "bar")) expect_is(x, "response") expect_equal(httr::content(x), list(foo = "bar")) expect_equal(x$headers, structure(list(`content-type` = "application/json"), class = c("insensitive", "list"))) expect_equal(x$status_code, 200) # HttrAdapter works on requests with auth load("httr_obj_auth.rda") zz <- HttrAdapter$new() z <- zz$handle_request(httr_obj_auth) expect_is(z, "response") expect_equal(httr::content(z), list(foo = "bar")) expect_equal(z$headers, structure(list(`content-type` = "application/json"), class = c("insensitive", "list"))) expect_equal(z$status_code, 200) }) test_that("httr works with webmockr_allow_net_connect", { skip_on_cran() httr_mock() stub_registry_clear() z <- stub_request("get", uri = "https://httpbin.org/get?stuff=things") %>% to_return(body = "yum=cheese") x <- httr::GET("https://httpbin.org/get?stuff=things") expect_true(httr::content(x, "text", encoding="UTF-8") == "yum=cheese") # allow net connect - stub still exists though - so not a real request webmockr_allow_net_connect() z <- httr::GET("https://httpbin.org/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("https://httpbin.org/get?stuff=things") expect_false(httr::content(w, "text", encoding="UTF-8") == "yum=cheese") # disable net connect - now real requests can't be made webmockr_disable_net_connect() expect_error(httr::GET("https://httpbin.org/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 = "https://httpbin.org/post") %>% to_return(body = "asdffsdsdf") x <- httr::POST("https://httpbin.org/post", body = list(stuff = "things")) expect_true(httr::content(x, "text", encoding="UTF-8") == "asdffsdsdf") # now with allow net connect stub_registry_clear() webmockr_allow_net_connect() x <- httr::POST("https://httpbin.org/post", body = list(stuff = "things")) expect_identical(httr::content(x)$form, list(stuff = "things")) webmockr_disable_net_connect() }) test_that("httr requests with JSON-encoded bodies work", { skip_on_cran() on.exit(disable(adapter = "httr")) enable(adapter = "httr") stub_registry_clear() body <- list(foo = "bar") z <- stub_request("post", uri = "https://httpbin.org/post") %>% wi_th(body = jsonlite::toJSON(body, auto_unbox = TRUE)) # encoded body works res <- httr::POST("https://httpbin.org/post", body = body, encode = "json") expect_is(res, "response") # encoded but modified body fails expect_error( httr::POST("https://httpbin.org/post", body = list(foo = "bar1"), encode = "json"), "Unregistered request" ) # unencoded body fails expect_error( httr::POST("https://httpbin.org/post", body = body), "Unregistered request" ) }) webmockr/tests/testthat/test-writing-to-disk-write_disk_path.R0000644000176200001440000000664414022531316024405 0ustar liggesuserscontext("write_disk_path behavior") # crul test_that("with crul", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") dir <- tempdir() invisible(vcr_configure(dir = dir)) library(crul) f <- tempfile(fileext = ".json") webmockr_net_connect_allowed() # path not set expect_error( suppressWarnings(use_cassette("write_disk_path_not_set_crul_error", { out <- HttpClient$new("https://httpbin.org/get")$get(disk = f) })), "write_disk_path must be given" ) # now set path wdp <- file.path(dir, "files") invisible(vcr_configure(dir = dir, write_disk_path = wdp)) expect_error( use_cassette("write_disk_path_not_set_crul_noerror", { out <- HttpClient$new("https://httpbin.org/get")$get(disk = f) }), NA ) # cleanup unlink(f) unlink(wdp, TRUE) unlink(file.path(dir, "write_disk_path_not_set_crul_error.yml")) unlink(file.path(dir, "write_disk_path_not_set_crul_noerror.yml")) webmockr_disable_net_connect() unloadNamespace("vcr") }) test_that("if relative path set its not expanded to full path anymore", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") dir <- tempdir() f <- "stuff.json" wdp <- "../files" invisible(vcr_configure(dir = dir, write_disk_path = wdp)) og <- getwd() setwd(dir) on.exit(setwd(og)) expect_error( use_cassette("write_disk_path_is_relative", { out <- HttpClient$new("https://httpbin.org/get?foo=foo")$get(disk = f) }), NA ) txt <- readLines(file.path(dir, "write_disk_path_is_relative.yml")) expect_true(any(grepl("../files/stuff.json", txt))) # cleanup # unlink("files", recursive = TRUE) unlink("stuff.json") webmockr_disable_net_connect() unloadNamespace("vcr") }) # httr test_that("with httr", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") enable() dir <- tempdir() invisible(vcr_configure(dir = dir)) library(httr) f <- tempfile(fileext = ".json") webmockr_net_connect_allowed() # path not set expect_error( suppressWarnings(use_cassette("write_disk_path_not_set_crul_error", { out <- GET("https://httpbin.org/get", write_disk(f)) })), "write_disk_path must be given" ) # now set path f <- tempfile(fileext = ".json") wdp <- file.path(dir, "files") invisible(vcr_configure(dir = dir, write_disk_path = wdp)) expect_error( use_cassette("write_disk_path_not_set_crul_noerror", { out <- GET("https://httpbin.org/get", write_disk(f)) }), NA ) # cleanup unlink(f) unlink(wdp, TRUE) unlink(file.path(dir, "write_disk_path_not_set_crul_error.yml")) unlink(file.path(dir, "write_disk_path_not_set_crul_noerror.yml")) webmockr_disable_net_connect() unloadNamespace("vcr") }) test_that("if relative path set its not expanded to full path anymore: httr", { skip_on_cran() skip_if_not_installed("vcr") library("vcr") dir <- tempdir() f <- "stuff.json" wdp <- "../files" invisible(vcr_configure(dir = dir, write_disk_path = wdp)) og <- getwd() setwd(dir) on.exit(setwd(og)) expect_error( use_cassette("write_disk_path_is_relative", { out <- GET("https://httpbin.org/get?foo=foo", write_disk(f)) }), NA ) txt <- readLines(file.path(dir, "write_disk_path_is_relative.yml")) expect_true(any(grepl("../files/stuff.json", txt))) # cleanup # unlink("files", recursive = TRUE) unlink("stuff.json") webmockr_disable_net_connect() unloadNamespace("vcr") }) webmockr/tests/testthat/crul_body_upload_list.rda0000644000176200001440000000062213665341057022150 0ustar liggesusers‹uRKKÃ@N“¶Ò€(ˆà1O¥Í[½P( ¥Hoa“l’ÕmvÙÝ`ã¯n^’†öÌÎã›ï›a–Ïësmjš¦kF_×tC=»ºúu´®6PöÒç)q=dnÊ…K°ªþB%{•í¨ï¼ºŠ¥dâ€Üz8±)£9n¯y/$Z`#åD™]+Ü-ñ_ÞìxÛÜ×{¾jîíÛ©íX|\xS{bå£Ç~°R‡þ[aõ=Žò=Hâ0B‰,Åü7ÉN£ÌFV€B%j%ÈÁ>”˜&àSÐddI´•`»!#«™+C0<¢êlæûˆÉñKâÓ'Qî—á†:µ ãÊX`CžW®þMù—K;¬ð¸PB˜Øw`‰M¹ ʃ§ùj¶š¿¿µz›ÅHŒ@œ]*”qý–Cí#ð í#„”oÜTη׹.êd’½æU›Ú Ó òN(Ë·.j7F0Pó×µ!F$Õîþà%³!webmockr/tests/testthat/test-to_raise.R0000644000176200001440000000275513665341057020015 0ustar liggesuserscontext("to_raise") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { expect_equal(length(stub_registry()$request_stubs), 0) }) library(fauxpas) aa <- stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPAccepted) test_that("stub_request bits are correct", { expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$response) expect_null(aa$query) expect_null(aa$request_headers) expect_null(aa$response_headers) # expect_false(aa$timeout) # timeout will be removed in StubbedRequest expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https://httpbin.org/get") # to_raise expected stuff rr <- aa$responses_sequences[[1]] expect_true(rr$raise) expect_is(rr$exceptions, "list") expect_is(rr$exceptions[[1]], "R6ClassGenerator") expect_equal(rr$exceptions[[1]]$classname, "HTTPAccepted") expect_equal(rr$exceptions[[1]]$new()$status_code, 202) }) test_that("stubs exist after stub_request called", { expect_equal(length(stub_registry()$request_stubs), 1) }) test_that("stub_request fails well", { expect_error(to_raise(), "argument \".data\" is missing") expect_error(to_raise(5), ".data must be of class StubbedRequest") # exception clases zzz <- stub_request("get", "https://httpbin.org/get") expect_error(to_raise(zzz, "foo"), "all objects must be error classes from fauxpas") }) webmockr/tests/testthat/test-stub_requests_crul.R0000644000176200001440000000725213320534135022127 0ustar liggesuserscontext("stub_request and crul: get") library(crul) crul::mock() # clear any stubs stub_registry_clear() test_that("stub_request works well: get requests", { skip_on_cran() # before any stubs made ## 0 stubs expect_equal(length(stub_registry()$request_stubs), 0) x <- crul::HttpClient$new(url = "https://httpbin.org") 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", "https://httpbin.org/get?foo=bar&a=5") %>% wi_th(headers = list( 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*') ) ## 1 stub expect_equal(length(stub_registry()$request_stubs), 1) # the matching request works z <- x$get('get', query = list(foo = "bar", a = 5)) expect_is(z, "HttpResponse") expect_equal(z$url, "https://httpbin.org/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", "https://httpbin.org/get?foo=bar&stuff=FALSE") %>% wi_th(headers = list( 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*') ) ## 2 stubs now expect_equal(length(stub_registry()$request_stubs), 2) # the other request now works w <- x$get('get', query = list(foo = "bar", stuff = FALSE)) expect_is(w, "HttpResponse") expect_equal(w$url, "https://httpbin.org/get?foo=bar&stuff=FALSE") # but the others still do not work cause they dont match the stub ms4 <- get_err_mssg(x$get('get', query = list(foo = "bar"))) expect_error(x$get('get', query = list(foo = "bar")), re_escape(ms4)) }) # clear any stubs again stub_registry_clear() context("stub_request and crul: post") test_that("stub_request works well: post requests", { skip_on_cran() # before any stubs made ## 0 stubs expect_equal(length(stub_registry()$request_stubs), 0) x <- crul::HttpClient$new(url = "https://httpbin.org") 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", "https://httpbin.org/post") %>% wi_th(headers = list( 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*'), body = list(foo = "bar", a = 5) ) ## 1 stub expect_equal(length(stub_registry()$request_stubs), 1) # the matching request works z <- x$post('post', body = list(foo = "bar", a = 5)) expect_is(z, "HttpResponse") expect_equal(z$url, "https://httpbin.org/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-Adapter.R0000644000176200001440000000033213665341057017555 0ustar liggesuserscontext("Adapter class") test_that("Adapter class can't be instantiated", { expect_is(Adapter, "R6ClassGenerator") expect_error( Adapter$new(), "Adapter parent class should not be called directly" ) }) webmockr/tests/testthat/test-request_registry.R0000644000176200001440000000151513665341057021621 0ustar liggesuserscontext("request_registry") test_that("request_registry: structure", { request_registry_clear() expect_is(request_registry, "function") expect_is(request_registry(), "RequestRegistry") enable() stub_request("get", "https://httpbin.org/get") %>% to_return(body = "success!", status = 200) invisible( crul::HttpClient$new(url = "https://httpbin.org")$get("get") ) disable() x <- request_registry() expect_is(x, "RequestRegistry") expect_is(x$clone, "function") expect_is(x$print, "function") expect_is(x$register_request, "function") expect_null(x$request) expect_is(x$request_signatures, "HashCounter") expect_is(x$reset, "function") expect_is(x$request_signatures$hash, "list") expect_match(names(x$request_signatures$hash), "GET") expect_is(x$request_signatures$hash[[1]]$count, 'numeric') }) webmockr/tests/testthat/crul_obj.rda0000644000176200001440000000036613107754664017376 0ustar liggesusers‹mPM Â0 ëüšA¼yõàZ'âÇÙ_ài7é¶²)u•¶ûûj»™CJš¤y/yÍå^è€!p ]Ç\=palü(–¿Šèn 3[¬½ÅL[¸E¦õó„11å™Pút$„à”i47€We?Íû1§Ju:MâBòkF󄳜œ>XÃqêGd(u8h3£RÌW½W–*kÃVüY xïï6>YÊu™þviw‰˜s% wi_th(headers = list("User-Agent" = "R")) expect_is(aa, "StubbedRequest") expect_null(aa$body) expect_null(aa$host) expect_null(aa$query) expect_is(aa$request_headers, "list") expect_null(aa$response) expect_null(aa$response_headers) expect_null(aa$responses_sequences) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https://httpbin.org/get") expect_equal(aa$request_headers, list("User-Agent" = "R")) }) test_that("wi_th: with headers and query", { aa <- stub_request("get", "https://httpbin.org/get") %>% wi_th( query = list(hello = "world"), headers = list("User-Agent" = "R")) expect_is(aa$query, "list") expect_is(aa$request_headers, "list") expect_output(print(aa), "hello=world") expect_output(print(aa), "User-Agent=R") }) test_that("wi_th: bodies", { aa <- stub_request("post", "https://httpbin.org/post") %>% wi_th(body = list(foo = "bar")) expect_is(aa$body, "list") expect_output(print(aa), "body \\(class: list\\): foo=bar") bb <- stub_request("post", "https://httpbin.org/post") %>% wi_th(body = '{"foo": "bar"}') expect_is(bb$body, "character") expect_output(print(bb), "body \\(class: character\\): \\{\"foo\": \"bar\"\\}") cc <- stub_request("post", "https://httpbin.org/post") %>% wi_th(body = charToRaw('{"foo": "bar"}')) expect_is(cc$body, "raw") expect_output(print(cc), "body \\(class: raw\\): raw bytes, length: 14") dd <- stub_request("post", "https://httpbin.org/post") %>% wi_th(body = 5) expect_is(dd$body, "numeric") expect_output(print(dd), "body \\(class: numeric\\): 5") ee <- stub_request("post", "https://httpbin.org/post") %>% wi_th(body = crul::upload(system.file("CITATION"))) expect_is(ee$body, "form_file") expect_output(print(ee), "body \\(class: form_file\\): crul::upload") # FIXME: ideally (maybe?) we have a upload within a list look like # the above when not in a list? ff <- stub_request("post", "https://httpbin.org/post") %>% wi_th(body = list(y = crul::upload(system.file("CITATION")))) expect_is(ff$body, "list") expect_is(ff$body$y, "form_file") expect_output(print(ff), "body \\(class: list\\): y = list\\(path") }) test_that("wi_th fails well", { expect_error(wi_th(), "argument \".data\" is missing") expect_error(wi_th(5), ".data must be of class StubbedRequest") zzz <- stub_request("get", "https://httpbin.org/get") # query expect_error(wi_th(zzz, query = list(5, 6)), "'query' must be a named list") expect_error(wi_th(zzz, query = list(a = 5, 6)), "'query' must be a named list") # headers expect_error(wi_th(zzz, headers = list(5, 6)), "'headers' must be a named list") expect_error(wi_th(zzz, headers = list(a = 5, 6)), "'headers' must be a named list") # only accepts certain set of named things expect_error(wi_th(zzz, a = 5), "'wi_th' only accepts query, body, headers") }) test_that("wi_th .list works", { req <- stub_request("post", "https://httpbin.org/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(wi_th(req, .list = 4), ".list must be of class list") expect_error(wi_th(req, .list = list(a = 5)), "'wi_th' only accepts query, body, headers") }) # addresses issue: https://github.com/ropensci/webmockr/issues/107 test_that("wi_th handles QUERIES with varied input classes", { stub_registry_clear() library(httr) enable("httr") # works w/ numeric stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = 30)) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ integer stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = 30L)) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ character stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = "30")) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ number as factor stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = as.factor(30))) expect_is(GET("https://google.com?per_page=30"), "response") # works w/ character as factor stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(cursor = as.factor("ads97as9dfas8dfasfd"))) expect_is(GET("https://google.com?cursor=ads97as9dfas8dfasfd"), "response") # works w/ AsIs stub_registry_clear() stub_request("get", "https://google.com") %>% wi_th(query = list(per_page = I(30))) expect_is(GET("https://google.com?per_page=30"), "response") }) test_that("wi_th handles HEADERS with varied input classes", { stub_registry_clear() library(httr) enable("httr") # works w/ numeric stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30)) expect_is(GET("https://x.com", add_headers(foo=30)), "response") # works w/ integer stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30L)) expect_is(GET("https://x.com", add_headers(foo=30)), "response") # works w/ character stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = "30")) expect_is(GET("https://x.com", add_headers(foo=30)), "response") # works w/ number as factor stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = as.factor(30))) expect_is(GET("https://x.com", add_headers(foo=30)), "response") # works w/ character as factor stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = as.factor("bar"))) expect_is(GET("https://x.com", add_headers(foo="bar")), "response") # works w/ AsIs stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(headers = list(foo = 30)) expect_is(GET("https://x.com", add_headers(foo=30)), "response") }) disable("httr") test_that("wi_th basic_auth", { # crul library(crul) enable("crul") con <- HttpClient$new("https://x.com", auth = auth("user", "passwd")) # pass stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth=c("user", "passwd")) expect_is(con$get(), "HttpResponse") # ignores auth type con$auth <- crul::auth("user", "passwd", "digest") expect_is(con$get(), "HttpResponse") # fail stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth=c("user", "passwd")) con$auth <- crul::auth("user", "password") expect_error(con$get(), "Unregistered") disable("crul") # httr library(httr) enable("httr") # pass stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth=c("user", "passwd")) expect_is(GET("https://x.com", authenticate("user", "passwd")), "response") # ignores auth type expect_is( GET("https://x.com", authenticate("user", "passwd", type = "digest")), "response") expect_is( GET("https://x.com", authenticate("user", "passwd", type = "ntlm")), "response") # fail stub_registry_clear() stub_request("get", "https://x.com") %>% wi_th(basic_auth=c("user", "passwd")) expect_error(GET("https://x.com", authenticate("user", "password")), "Unregistered") disable("httr") }) # cleanup stub_registry_clear() context("wi_th_: defunct") test_that("wi_th_: defunct", { expect_error(wi_th_(), "wi_th", class = "error") }) webmockr/tests/testthat/crul_body_upload_no_list.rda0000644000176200001440000002167713665341057022661 0ustar liggesusers‹í=YpÇu½‹Å ð&AR¤¸¤ÀSÄ.xH”(’"ÅC‚H‰‡(J²d¯»bÄÅÎrf—dÉ¢-ß.F‰+vì$vìØI'qªr”œË9*Uq|%vÅùH*)§Ê‰]ÉOÊtN+ØLϼÞyó¦{fvØ– ¨jìLïêׯßëéé¹pâɽ}Oö1ÆÒ¬£+ÍÒÎe&íüK± ëu~×­z¹0n–f õjÙÔJ…ŠY(vÍi²Ò)ï„ß”“–áv“µZÕ>˜Ïóßq£’3­ËùªÉÛàwV´)Ý&;êVÙù™%Ù¯½‹/ã¤>Àë¤Läñ¿ÿß´hÇyøFs÷æF E³âá dglãyÝù]ÂóŽÞü€ Ôé™0Êú9­6Ih=“?cŒ[š5“?e9^7­+vþBnBÜä/é–m˜;¿/wwþ‚n›u«¨Ûù2´×l=|ìⱋcg¥tñîðdß±ÒåsAq`÷ÕôéZ¾ZÖŒŠGUº5šÒ®riÀum¦ªÓ/–5›öxï„iM¸,½~èiV]z¥h–8¬NÔÓ𛡵»«–qM«éP…+É÷H•~W±' UÓ,#ˆß½ãrÝ×(@¬’é8è'íEÝŽ5€«“àqô¹#$ƒÊøLÍ,?  œËå¼lÀj'-uÒ “Îq^9 ‡Ó¼:$Žx˜çÌv9i Ÿ“¶Qh—Ë¡>…× m9¼>hßÚÞÚmÎ- ¬P‡·åƒŽ g´Y8WAÞf'm^WAÝ»6§g-ÐÆï×ìÛöz€¹œðw†ð·Ê6lfAI„ØSo…†¼àûP(«˜6&HÍ”¢f·aç*õrUçÑ€j³LZ¦ãС Ü´CÑ4£µínïš¶ÆqôcÌ1®ÁPQþÁ¦d¾SÁA—¥×êV…ÔîR‰ÊÒ®'d ["M…í7(= Ý–®•Tg¤Ûøß²0é¨x%–•Œ…^¦î^Þ§ .uˆTìW ¿¬W.»Ó!"k£¬ )¹UXMÉP`u&Ó&Z«Ô›Á µ2}Ã"úU1™8·¼k÷×#˜­ù|®z2Ì7ÓPÏ-OÁèõºný~=á9´ôŠÙXf™>]µtÛîÇ*%}šù~®çâ[ÀÑ-Öœ8oØ»à·ÓË¿]ä÷$ã¢×_(.`@$ gåB“%àp»½û¬¸ï'xûà·×Ëß,òZçÀ<ÒÏà÷àpϸiæû Q©RI^/Jý$ rž–$L+QZ‘Ö@‚´¥õió|‹¤ O+üÔR? g3Ô¦¿èG…I­R¾²Ô wC(°È¸ò+ÝqK¿Z×yìÆf3Á¢)íŠ^h–s¿w€ú½³Z¯·éÞ>É\õLM‚Š *mÕâ¿|ølc¾ºrUÜ˼áćçóÔ’ãà®â}‹ÃæÖn3© C­Y—»®OAÝhánäP»­Ìs!W=+€¦Q¨Ç¯÷± {¼šùîôP'Þv R¹õÌwk7A>¯³Žù.¬ ×»Ñžš9%Î;Þ έç0ð¡Çð±êo“ÀÜI`î8üw‚y'Àv9¨¿xâ}ð!àøßü¾YïGøï†öwfÁ0à´»ÇI÷ŽƒNús ç> ç0À9$áÿ0üÞuŽÌ£N:†x~úø8ÂêžtÒ)D÷CÐæAæ›Ñ¯Þ‡¡Î¨sà>"‘ã9"dzÀãy'}'BŽœô¢çqhhù. êÂ%À÷$Ô ê?øÞä¤×˜§O3OWžºßìÁLíX€¡Œg¡Þ8’Û8ðÍá::žce•oš¸Ù ×à~Žycú ót¦ t•€Þ)掄ôV€Þ*ü^ºMT_Ðmƒ|¹½ºÁÛ\cÞø¸ŽäÇï§á~û·Âý pÿ"Ü¿ î_‚ûpÿv¸Ü¿ ÷ï„ûwÁý»™?nùý{àþ½p¿x«3O/ßÏ¢zÆ¢cU¬Ü1mZ¤ª*Nm&Iô;DqfT€†YÀé¦ÁBsÒ*öÈ‹‹+I »CB×±$.ÝNhRÒØeל s*‚JJmT7’À6Ô$ôôCmÛHM„†äAb϶ÂlÈä—er›ÖmVrú´Q“pÙŽx@¼–îøG(Y\Þ´…Z©Eè¹®TZ›Y´%Ú¢ff«QÙJD³ KÛ_¦Ààî‚KStÃÑB³­^žP”uNšæ•$6Œ#ÜÊ‚£m[¼|{4‡ÈýaEnQäÇ=sØÁ¢ûkgBöºla1H*á)³ˆ}î$†“+Ëòâ¤^¼RpŒx¡ª¯h—ÉÓ…€æô\×Ç9nK!;ƒH6(UD+iUÒv7 ööH„´xyŽE)Ͳòþ㎴9ôÔt[¸jGEOú-¤n=¥~”p»'‚[çïXÜ<ìi RÍ¥õ¢”g/KدŽÅ­’¶û˜\ñú\-ŸÐkEò-’ZJ5ǰŸE»»‚å÷Qê—!ªz8Ž“ˆGÊ(¶kk¢x¹›õâ@žy°uR¾%õNÅÙ¾{XtÜËäZÐyÙÒ«4hY†*t¿e¢V=˜Ïx£ù?5]Sú£4ÿ>©ùhýC >3ÀPZ¡åp4-~„89IZQPÕki×/šÇ'5‹4¸_ÅÆÖ^ØJêe-uÅ™*r8Ç‚pn£ì-aÁ[%JìX´zWð›~áRóD°&ÝÄqZÅÝI†Ã‡IÍSŠš•b°£Tè’+Nß’ê<ª÷ð\g™[ÀËë?¤TWY«VË3¤ö ZÖ‡ƒ­ƒUͲõ‚:ncÐ-Øë—kFµ¹Àåúš‚‹4B¾qrçŸ&8Ã"®N=T«U/„çEçïÕ¿fL9¡­YLDc¢ÁÕ%ÕµÞíZ{LU¿]Óju»àm±tI{´5ÐO¨@/ )–Éu4U$íû·ukäØe½"Ö¹ÎEPÆËÏ·&Ô}q.@oÝ¡@hEŽðBkÈìfy™ð9ˆÌSÈ,SÖA+Åa¯¢° Z¹ŒÚ§Y2& ]hëÅh>©JT4tÖ oÏ7úxk@ŸUí.š•š¯$—Z«°{¢FÖ,4‰ØZêã;Æp+Ï{ÉÄö n,ñÖÞ1ÀÁŸm‰çüŒùÏÏÄî®àA»¼vˆ{¼Ç¬ï†ß^<_)Ã-mo™ ý„~ØfµSÜwýè{ùÐö­&=Džý,¸Ýk)¡w ó·[‰íhNù¢| ïrk屌kwÃû0WH`Šg$4?ô|„Xž°Ç„tI'®$Bƒ¶£@¨;8’t"ùkK »%ô3Ö(.í· ¾ 9³† ±›Ð8ºR°êÌq®óî÷‹ûµð;¿kà÷6IÇ…DðšëÛà|Cóý Å9Çu»„éC^ycÌl 2s`!™ÉzpîÝ·EÂZs¬ +ëŒUÀgI¼æ$Þ~䊑u‡wŸö ÔÃÞýaÌîÀ bTášsÁfBÇvD¿ßæÝo÷[Y¢Ý¯Ã¸þ<îÞ="àîôîï÷;¼û£â~—¤+ñ‚*¯““Ô!‹ª¼Úˆú„½Û»?&îï„ß=^þI‘?Ú¢¨FçQT^Þk÷ €¿¯EzöÍo×p÷Âï]².B«y¼Î~ø=àÁxHÀ¸;/§pýyäeLÀ½WÂZøkÕøDd‹ùv¡Œß=œ‡+‡˜opùý}Þýq„…} ¼©7ÍüͽÛPWtBûû½ûGmÈåhP. 6)ºz[€&Ì— í˜wï®ú-aá,AgÏ0qs¡•ú_ þZUóÓ¢ïÃïqø=ᕟå§XxtòE?î ôAJ¡(:;'[„Ä!¾ ®€7/…ò‘dx¾¬w8õ'á÷¯ì¼àŠ/Ó à.9Õˆøåš vȉ­ \ëùœ¾ ÆšÓðÇXÐíX"E¥ÛOóXÃfwޱyµ†áá¸â†ßQ)Á_[C7‚ÿ‹¸cçs¦…ýÝ øgà÷4kÝÔ=Âþï¥ c.ái¦U:e“üÄÒù¦oˆÅ;ßüZlÙåî&à ×ï•PG]¬œõîŸj þàùç½û}âþœwÿ4Ô{“È¿ÀÂSÕР d=~-KV·¥9ÊõI,W:å‰)]6å=æÝ¿·wM—â16ãn¡¦U‡ŽgZåëô<òåÔK;ãñ" ŒÇÂŽÇB;ô=¤ïÙ¤ïÙv軤O[@ú4¼ŒÖJD6ŸzpR“7|yD%l—º!a[$B±õ_$Qw%î„-eþvû.\G]‘ áúôuÖ51i]Â$h߈ŸK²6£´%& 'H›IÚ“v$L»PÚ“ò(BÚƒÒ>”î’¤NDÅ„",PVzœî®™fÙ&ð0]O ¾^\¶ëãu1ýŒ-ÉíØºw´5A6›öj¥RA(›SX’I­GF>Ú@.é¥=¡^òFÞŽ–&Q©iµæo Ýz^–P3>,½bCÂЙDºôiÃûꟓ(ŸÐé¥ h Kúé§@´1 Åõs*±jO%áÑu(Qp‡³¦ésŸ‰§àß#¿4W(è~€‘ós­PðuÃ}LÆ–3Ò¤§j™—¹yöQ`K{@Õ.£Õ]Ë++ëv`Nî¾TǺâc׫ºæ ñvÅh“EØ|ùÓâ Ä„ [÷Jc~¸ýi¸Îˆü˜sϯÍa½ˆà(‰úDÛ‚¥Òš]pýS(o¦ ÞY´æË-<ø)@x”4àýðQõá“…Œìaú® ?ןI¼ÍkZ¹I¼«]èú'áú#ÄZÅYå4*§À—|dpl4L\Õ¢# —–'±þƒ<(ÝSh:óbê ÍsžçTW¹KÉN¸]s£o»l^©Šõr"EEг6¢U+2I° ³zõó+Tw@l6âôñçÉ(Lצ+ÄȲ¦›[hÆmt~éóJr¥J•Êg a\úÂ÷.I¯‘È)’Ÿ% |‰ ËÜÍQ)Cù ÿ“ ?à ­>%tiê? ŸˆÃ‘öMì'¡?ºÆõÄ'QÞ/´¢Å Ù'ö'’àXè>Œ15ŸH(Ç8 3ï4·©JÂÃq¨|­Z—èP… Rýj“oÜf ¾›„ïáú‰ìµ;ÇÆÌ®®6þ=µøZÓH0±~S19忘ÐX| ò>aêe,þ’JüT©‘6äÜÂŽÓ$ 5±:ÖÕÂÌ'm}E³:“tÞúºnBòìúqRóñnðÓp^*°Qk%ûPläÐí=S§]¿R³ÝÃ{£û©s €ù)Ëâû‰²5u=Wø²“Qšöëà9ã=èú>t-yû,ÑŽ§De>íçw .j®±ÒùS˜8åù¬Ì褞þF„éÅê$ï3ILvŸV¬×ô ¤ýç«×ðqL*ù6e5fs]èðbú¨¸"Ý¢– õT…?GDñ› EHÛaµ ÀLJªÜȾîšBÆ+–2A¶A÷Ø<6öȹ3c§žb‰B¨wH(i%tQM»¿š˜ÿ3íþŒ„ç<ÒÎßÃCOÏÀ8…вVãÄa´½Š–È>‹Õ%ªÜ¿–W“_o°ÈÑ”Tq_Ey¿ÓP«ê«Hº¯‚ªþ.¦!B5e¸ê$OfÏÞ!i×J,dð«12ð'^ïp4²Ÿë<&16ï-CMáÚ8›ÖkØ…æ lPIº¸œâs8Ÿ"N»~ å‰ME¿/‘«Ìe|\>bxâÑñ’熑FÞ^ó9GÔó :s0”áËLõT¼ýž„§H‹B¬•¡¯_e³xEiÐ,B²jÑ)J¯Î³(Šâ$4%ÒQ†;Âä|áy¸Å¡p#BF²hï3ÖloFÀS3QKQ¼í‰ˆ¶‘Á”BwÚåûWÒž$ þ‘Ž\1]ÒÁÁáÂYÚ^ÆLþ~˜„£1ûŒ3~u0Ý“ï5ó’FXŸRp·àáúgc ëÁuhÝ@‚ï1ø‰¢ç-C¬ôL­ì}‘¾Wg¹hg®[ŽCÜŒ°”S_ÌãyLé'¥4­ÀÓæT&¼›œ¾¹ûTZeÐÒ/çšL%ú…ÝäjVàªI0¡µëÓOÏCŸ~åá®s{!¦ÇTKB‘=©¼ÓŠí, Ðñ"jJ†‰èÔ?kDtcî^ o6œÿQBƒW¼äÐË?Ë §öãÄ›Püº³H`&$}µ]Ñoƒð;Nˆåbû*~ûŽã.6|Ü%ÔÖ׉0ÒoUù§Á'2J…±/qE ¥,Ê–LNÕËdÞRˆ{ ©ÉMš}È!q™·µ™èÛ,–^ã/ŽÉßf¹¦»Ò†ÈaUƒ…—ûªZÝÖ Ü±ÐÔ)¯fÑý&ˆ[ñè£Q§Ü¯ÇK ºGxz¤jºå´æ±ûÊÉ,Ý$ï2픕gä;z]sí¨B¯Ñ«"5'枨˜²*†ãç0iÅš0Ý_$ /[$ ÔqùdþQ“¿BíE×bákß ÍWY’&ƒ\Ü“üJSd,ç´šY6¯‡ø [ÐôuÉ0ôœBõ¿׫$õU»í’\¿GÆNúÈa?w;¡æ‰POQõ†ŽWƒðštü¯È†³¶L ¾J´ )ί&Ä)´øY‘§ÒZEûMpý—ðû%…ÖDº†ik’)¹z&FWTësBÕÿFæPô»vdD›¨6S'%¸—Û˜?>\¢w}š«Ô§tË ¼V©I0@^JÊôêé˱¬ecʨð׊·1+©œ boKÌ˃½¯½)Ø“ ü›(ï}* …ò_Fuÿv^”C«ò3v@æÞ)“½ðe2Ä7à|1´Æ ˆ§ª©ü‹ 6Í´êcAŒšü;ÜÙüËàa¼\–¿“ %µ QìV¿«_ÈHÄh»ê¡à{‰’Y|D§Ú¯ôMIø¶€k‚]öÞÆ•#æA™[úÐ.sïÑ\™BuÚý=±¸2!g@_‚¶¼÷D> pÄx ZþàIf¯¯@[>«|®¹B¾¾Ë38®œ쫺üÿTæ°aã¯áz¾}±ïä¾Zû—>Z×$Ù™ªiËò;ªuYvgUó?±† ºJzY—> Îðó0e  $H:–°3ñ ‰ØþA¢÷Ò×ô†¶symo¾¥gVœ4q0ë7ó¹ªjvMõvÍrY«º FÞ k#VdNnˆ½6½Ú°KÂ2蛤¡wœöûK ü„T÷£“÷‹„ "ŽÀq#sˆÞUå{PyòJq z†=¡7c‹ŽÚ˜Sþ ô]èä±4È«˜ãf‰+z+ûÒ–&¡âÀ }™†ƒ0qt‹UÄÛ,:ñB"¯ µSùtÒQŠI | HÑIà ¤±Àû8ðý¨UºÆúm«Ië.ùâ €»©ÜÓD=ýÖ; JS£–¡“¡P{TõšQ¦UŸû‰¢™3ÞG%G…â) 9¡þS”[1åWQù*Ú+ÆáÔîÛ*;לZ±t=èzºÞ‰®ûè(ìõ¾Í¦YµxsùOÔ<¿Žì"ZE³ôj,œšŒÐ·Õ€Ð‡Š±XîÅ(ác˜Ê1áÚøß¡èY»¨îNÒ®mžÕ¢†Î“†þk£=…ü7Ù$ƒýÞ7¤úyþþ¢òý8*Ÿ‹½!UÏ AÓ‹º÷ã¨{h}à ©|Þ²H+º§Ò·7’:aµH|‚Ó~ìùÏ~äÃÏ=ô¤$A1ŽMýÅ–’>Q€¥¤#¥D:þƒÓŠiM¡ïµ$l¿/ËS:¬øó/ÿ‹ g‚n ¿¿ßUtí:–•WQ¹*BnIhIK¬ÖMå^¯Æ¾Ï¨5ÃÛl• ¾ ËûÃèÚB×WÑõt½]WÑõáˆù@Æyh? ” !y ¾,ñN°’ïRôLìÁyÝS†m77vG 7íÈÚ¶òfÊ‘»E‡jäÅÁTÑ÷²v-Ò!kÛŽ<¬6䡲4q0ãäaIxJrÖ¼?‰•IÝ2Ä%›Ÿ:ù‘Ê’çB±Ç/ÃYÌY£âLþã‰l±¬Ùvàòq³%67·*̨ξÚFg«¦8˜q}UÒÙIéµÃW•´‘>\êr:S·j¨Õô}à„ÄWBàCSß;Zå2FѨrCã`Æ þ€DðIéµÃ÷ʼnÿÂõh×fÊ¡§øi¨heäÉàgÇò§ãÞiv—·­7ˆ/-ã£ùá`Lu>¾*té”t«p‚ú*ܱ†v]E×KðØ<ë.kZY!¨¤Ö5NI'T’à •D…ï¿¥Ó?ÇÎb¤´ ˜RálØ>išWl{–åJY¦Hù´@«ìˆ&QšŽl#-ÂzVèµ”å=õŠ]¯òÃv6Ý£œ)8+äÀù>˜å› ³€ÚÝA¬ȳMXɤåGÍFåšaó~ÏS5é ¾â~«"ᩚ¸+þ®Ÿ“ÉB!‰ü†\I5F´¶ަ6LÖ”v‡ŸLYî38`‡â'ÚÒQÔd*·âPѪ—³E³RÑ]¦déŽ>ÛÝ«†¥ú‚œ¾†þ£Tç³ÜLá>qGGÙTÙ:†Ì¶Ç-ÊÑW;8Ûÿ×HÊ+®´,›-ºv¸êêÍÁlB`/0Ù •‘ñb´¼&ëùnÛÕŸ Ý}Yço«CïVÉIز%!Fõ&g\ †_øŽ–á\ÚýÙ,„!‰{ëb6‚hYô%•x§»kMB\'—÷ˆ¤E¦êû?q˜‰)JD=Ù,ÿ¢Î¼É'6(jj"_ù¬^ùÊ iCF?•bB:R©ÄŠ–”’—’lm¦ªcãÖ²`zør<|åh>G¬¬/˜=’Eª®œ•Ñ8'D±·b€p 5w¤š÷\cä~ó ëG\ Šçe’êuôû9m{ÙžéHÇFÀYÂÂ{©%šÒªæÅ…'±š·Bhž­ëÙaW0­k ¥¢uM",ü/F éùæ/Ób=äXŽãeƒ?L‚«î–·å«òiþQ´Nø¥"Y+ù(ZÞ{ü¼¢áÁHSünÜ.‹Õ1`x†í"åߓËèŽOÛÀWrà2Ÿ–z)ó>”tŽ?]Í?A+>Ï᎞@ÝÏ óÏoógh—Ë¡>…× m‡€Þm€W´½µÚ6[€ÿP‡·åã` ó>ÓÌÛ¬œ« Úx;ðº êÞ°9=k6~¿`ß°×Ìå„¿3„¿P¶ dÃeËиá÷ß÷òpùZž –ár.æÀ˜%íÒÁvkeípýŽ`ýu¤~7¹¾à¾ÑÌP)þÅX2ܶÃeg°ÝzÊUW°ü6 'ŠÎî`» „žOO°þíQÒ¦Òë°´ëÁâ•221ºÞ1òò¾`ù&ZÞ,ÏÊØ£x)]’n )÷@°|sÒndÉ•—ÊI%7ÊW àÜò®Ý_æ]¯ù|P¬z2Ì7†PÏ-OÁàõá»ö,sb&ûŽ2ó¿-d·€£[@Q ”úHŒÿvzù·‹üžd\tâú Å({rV.9)P·Û»ÏŠû~‚·~{½üÍ" EqÌ#ý ~o~÷›fþLÝ*•z u„áõ¢ÔOÒ)çiI´¥Õi ¤!HkQZ‘60oßHÚð´ÂO-õƒëi½ù-è’à£Ù²1ÎW¨òrwíÏf­÷nn_–¯ÿåGs÷æF‰‹— xoÐXNDÙ\]õòVòò C/—lãy½P֬˺lÕ,x€„¶¾š>]ËWËš{.¼ü¼QÝ-éeïì]\8ÊI5Ч$ÿœmVvg]@ÓSåÝY\æfìÊï"ìu–Ž›•šCáÈE'Ї¼¥ÇŠE½Z9Y)šî±{àázÙ,àV7vJ\b8µ–?`y°¹ö½A]O„>àaᯧ‘à]çE×™-ºÎ^ù¢ë¼è:‹üE×™p±è:/ºÎ‹®s[®³ÔOlË ö½Þ‹ðz›ŽiØßK°÷•]¸®êŽ"rÁ–z›ïìt$âÕ%IÞpÞéMá]’wÌœògògŒqK³fò§,mJ¿nZWìü…Ü„¸É_rYÆÉëçe¯Q”Q/Ù‰ôš„ó{øèô¢ ðl0-Fl1ÒXŒ4¢è\Œ4Bx)]‹‘Æb¤±i$çb¤ñ†4é_Ç‹ôlöÿ§”$íŠâwebmockr/tests/testthat/test-RequestPattern.R0000644000176200001440000001373213733440147021167 0ustar liggesuserscontext("RequestPattern") test_that("RequestPattern: structure is correct", { expect_is(RequestPattern, "R6ClassGenerator") aa <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") expect_is(aa, "RequestPattern") expect_null(aa$body_pattern) expect_null(aa$headers_pattern) expect_is(aa$clone, "function") expect_is(aa$initialize, "function") expect_is(aa$matches, "function") expect_is(aa$method_pattern, "MethodPattern") expect_is(aa$to_s, "function") expect_is(aa$uri_pattern, "UriPattern") }) test_that("RequestPattern: behaves as expected", { aa <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") rs1 <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get") rs2 <- RequestSignature$new(method = "post", uri = "https://httpbin.org/get") rs3 <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) expect_true(aa$matches(rs1)) expect_false(aa$matches(rs2)) expect_false(aa$matches(rs3)) expect_is(aa$to_s(), "character") expect_match(aa$to_s(), "GET") expect_match(aa$to_s(), "httpbin.org/get") }) test_that("RequestPattern: uri_regex", { x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org") expect_is(x$uri_pattern, "UriPattern") expect_equal(x$uri_pattern$to_s(), "https?://.+ossref.org") expect_equal(x$to_s(), "GET https?://.+ossref.org") }) test_that("RequestPattern fails well", { expect_error(RequestPattern$new(), "one of uri or uri_regex is required") x <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") expect_error(x$matches(), "argument \"request_signature\" is missing") expect_error(x$matches("adfadf"), "request_signature must be of class RequestSignature") }) context("MethodPattern") test_that("MethodPattern: structure is correct", { expect_is(MethodPattern, "R6ClassGenerator") aa <- MethodPattern$new(pattern = "get") expect_is(aa, "MethodPattern") expect_is(aa$pattern, "character") expect_equal(aa$pattern, "get") expect_true(aa$matches(method = "get")) expect_false(aa$matches(method = "post")) expect_error( expect_is(aa$matches(), "function"), "argument \"method\" is missing" ) }) context("HeadersPattern") test_that("HeadersPattern: structure is correct", { expect_is(HeadersPattern, "R6ClassGenerator") aa <- HeadersPattern$new(pattern = list(a = 5)) expect_is(aa, "HeadersPattern") expect_is(aa$pattern, "list") expect_named(aa$pattern, "a") expect_true(aa$matches(headers = list(a = 5))) expect_false(aa$matches(headers = list(a = 6))) expect_false(aa$matches(list())) # with pattern empty bb <- HeadersPattern$new(pattern = list()) expect_true(bb$matches(list())) expect_error( expect_is(aa$matches(), "function"), "argument \"headers\" is missing" ) expect_equal(aa$to_s(), "a=5") }) context("BodyPattern") test_that("BodyPattern: structure is correct", { expect_is(BodyPattern, "R6ClassGenerator") bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( body = list(foo = "bar", a = 5) ) ) aa <- BodyPattern$new(pattern = list(foo = "bar")) expect_is(aa, "BodyPattern") expect_is(aa$pattern, "list") expect_named(aa$pattern, "foo") expect_false(aa$matches(bb$body)) aaa <- BodyPattern$new(pattern = list(foo = "bar", a = 5)) expect_true(aaa$matches(bb$body)) # with pattern empty bb <- BodyPattern$new(pattern = list()) expect_true(bb$matches(list())) expect_error( aa$matches(), "argument \"body\" is missing" ) expect_equal(aa$to_s(), list(foo = "bar")) }) context("UriPattern") test_that("UriPattern: structure is correct", { expect_is(UriPattern, "R6ClassGenerator") aa <- UriPattern$new(pattern = "http://foobar.com") expect_is(aa, "UriPattern") expect_is(aa$pattern, "character") expect_false(aa$regex) expect_match(aa$pattern, "foobar") # matches w/o slash expect_true(aa$matches("http://foobar.com")) # and matches w/ slash expect_true(aa$matches("http://foobar.com/")) # fails well expect_error( expect_is(aa$matches(), "function"), "argument \"uri\" is missing" ) # regex usage z <- UriPattern$new(regex_pattern = ".+ample\\..") expect_is(z, "UriPattern") expect_is(z$pattern, "character") expect_true(z$regex) expect_true(z$matches("http://sample.org")) expect_true(z$matches("http://example.com")) expect_false(z$matches("http://tramples.net")) # add query params usage z <- UriPattern$new(pattern = "http://foobar.com") expect_equal(z$pattern, "http://foobar.com") z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) expect_equal(z$pattern, "http://foobar.com?pizza=cheese&cheese=cheddar") ## query params in uri only z <- UriPattern$new(pattern = "http://foobar.com?pizza=cheese&cheese=cheddar") expect_equal(z$pattern, "http://foobar.com?pizza=cheese&cheese=cheddar") ## before running add_query_params(), query_params_matches() of UriPattern won't match expect_false(z$matches("http://foobar.com?pizza=cheese&cheese=cheddar")) z$add_query_params() ## after unning add_query_params(), we should match expect_true(z$matches("http://foobar.com?pizza=cheese&cheese=cheddar")) # matches urls without scheme # - does match with "http" # - does not match with "https" z <- UriPattern$new(pattern = "foobar.com") expect_equal(z$pattern, "http://foobar.com") expect_true(z$matches("http://foobar.com")) expect_false(z$matches("https://foobar.com")) # regex with query parameters z <- UriPattern$new(regex_pattern = "https://x.com/.+/order?fruit=apple") z$add_query_params() # this is done automatically in the pkg expect_is(z, "UriPattern") expect_is(z$pattern, "character") expect_true(z$regex) expect_true(z$matches("https://x.com/a/order?fruit=apple")) expect_true(z$matches("https://x.com/b/order?fruit=apple")) expect_false(z$matches("https://x.com/a?fruit=apple")) }) webmockr/tests/testthat/test-RequestRegistry.R0000644000176200001440000000227213665341057021363 0ustar liggesuserscontext("RequestRegistry") test_that("RequestRegistry: structure", { expect_is(RequestRegistry, "R6ClassGenerator") aa <- RequestRegistry$new() expect_is(aa, "RequestRegistry") expect_is(aa$clone, "function") expect_is(aa$print, "function") expect_is(aa$register_request, "function") expect_null(aa$request) expect_is(aa$request_signatures, "HashCounter") expect_is(aa$reset, "function") }) test_that("RequestRegistry: behaves as expected", { aa <- RequestRegistry$new() aa$reset() expect_length(aa$request_signatures$hash, 0) z1 = RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/") aa$register_request(request = z1) aa$register_request(request = z1) expect_length(aa$request_signatures$hash, 1) expect_equal( aa$request_signatures$hash[[z1$to_s()]]$count, 2 ) expect_output( print(aa), "Registered Requests" ) expect_output( print(aa), "POST: https://www.wikipedia.org/ was made" ) # reset the request registry aa$reset() expect_length(aa$request_signatures$hash, 0) }) test_that("RequestRegistry fails well", { x <- RequestRegistry$new() expect_error(x$register_request(), '\"request\" is missing') }) webmockr/tests/testthat/test-onload.R0000644000176200001440000000123213665341057017451 0ustar liggesuserscontext("onload") test_that("onload: http_lib_adapter_registry", { expect_is(http_lib_adapter_registry, "HttpLibAdapaterRegistry") expect_is(http_lib_adapter_registry, "R6") expect_equal(sort(ls(envir=http_lib_adapter_registry)), c('adapters', 'clone', 'print', 'register')) expect_is(http_lib_adapter_registry$adapters, "list") expect_is(http_lib_adapter_registry$adapters[[1]], "CrulAdapter") expect_is(http_lib_adapter_registry$adapters[[2]], "HttrAdapter") expect_is(http_lib_adapter_registry$clone, "function") expect_is(http_lib_adapter_registry$print, "function") expect_is(http_lib_adapter_registry$register, "function") }) webmockr/tests/testthat/test-RequestSignature.R0000644000176200001440000000257613761547172021526 0ustar liggesuserscontext("RequestSignature") test_that("RequestSignature: works", { expect_is(RequestSignature, "R6ClassGenerator") aa <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") expect_is(aa, "RequestSignature") expect_null(aa$auth) expect_null(aa$body) expect_null(aa$headers) expect_null(aa$proxies) expect_null(aa$fields) expect_null(aa$output) expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$uri, "character") expect_equal(aa$uri, "https:/httpbin.org/get") expect_is(aa$to_s, "function") expect_equal(aa$to_s(), "GET: https:/httpbin.org/get") }) test_that("RequestSignature: different methods work", { aa <- RequestSignature$new(method = "post", uri = "https:/httpbin.org/post", options = list(fields = list(foo = "bar"))) aa$headers <- list(Accept = "application/json") aa$body <- list(foo = "bar") expect_is(aa$method, "character") expect_is(aa$uri, "character") expect_is(aa$headers, "list") expect_is(aa$body, "list") expect_is(aa$fields, "list") expect_named(aa$fields, "foo") }) test_that("RequestSignature fails well", { expect_error(RequestSignature$new(), "argument \"method\" is missing") expect_error(RequestSignature$new(method = "adf"), "'arg' should be one of") expect_error(RequestSignature$new(method = "get"), "argument \"uri\" is missing") }) webmockr/tests/testthat/test-HttpLibAdapaterRegistry.R0000644000176200001440000000261513665341057022744 0ustar liggesuserscontext("HttpLibAdapaterRegistry") test_that("HttpLibAdapaterRegistry: structure", { expect_is(HttpLibAdapaterRegistry, "R6ClassGenerator") aa <- HttpLibAdapaterRegistry$new() expect_is(aa, "HttpLibAdapaterRegistry") expect_null(aa$adapters) expect_is(aa$clone, "function") expect_is(aa$print, "function") expect_is(aa$register, "function") expect_output(print(aa), "HttpLibAdapaterRegistry") }) test_that("HttpLibAdapaterRegistry: behaves as expected", { skip_on_cran() aa <- HttpLibAdapaterRegistry$new() aa$register(CrulAdapter$new()) expect_length(aa$adapters, 1) expect_is(aa$adapters[[1]], "CrulAdapter") expect_equal(aa$adapters[[1]]$name, "CrulAdapter") expect_output(print(aa), "HttpLibAdapaterRegistry") expect_output(print(aa), "CrulAdapter") }) test_that("HttpLibAdapaterRegistry: behaves as expected", { skip_on_cran() aa <- HttpLibAdapaterRegistry$new() aa$register(HttrAdapter$new()) expect_length(aa$adapters, 1) expect_is(aa$adapters[[1]], "HttrAdapter") expect_equal(aa$adapters[[1]]$name, "HttrAdapter") expect_output(print(aa), "HttpLibAdapaterRegistry") expect_output(print(aa), "HttrAdapter") }) test_that("HttpLibAdapaterRegistry 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/R/0000755000176200001440000000000014022547752012274 5ustar liggesuserswebmockr/R/stub_request.R0000644000176200001440000001274414022751250015142 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. #' @param uri_regex (character) A URI represented as regex. required, if `uri` #' not given. See examples #' @return an object of class `StubbedRequest`, with print method describing #' the stub. #' @details Internally, this calls [StubbedRequest] which handles the logic #' #' See [stub_registry()] for listing stubs, [stub_registry_clear()] #' for removing all stubs and [remove_request_stub()] for removing specific #' stubs #' #' 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 #' #' @section Matching URI's: #' - Trailing slashes are dropped from stub URIs before matching #' - Query parameters are dropped from stub URIs before matching; #' URIs are compared without query parameters #' #' @section Mocking writing to disk: #' See [mocking-disk-writing] #' @seealso [wi_th()], [to_return()], [to_timeout()], [to_raise()], #' [mock_file()] #' @examples \dontrun{ #' # basic stubbing #' stub_request("get", "https://httpbin.org/get") #' stub_request("post", "https://httpbin.org/post") #' #' # any method, use "any" #' stub_request("any", "https://httpbin.org/get") #' #' # list stubs #' stub_registry() #' #' # request headers #' stub_request("get", "https://httpbin.org/get") %>% #' wi_th(headers = list('User-Agent' = 'R')) #' #' # request body #' stub_request("post", "https://httpbin.org/post") %>% #' wi_th(body = list(foo = 'bar')) #' stub_registry() #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' crul::mock() #' x$post('post', body = list(foo = 'bar')) #' #' # add expectation with to_return #' stub_request("get", "https://httpbin.org/get") %>% #' wi_th( #' query = list(hello = "world"), #' headers = list('User-Agent' = 'R')) %>% #' to_return(status = 200, body = "stuff", headers = list(a = 5)) #' #' # list stubs again #' stub_registry() #' #' # regex #' stub_request("get", uri_regex = ".+ample\\..") #' #' # set stub an expectation to timeout #' stub_request("get", "https://httpbin.org/get") %>% to_timeout() #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' res <- x$get('get') #' #' # raise exception #' library(fauxpas) #' stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPAccepted) #' stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPAccepted, HTTPGone) #' #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' stub_request("get", "https://httpbin.org/get") %>% to_raise(HTTPBadGateway) #' crul::mock() #' x$get('get') #' #' # pass a list to .list #' z <- stub_request("get", "https://httpbin.org/get") #' wi_th(z, .list = list(query = list(foo = "bar"))) #' #' # just body #' stub_request("any", uri_regex = ".+") %>% #' wi_th(body = list(foo = 'bar')) #' ## with crul #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' crul::mock() #' x$post('post', body = list(foo = 'bar')) #' x$put('put', body = list(foo = 'bar')) #' ## with httr #' library(httr) #' httr_mock() #' POST('https://example.com', body = list(foo = 'bar')) #' PUT('https://google.com', body = list(foo = 'bar')) #' #' #' # just headers #' headers <- list( #' 'Accept-Encoding' = 'gzip, deflate', #' 'Accept' = 'application/json, text/xml, application/xml, */*') #' stub_request("any", uri_regex = ".+") %>% wi_th(headers = headers) #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org", headers = headers) #' crul::mock() #' x$post('post') #' x$put('put', body = list(foo = 'bar')) #' x$get('put', query = list(stuff = 3423234L)) #' #' # many responses #' ## the first response matches the first to_return call, and so on #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(status = 200, body = "foobar", headers = list(a = 5)) %>% #' to_return(status = 200, body = "bears", headers = list(b = 6)) #' con <- crul::HttpClient$new(url = "https://httpbin.org") #' con$get("get")$parse("UTF-8") #' con$get("get")$parse("UTF-8") #' #' ## OR, use times with to_return() to repeat the same response many times #' library(fauxpas) #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(status = 200, body = "apple-pie", times = 2) %>% #' to_raise(HTTPUnauthorized) #' con <- crul::HttpClient$new(url = "https://httpbin.org") #' con$get("get")$parse("UTF-8") #' con$get("get")$parse("UTF-8") #' con$get("get")$parse("UTF-8") #' #' # 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)) { stop("one of uri or uri_regex is required", call. = FALSE) } tmp <- StubbedRequest$new(method = method, uri = uri, uri_regex = uri_regex) webmockr_stub_registry$register_stub(tmp) return(tmp) } webmockr/R/StubbedRequest.R0000644000176200001440000002510513750077436015367 0ustar liggesusers#' @title StubbedRequest #' @description stubbed request class underlying [stub_request()] #' @export #' @seealso [stub_request()] #' @examples \dontrun{ #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$method #' x$uri #' x$with(headers = list('User-Agent' = 'R', apple = "good")) #' x$to_return(status = 200, body = "foobar", headers = list(a = 5)) #' x #' x$to_s() #' #' # many to_return's #' x <- StubbedRequest$new(method = "get", uri = "httpbin.org") #' x$to_return(status = 200, body = "foobar", headers = list(a = 5)) #' x$to_return(status = 200, body = "bears", headers = list(b = 6)) #' x #' x$to_s() #' #' # raw body #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$to_return(status = 200, body = raw(0), headers = list(a = 5)) #' x$to_s() #' x #' #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$to_return(status = 200, body = charToRaw("foo bar"), #' headers = list(a = 5)) #' x$to_s() #' x #' #' # basic auth #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$with(basic_auth = c("foo", "bar")) #' x$to_s() #' x #' #' # file path #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' f <- tempfile() #' x$to_return(status = 200, body = file(f), headers = list(a = 5)) #' x #' x$to_s() #' unlink(f) #' #' # to_file(): file path and payload to go into the file #' # payload written to file during mocked response creation #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' f <- tempfile() #' x$to_return(status = 200, body = mock_file(f, "{\"foo\": \"bar\"}"), #' headers = list(a = 5)) #' x #' x$to_s() #' unlink(f) #' #' # uri_regex #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$method #' x$uri_regex #' x$to_s() #' #' # to timeout #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$to_s() #' x$to_timeout() #' x$to_s() #' x #' #' # to raise #' library(fauxpas) #' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org")) #' x$to_s() #' x$to_raise(HTTPBadGateway) #' x$to_s() #' x #' } StubbedRequest <- R6::R6Class( "StubbedRequest", public = list( #' @field method (xx) xx method = NULL, #' @field uri (xx) xx uri = NULL, #' @field uri_regex (xx) xx uri_regex = NULL, #' @field 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, #' @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)) { stop("one of uri or uri_regex is required", call. = FALSE) } self$uri <- uri self$uri_regex <- uri_regex if (!is.null(uri)) self$uri_parts <- parseurl(self$uri) }, #' @description print method for the `StubbedRequest` class #' @param x self #' @param ... ignored print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" method: ", self$method), sep = "\n") cat(paste0(" uri: ", self$uri %||% self$uri_regex), sep = "\n") cat(" with: ", sep = "\n") cat(paste0(" query: ", hdl_lst(self$query)), sep = "\n") if (is.null(self$body)) cat(" body: ", sep = "\n") else cat(sprintf(" body (class: %s): %s", class(self$body)[1L], hdl_lst(self$body)), sep = "\n") cat(paste0(" request_headers: ", hdl_lst(self$request_headers)), sep = "\n") cat(" to_return: ", sep = "\n") rs <- self$responses_sequences for (i in seq_along(rs)) { cat(paste0(" - status: ", hdl_lst(rs[[i]]$status)), sep = "\n") cat(paste0(" body: ", hdl_lst(rs[[i]]$body)), sep = "\n") cat(paste0(" response_headers: ", hdl_lst(rs[[i]]$headers)), sep = "\n") cat(paste0(" should_timeout: ", rs[[i]]$timeout), sep = "\n") cat(paste0(" should_raise: ", if (rs[[i]]$raise) paste0(vapply(rs[[i]]$exceptions, "[[", "", "classname"), collapse = ", ") else "FALSE" ), sep = "\n") } }, #' @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 if (!is.null(basic_auth)) { headers <- c(prep_auth(paste0(basic_auth, collapse = ':')), headers) } 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 connetion 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") stop("'to_return' only supports connections of type 'file'") structure(bod_sum$description, type = "file") } else { body } self$response_headers <- headers # FIXME: for then change, remove eventually body_raw <- { if (inherits(body, "mock_file")) { body } else if (inherits(body, "logical")) { if (!body) { raw() } else { webmockr_stub_registry$remove_request_stub(self) stop(paste0("Unknown type of `body`: ", "must be NULL, FALSE, character, raw or list; stub removed"), call. = FALSE) } } 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) stop(paste0("Unknown type of `body`: ", "must be numeric, NULL, FALSE, character, json, ", "raw, list, or file connection; stub removed"), call. = FALSE) } 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", toupper(self$method), url_builder(self$uri %||% self$uri_regex, 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 { "" } )) } ), 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 ) } ) ) basic_auth_header <- function(x) { assert(x, "character") stopifnot(length(x) == 1) encoded <- base64enc::base64encode(charToRaw(x)) return(paste0("Basic ", encoded)) } prep_auth <- function(x) { if (is.null(x)) return(NULL) if (!is.null(x)) { list(Authorization = basic_auth_header(x)) } } webmockr/R/adapter-crul.R0000644000176200001440000000566014022756516015011 0ustar liggesusers#' Build a crul response #' @export #' @param req a request #' @param resp a response #' @return a crul response build_crul_response <- function(req, resp) { # prep headers if (grepl("^ftp://", resp$url %||% "")) { # in case uri_regex only headers <- list() } else { hds <- resp$headers if (is.null(hds)) { hds <- resp$response_headers headers <- if (is.null(hds)) { list() } else { stopifnot(is.list(hds)) stopifnot(is.character(hds[[1]])) hds } } else { hh <- rawToChar(hds %||% raw(0)) if (is.null(hh) || nchar(hh) == 0) { headers <- list() } else { headers <- lapply(curl::parse_headers(hh, multiple = TRUE), crul_headers_parse) } } } crul::HttpResponse$new( method = req$method, # if resp URL is empty, use URL from request url = resp$url %||% req$url$url, status_code = resp$status_code, request_headers = c('User-Agent' = req$options$useragent, req$headers), response_headers = { if (all(hz_namez(headers))) headers else last(headers) }, response_headers_all = headers, modified = resp$modified %||% NA, times = resp$times, content = resp$content, handle = req$url$handle, request = req ) } #' Build a crul request #' @export #' @param x an unexecuted crul request object #' @return a crul request build_crul_request = function(x) { headers <- x$headers %||% NULL auth <- check_user_pwd(x$options$userpwd) %||% NULL if (!is.null(auth)) { auth_header <- prep_auth(auth) headers <- c(headers, auth_header) } RequestSignature$new( method = x$method, uri = x$url$url, options = list( body = pluck_body(x), headers = headers, proxies = x$proxies %||% NULL, auth = auth, disk = x$disk %||% NULL ) ) } #' @rdname Adapter #' @export CrulAdapter <- R6::R6Class("CrulAdapter", inherit = Adapter, public = list( #' @field client HTTP client package name client = "crul", #' @field name adapter name name = "CrulAdapter" ), private = list( pluck_url = function(request) request$url$url, mock = function(on) crul::mock(on), build_request = build_crul_request, build_response = build_crul_response, fetch_request = function(request) { private$build_response(request, webmockr_crul_fetch(request)) }, request_handler = function(request) vcr::RequestHandlerCrul$new(request), update_vcr_disk_path = function(response) { write_disk_path <- vcr::vcr_configuration()$write_disk_path # if crul_resp$content is character, it must be a file path (I THINK?) if (is.null(write_disk_path)) { stop("if writing to disk, write_disk_path must be given; ", "see ?vcr::vcr_configure") } response$content <- file.path( write_disk_path, basename(response$content) ) response } ) ) webmockr/R/headers.R0000644000176200001440000000242113270175254014027 0ustar liggesusers# 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/R/zzz.R0000644000176200001440000001362114022547752013257 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 = "") 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, "list")) { if (is_nested(x)) { # substring(l2c(x), 1, 80) subs(l2c(x), 80) } else { txt <- paste(names(x), subs(unname(unlist(x)), 20), sep = "=", collapse = ", ") substring(txt, 1, 80) } } else { x } } hdl_lst2 <- function(x) { if (is.null(x) || length(x) == 0) return("") if (is.raw(x)) return(rawToChar(x)) if (inherits(x, "form_file")) return(sprintf("crul::upload(\"%s\", \"%s\")", 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]] <- sprintf("crul::upload(\"%s\", \"%s\")", 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, args = NULL) { if (is.null(args)) return(uri) paste0(uri, "?", paste(names(args), args, sep = "=", collapse = "&")) } `%||%` <- 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 assert <- function(x, y) { if (!is.null(x)) { if (!inherits(x, y)) { stop(deparse(substitute(x)), " must be of class ", paste0(y, collapse = ", "), call. = FALSE) } } } assert_gte <- function(x, y) { if (!x >= y) { stop(sprintf("%s must be greater than or equal to %s", deparse(substitute(x)), y), call. = FALSE) } } assert_eq <- function(x, y) { if (!is.null(x)) { if (!length(x) == y) { stop(sprintf("length of %s must be equal to %s", deparse(substitute(x)), y), call. = FALSE) } } } crul_head_parse <- function(z) { if (grepl("HTTP\\/", z)) { list(status = z) } else { ff <- regexec("^([^:]*):\\s*(.*)$", z) xx <- regmatches(z, ff)[[1]] as.list(stats::setNames(xx[[3]], tolower(xx[[2]]))) } } crul_headers_parse <- function(x) do.call("c", lapply(x, crul_head_parse)) #' 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 == "") } } # check for a package check_for_pkg <- function(x) { if (!requireNamespace(x, quietly = TRUE)) { stop(sprintf("Please install '%s'", x), call. = FALSE) } else { invisible(TRUE) } } # lower case names in a list, return that list names_to_lower <- function(x) { names(x) <- tolower(names(x)) return(x) } as_character <- function(x) { stopifnot(is.list(x)) lapply(x, as.character) } last <- function(x) { if (length(x) == 0) return(list()) x[[length(x)]] } vcr_loaded <- function() { "package:vcr" %in% search() } # check whether a cassette is inserted without assuming vcr is installed vcr_cassette_inserted <- function() { if (vcr_loaded()) { return(length(vcr::current_cassette()) > 0) } return(FALSE) } check_redirect_setting <- function() { cs <- vcr::current_cassette() stopifnot("record_separate_redirects must be logical" = is.logical(cs$record_separate_redirects)) return(cs) } handle_separate_redirects <- function(req) { cs <- check_redirect_setting() if (cs$record_separate_redirects) { req$options$followlocation <- 0L if (is.list(req$url)) curl::handle_setopt(req$url$handle, followlocation = 0L) } return(req) } redirects_request <- function(x) { cs <- check_redirect_setting() if (cs$record_separate_redirects) return(cs$request_handler$request_original) x } redirects_response <- function(x) { cs <- check_redirect_setting() if (cs$record_separate_redirects) return(last(cs$redirect_pool)[[1]]) x } webmockr/R/webmockr_reset.R0000644000176200001440000000072113665341057015434 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/StubRegistry.R0000644000176200001440000001066313733453474015100 0ustar liggesusers#' @title StubRegistry #' @description stub registry to keep track of [StubbedRequest] stubs #' @export #' @family stub-registry #' @examples \dontrun{ #' # Make a stub #' stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' stub1$with(headers = list('User-Agent' = 'R')) #' stub1$to_return(status = 200, body = "foobar", headers = list()) #' stub1 #' #' # Make another stub #' stub2 <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' stub2 #' #' # Put both stubs in the stub registry #' reg <- StubRegistry$new() #' reg$register_stub(stub = stub1) #' reg$register_stub(stub = stub2) #' reg #' reg$request_stubs #' } StubRegistry <- R6::R6Class( "StubRegistry", public = list( #' @field request_stubs (list) list of request stubs request_stubs = list(), #' @field global_stubs (list) list of global stubs global_stubs = list(), #' @description print method for the `StubRegistry` class #' @param x self #' @param ... ignored print = function(x, ...) { cat(" ", sep = "\n") cat(" Registered Stubs", sep = "\n") for (i in seq_along(self$request_stubs)) { cat(" ", self$request_stubs[[i]]$to_s(), "\n") } invisible(self$request_stubs) }, #' @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) { stubs <- c(self$global_stubs, self$request_stubs) stubs[self$request_stub_for(req)] }, # response_for_request = function(request_signature) { # stub <- self$request_stub_for(request_signature) # evaluate_response_for_request(stub$response, request_signature) %||% NULL # }, #' @description Find a stubbed request #' @param request_signature an object of class [RequestSignature] #' @return logical, 1 or more request_stub_for = function(request_signature) { stubs <- c(self$global_stubs, self$request_stubs) vapply(stubs, function(z) { tmp <- RequestPattern$new(method = z$method, uri = z$uri, uri_regex = z$uri_regex, query = z$query, body = z$body, headers = z$request_headers) tmp$matches(request_signature) }, logical(1)) }, #' @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 { stop( "Request stub \n\n ", stub$to_s(), "\n\n is not registered.", call. = FALSE ) } }, #' @description Remove all request stubs #' @return nothing returned; removes all request stubs remove_all_request_stubs = function() { self$request_stubs <- list() }, #' @description Find a stubbed request #' @param x an object of class [RequestSignature] #' @return nothing returned; registers the stub is_registered = function(x) any(self$request_stub_for(x)) ) ) 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, "form_file")) 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 headers info for print method 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/to_raise.R0000644000176200001440000000337514022732367014232 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 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, ...) { assert(.data, "StubbedRequest") tmp <- list(...) if (!all(vapply(tmp, function(x) inherits(x, "R6ClassGenerator"), logical(1)))) { stop("all objects must be error classes from fauxpas") } if (!all(vapply(tmp, function(x) grepl("HTTP", x$classname), logical(1)))) { stop("all objects must be error classes from fauxpas") } .data$to_raise(tmp) return(.data) } webmockr/R/onload.R0000644000176200001440000000121413665341057013673 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 and httr adapters # which doesn't require those packages loaded yet x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) x$register(HttrAdapter$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/globals.R0000644000176200001440000000011613242617054014034 0ustar liggesusersif (base::getRversion() >= "2.15.1") { utils::globalVariables(c("vcr_c")) } webmockr/R/query_mapper.R0000644000176200001440000000024113272667167015136 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/Response.R0000644000176200001440000001310213665341057014214 0ustar liggesusers#' @title Response #' @description custom webmockr http response class #' @export #' @examples \dontrun{ #' (x <- Response$new()) #' #' x$set_url("https://httpbin.org/get") #' x #' #' x$set_request_headers(list('Content-Type' = "application/json")) #' x #' x$request_headers #' #' x$set_response_headers(list('Host' = "httpbin.org")) #' x #' x$response_headers #' #' x$set_status(404) #' x #' x$get_status() #' #' x$set_body("hello world") #' x #' x$get_body() #' # raw body #' x$set_body(charToRaw("hello world")) #' x #' x$get_body() #' #' x$set_exception("exception") #' x #' x$get_exception() #' } Response <- R6::R6Class( 'Response', public = list( #' @field url (character) a url url = NULL, #' @field body (various) list, character, etc body = NULL, #' @field content (various) response content/body content = NULL, #' @field request_headers (list) a named list request_headers = NULL, #' @field response_headers (list) a named list response_headers = NULL, #' @field options (character) list options = NULL, #' @field status_code (integer) an http status code status_code = 200, #' @field exception (character) an exception message exception = NULL, #' @field should_timeout (logical) should the response timeout? should_timeout = NULL, #' @description Create a new `Response` object #' @param options (list) a list of options #' @return A new `Response` object initialize = function(options = list()) { if (inherits(options, "file") || inherits(options, "character")) { self$options <- read_raw_response(options) } else { self$options <- options } }, #' @description print method for the `Response` class #' @param x self #' @param ... ignored print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" url: ", self$url), sep = "\n") cat(paste0(" status: ", self$status_code), sep = "\n") cat(" headers: ", sep = "\n") for (i in seq_along(self$request_headers)) { cat(" request headers: ", sep = "\n") cat(paste0(" ", paste(names(self$request_headers)[i], self$request_headers[[i]], sep = ": ")), sep = "\n") } for (i in seq_along(self$response_headers)) { cat(" response headers: ", sep = "\n") cat(paste0(" ", paste(names(self$response_headers)[i], self$response_headers[[i]], sep = ": ")), sep = "\n") } cat(paste0(" exception: ", self$exception), sep = "\n") cat(paste0(" body length: ", length(self$body)), sep = "\n") }, #' @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 <- 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/RequestSignature.R0000644000176200001440000001225113761546473015742 0ustar liggesusers#' @title RequestSignature #' @description General purpose request signature builder #' @export #' @examples #' # make request signature #' x <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") #' # method #' x$method #' # uri #' x$uri #' # request signature to string #' x$to_s() #' #' # headers #' w <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) #' ) #' w #' w$headers #' w$to_s() #' #' # headers and body #' bb <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list( #' headers = list(`User-Agent` = "foobar", stuff = "things"), #' body = list(a = "tables") #' ) #' ) #' bb #' bb$headers #' bb$body #' bb$to_s() #' #' # with disk path #' f <- tempfile() #' bb <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(disk = f) #' ) #' bb #' bb$disk #' bb$to_s() RequestSignature <- R6::R6Class( 'RequestSignature', public = list( #' @field method (character) an http method method = NULL, #' @field uri (character) a uri uri = NULL, #' @field body (various) request body body = NULL, #' @field headers (list) named list of headers headers = NULL, #' @field proxies (list) proxies as a named list proxies = NULL, #' @field auth (list) authentication details, as a named list auth = NULL, #' @field url internal use url = NULL, #' @field disk (character) if writing to disk, the path disk = NULL, #' @field fields (various) request body details fields = NULL, #' @field output (various) request output details, disk, memory, etc output = NULL, #' @description Create a new `RequestSignature` object #' @param method the HTTP method (any, head, options, get, post, put, #' patch, trace, or delete). "any" matches any HTTP method. required. #' @param uri (character) request URI. required. #' @param options (list) options. optional. See Details. #' @return A new `RequestSignature` object initialize = function(method, uri, options = list()) { verb <- match.arg(tolower(method), http_verbs) self$method <- verb self$uri <- uri self$url$url <- uri if (length(options)) private$assign_options(options) }, #' @description print method for the `RequestSignature` class #' @param x self #' @param ... ignored print = function() { cat(" ", sep = "\n") cat(paste0(" method: ", toupper(self$method)), sep = "\n") cat(paste0(" uri: ", self$uri), sep = "\n") if (!is.null(self$body)) { cat(" body: ", sep = "\n") if (inherits(self$body, "form_file")) { cat(paste0(" ", sprintf("type=%s; path=%s", self$body$type, self$body$path)), sep = "\n") } else { cat_foo(self$body) } } if (!is.null(self$headers)) { cat(" headers: ", sep = "\n") cat_foo(self$headers) } if (!is.null(self$proxies)) { cat(" proxies: ", sep = "\n") cat_foo(self$proxies) } if (!is.null(self$auth)) { cat(" auth: ", sep = "\n") cat_foo(self$auth) } if (!is.null(self$disk)) { cat(paste0(" disk: ", self$disk), sep = "\n") } if (!is.null(self$fields)) { cat(" fields: ", sep = "\n") 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(paste0(" ", paste0(paste(names(x), x, sep = ": "), collapse = "\n ")), sep = "\n") } to_string <- function(x) { if (inherits(x, "list") && all(nchar(names(x)) > 0)) { tmp <- paste0(paste(names(x), x, sep = ": "), collapse = ", ") } else if (inherits(x, "list") && any(nchar(names(x)) == 0)) { tmp <- paste0(paste(names(x), x, sep = ": "), collapse = ", ") } else 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/stub_registry.R0000644000176200001440000000126713242621430015317 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/mocking-disk-writing.R0000644000176200001440000000412513665341057016463 0ustar liggesusers#' Mocking writing to disk #' #' @name mocking-disk-writing #' @examples \dontrun{ #' # 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) #' #' # 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") #' #' #' # Use mock_file to have webmockr handle file and contents #' #' # crul #' library(crul) #' f <- tempfile(fileext = ".json") #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return(body = mock_file(f, "{\"hello\":\"mars\"}\n")) #' ## make a request #' (out <- crul::HttpClient$new("https://httpbin.org/get")$get(disk = f)) #' out$content #' readLines(out$content) #' #' # httr #' library(httr) #' ## make a temp file #' f <- tempfile(fileext = ".json") #' ## make the stub #' stub_request("get", "https://httpbin.org/get") %>% #' to_return( #' body = mock_file(path = f, payload = "{\"foo\": \"bar\"}"), #' headers = list('content-type' = "application/json") #' ) #' ## make a request #' out <- GET("https://httpbin.org/get", write_disk(f)) #' out #' ## view stubbed file content #' out$content #' readLines(out$content) #' content(out, "text", encoding = "UTF-8") #' #' # disable mocking #' disable() #' } NULL webmockr/R/to_timeout.R0000644000176200001440000000060413665341057014611 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) { assert(.data, "StubbedRequest") .data$to_timeout() return(.data) } webmockr/R/adapter-httr.R0000644000176200001440000000734714017531570015024 0ustar liggesusers#' Build a httr response #' @export #' @param req a request #' @param resp a response #' @return a httr response build_httr_response <- function(req, resp) { try_url <- tryCatch(resp$url, error = function(e) e) lst <- list( url = try_url %|s|% req$url, status_code = as.integer(resp$status_code), headers = { if (grepl("^ftp://", resp$url %||% "")) { # in case uri_regex only list() } else { hds <- resp$headers if (is.null(hds)) { hds <- resp$response_headers if (is.null(hds)) { list() } else { stopifnot(is.list(hds)) stopifnot(is.character(hds[[1]])) httr::insensitive(hds) } } else { httr::insensitive(hds) } } }, all_headers = list(), cookies = httr_cookies_df(), content = resp$content, date = { if (!is.null(resp$response_headers$date)) { httr::parse_http_date(resp$response_headers$date) } else { Sys.time() } }, times = numeric(0), request = req, handle = NA ) lst$all_headers <- list(list( status = lst$status_code, version = "", headers = lst$headers )) structure(lst, class = "response") } httr_cookies_df <- function() { df <- data.frame(matrix(ncol = 7, nrow = 0)) x <- c("domain", "flag", "path", "secure", "expiration", "name", "value") colnames(df) <- x df } # x = "https://foobar.com" # check_user_pwd(x) check_user_pwd <- function(x) { if (is.null(x)) return(x) if (grepl("^https?://", x)) { stop(sprintf("expecting string of pattern 'user:pwd', got '%s'", x)) } return(x) } #' Build a httr request #' @export #' @param x an unexecuted httr request object #' @return a httr request build_httr_request = function(x) { headers <- as.list(x$headers) %||% NULL auth <- check_user_pwd(x$options$userpwd) %||% NULL if (!is.null(auth)) { auth_header <- prep_auth(auth) headers <- c(headers, auth_header) } RequestSignature$new( method = x$method, uri = x$url, options = list( body = pluck_body(x), headers = headers, proxies = x$proxies %||% NULL, auth = auth, disk = x$disk %||% NULL, fields = x$fields %||% NULL, output = x$output %||% NULL ) ) } #' Turn on httr mocking #' Sets a callback that routes httr request 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_for_pkg("httr") webmockr_handle <- function(req) { webmockr::HttrAdapter$new()$handle_request(req) } if (on) { httr::set_callback("request", webmockr_handle) } else { httr::set_callback("request", NULL) } invisible(on) } #' @rdname Adapter #' @export HttrAdapter <- R6::R6Class("HttrAdapter", inherit = Adapter, public = list( #' @field client HTTP client package name client = "httr", #' @field name adapter name name = "HttrAdapter" ), private = list( pluck_url = function(request) request$url, mock = function(on) httr_mock(on), build_request = build_httr_request, build_response = build_httr_response, request_handler = function(request) vcr::RequestHandlerHttr$new(request), fetch_request = function(request) { METHOD <- eval(parse(text = paste0("httr::", request$method))) METHOD( private$pluck_url(request), body = pluck_body(request), do.call(httr::config, request$options), httr::add_headers(request$headers), if (!is.null(request$output$path)) { httr::write_disk(request$output$path, TRUE) } ) } ) ) webmockr/R/to_return.R0000644000176200001440000000752114022727047014442 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 reqeust 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) { assert(.data, "StubbedRequest") assert(.list, "list") assert(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 ) { stop("'to_return' only accepts status, body, headers") } assert(z$status, "numeric") assert(z$headers, "list") if (!all(hz_namez(z$headers))) stop("'headers' must be a named list") replicate(times, .data$to_return(status = z$status, body = z$body, headers = z$headers)) return(.data) } webmockr/R/request_is_in_cache.R0000644000176200001440000000022013076516661016410 0ustar liggesusers# Check if request is in cache request_is_in_cache <- function(request_signature) { webmockr_stub_registry$is_registered(request_signature) } webmockr/R/pluck_body.R0000644000176200001440000000320213665341057014551 0ustar liggesusers#' Extract the body from an HTTP request #' #' Returns an appropriate representation of the data contained within a request #' body based on its encoding. #' #' @export #' @param x an unexecuted crul *or* httr request object #' @return one of the following: #' - `NULL` if the request is not associated with a body #' - `NULL` if an upload is used not in a list #' - list containing the multipart-encoded body #' - character vector with the JSON- or raw-encoded body, or upload form file pluck_body <- function(x) { assert_request(x) if (is_body_empty(x)) return(NULL) # multipart body if (!is.null(x$fields)) { form_file_comp <- vapply(x$fields, inherits, logical(1), "form_file") if (any(form_file_comp)) { return(x$fields[form_file_comp]) } else { return(x$fields) } # json/raw-encoded body } else if (!is.null(x$options$postfields) && is.raw(x$options$postfields)) { return(rawToChar(x$options$postfields)) # upload not in a list } else if (!is.null(x$options$postfieldsize_large)) { return(paste0("upload, file size: ", x$options$postfieldsize_large)) # unknown, fail out } else { stop("couldn't fetch request body; file an issue at \n", " https://github.com/ropensci/webmockr/issues/", call. = FALSE) } } assert_request <- function(x) { request_slots <- c("url", "method", "options", "headers") if (!is.list(x) || !all(request_slots %in% names(x))) { stop(deparse(substitute(x)), " is not a valid request ", call. = FALSE) } } is_body_empty <- function(x) { is.null(x$fields) && (is.null(x$options$postfieldsize) || x$options$postfieldsize == 0L) } webmockr/R/mock_file.R0000644000176200001440000000125113665341057014350 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(path, "character") assert(payload, c("character", "json")) structure(list(path = path, payload = payload), class = "mock_file") } #' @export print.mock_file <- function(x, ...) { cat("", sep = "\n") cat(paste0(" path: ", x$path), sep = "\n") cat(paste0(" payload: ", substring(x$payload, 1, 80)), sep = "\n") } webmockr/R/stub_registry_clear.R0000644000176200001440000000060413665341057016474 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/pipe.R0000644000176200001440000000021313040740114013332 0ustar liggesusers#' Pipe operator #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs NULL webmockr/R/webmockr-opts.R0000644000176200001440000001166113665341057015222 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 net_http_connect_on_start (logical) Default: `FALSE`. ignored for #' now #' @param show_stubbing_instructions (logical) Default: `FALSE`. ignored for #' now #' @param query_values_notation (logical) Default: `FALSE`. ignored for #' now #' @param show_body_diff (logical) Default: `FALSE`. ignored for #' now #' @param uri (character) a URI/URL as a character string - to determine #' whether or not it is allowed #' #' @section webmockr_allow_net_connect: #' If there are stubs found for a request, even if net connections are #' allowed (by running `webmockr_allow_net_connect()`) the stubbed #' response will be returned. If no stub is found, and net connections #' are allowed, then a real HTTP request can be made. #' #' @examples \dontrun{ #' webmockr_configure() #' webmockr_configure( #' allow_localhost = TRUE #' ) #' webmockr_configuration() #' webmockr_configure_reset() #' #' webmockr_allow_net_connect() #' webmockr_net_connect_allowed() #' #' # disable net connect for any URIs #' webmockr_disable_net_connect() #' ### gives NULL with no URI passed #' webmockr_net_connect_allowed() #' # disable net connect EXCEPT FOR given URIs #' webmockr_disable_net_connect(allow = "google.com") #' ### is a specific URI allowed? #' webmockr_net_connect_allowed("google.com") #' } webmockr_configure <- function( allow_net_connect = FALSE, allow_localhost = FALSE, allow = NULL, net_http_connect_on_start = FALSE, show_stubbing_instructions = FALSE, query_values_notation = FALSE, show_body_diff = FALSE) { opts <- list( allow_net_connect = allow_net_connect, allow_localhost = allow_localhost, allow = allow, net_http_connect_on_start = net_http_connect_on_start, show_stubbing_instructions = show_stubbing_instructions, query_values_notation = query_values_notation, show_body_diff = show_body_diff ) for (i in seq_along(opts)) { assign(names(opts)[i], opts[[i]], envir = webmockr_conf_env) } webmockr_configuration() } #' @export #' @rdname webmockr_configure webmockr_configure_reset <- function() webmockr_configure() #' @export #' @rdname webmockr_configure webmockr_configuration <- function() { structure(as.list(webmockr_conf_env), class = "webmockr_config") } #' @export #' @rdname webmockr_configure webmockr_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(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(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("", sep = "\n") cat(paste0(" crul enabled?: ", webmockr_lightswitch$crul), sep = "\n") cat(paste0(" httr enabled?: ", webmockr_lightswitch$httr), sep = "\n") cat(paste0(" allow_net_connect?: ", x$allow_net_connect), sep = "\n") cat(paste0(" allow_localhost?: ", x$allow_localhost), sep = "\n") cat(paste0(" allow: ", x$allow %||% ""), sep = "\n") cat(paste0(" net_http_connect_on_start: ", x$net_http_connect_on_start), sep = "\n") cat(paste0(" show_stubbing_instructions: ", x$show_stubbing_instructions), sep = "\n") cat(paste0(" query_values_notation: ", x$query_values_notation), sep = "\n") cat(paste0(" show_body_diff: ", x$show_body_diff), sep = "\n") } webmockr_conf_env <- new.env() webmockr/R/RequestPattern.R0000644000176200001440000005357113733453474015425 0ustar liggesusers#' @title RequestPattern class #' @description class handling all request matchers #' @export #' @seealso pattern classes for HTTP method [MethodPattern], headers #' [HeadersPattern], body [BodyPattern], and URI/URL [UriPattern] #' @examples \dontrun{ #' (x <- RequestPattern$new(method = "get", uri = "httpbin.org/get")) #' x$body_pattern #' x$headers_pattern #' x$method_pattern #' x$uri_pattern #' x$to_s() #' #' # make a request signature #' rs <- RequestSignature$new(method = "get", uri = "http://httpbin.org/get") #' #' # check if it matches #' x$matches(rs) #' #' # regex uri #' (x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org")) #' x$uri_pattern #' x$uri_pattern$to_s() #' x$to_s() #' #' # uri with query parameters #' (x <- RequestPattern$new( #' method = "get", uri = "https://httpbin.org/get", #' query = list(foo = "bar") #' )) #' x$to_s() #' ## query params included in url, not separately #' (x <- RequestPattern$new( #' method = "get", uri = "https://httpbin.org/get?stuff=things" #' )) #' x$to_s() #' x$query_params #' #' # just headers (via setting method=any & uri_regex=.+) #' headers <- list( #' 'User-Agent' = 'Apple', #' 'Accept-Encoding' = 'gzip, deflate', #' 'Accept' = 'application/json, text/xml, application/xml, */*') #' x <- RequestPattern$new( #' method = "any", #' uri_regex = ".+", #' headers = headers) #' x$to_s() #' rs <- RequestSignature$new(method = "any", uri = "http://foo.bar", #' options = list(headers = headers)) #' rs #' x$matches(rs) #' #' # body #' x <- RequestPattern$new(method = "post", uri = "httpbin.org/post", #' body = list(y = crul::upload(system.file("CITATION")))) #' x$to_s() #' rs <- RequestSignature$new(method = "post", uri = "http://httpbin.org/post", #' options = list( #' body = list(y = crul::upload(system.file("CITATION"))))) #' rs #' x$matches(rs) #' } 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 #' @return A new `RequestPattern` object initialize = function(method, uri = NULL, uri_regex = NULL, query = NULL, body = NULL, headers = NULL) { if (is.null(uri) && is.null(uri_regex)) { stop("one of uri or uri_regex is required", call. = FALSE) } self$method_pattern <- MethodPattern$new(pattern = method) self$uri_pattern <- if (is.null(uri_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) self$headers_pattern <- if (!is.null(headers)) HeadersPattern$new(pattern = headers) # FIXME: all private methods used in the below line, see if needed or remove # if (length(options)) private$assign_options(options) }, #' @description does a request signature match the selected matchers? #' @param request_signature a [RequestSignature] object #' @return a boolean matches = function(request_signature) { assert(request_signature, "RequestSignature") c_type <- if (!is.null(request_signature$headers)) request_signature$headers$`Content-Type` else NULL 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)) paste0(" with body ", self$body_pattern$to_s()), if (!is.null(self$headers_pattern)) paste0(" with headers ", self$headers_pattern$to_s()) )) } ), private = list( # assign_options = function(options) { # #self$validate_keys(options, 'body', 'headers', 'query', 'basic_auth') # set_basic_auth_as_headers(options) # self$body_pattern <- if ('body' %in% names(options)) BodyPattern$new(options['body']) # self$headers_pattern <- if ('headers' %in% names(options)) HeadersPattern$new(options['headers']) # if ('query' %in% names(options)) self$uri_pattern$add_query_params(options['query']) # }, # validate_keys = function(x, ...) { # valid_keys <- unlist(list(...), recursive = FALSE) # for (i in seq_along(x)) { # if (!names(x)[i] %in% valid_keys) { # stop( # sprintf("Unknown key: %s. Valid keys are: %s", # names(x)[i], # paste0(valid_keys, collapse = ", "), # call. = FALSE # ) # ) # } # } # }, set_basic_auth_as_headers = function(options) { if ('basic_auth' %in% names(options)) { private$validate_basic_auth(options$basic_auth) options$headers <- list() options$headers$Authorization <- private$make_basic_auth(options$basic_auth[1], options$basic_auth[2]) } }, validate_basic_auth = function(x) { if (!inherits(x, "list") || length(unique(unname(unlist(x)))) == 1) { stop( "'basic_auth' option should be a list of length 2: username and password", call. = FALSE ) } }, make_basic_auth = function(x, y) { jsonlite::base64_enc(paste0(x, ":", y)) } ) ) #' @title MethodPattern #' @description method matcher #' @export #' @keywords internal #' @details Matches regardless of case. e.g., POST will match to post #' @examples #' (x <- MethodPattern$new(pattern = "post")) #' x$pattern #' x$matches(method = "post") #' x$matches(method = "POST") #' #' # all matches() calls should be TRUE #' (x <- MethodPattern$new(pattern = "any")) #' x$pattern #' x$matches(method = "post") #' x$matches(method = "GET") #' x$matches(method = "HEAD") MethodPattern <- R6::R6Class( 'MethodPattern', public = list( #' @field pattern (character) an http method pattern = NULL, #' @description Create a new `MethodPattern` object #' @param pattern (character) a HTTP method, lowercase #' @return A new `MethodPattern` object initialize = function(pattern) { self$pattern <- tolower(pattern) }, #' @description test if the pattern matches a given http method #' @param method (character) a HTTP method, lowercase #' @return a boolean matches = function(method) { self$pattern == tolower(method) || self$pattern == "any" }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ) ) #' @title HeadersPattern #' @description headers matcher #' @export #' @keywords internal #' @details #' `webmockr` normalises headers and treats all forms of same headers as equal: #' i.e the following two sets of headers are equal: #' `list(Header1 = "value1", content_length = 123, X_CuStOm_hEAder = "foo")` #' and #' `list(header1 = "value1", "Content-Length" = 123, "x-cuSTOM-HeAder" = "foo")` #' @examples #' (x <- HeadersPattern$new(pattern = list(a = 5))) #' x$pattern #' x$matches(list(a = 5)) #' #' # different cases #' (x <- HeadersPattern$new(pattern = list(Header1 = "value1"))) #' x$pattern #' x$matches(list(header1 = "value1")) #' x$matches(list(header1 = "value2")) #' #' # different symbols #' (x <- HeadersPattern$new(pattern = list(`Hello_World` = "yep"))) #' x$pattern #' x$matches(list(`hello-world` = "yep")) #' x$matches(list(`hello-worlds` = "yep")) #' #' headers <- list( #' 'User-Agent' = 'Apple', #' 'Accept-Encoding' = 'gzip, deflate', #' 'Accept' = 'application/json, text/xml, application/xml, */*') #' (x <- HeadersPattern$new(pattern = headers)) #' x$to_s() #' x$pattern #' x$matches(headers) HeadersPattern <- R6::R6Class( 'HeadersPattern', public = list( #' @field pattern a list pattern = NULL, #' @description Create a new `HeadersPattern` object #' @param pattern (list) a pattern, as a named list, must be named, #' e.g,. `list(a = 5, b = 6)` #' @return A new `HeadersPattern` object initialize = function(pattern) { stopifnot(is.list(pattern)) pattern <- private$normalize_headers(pattern) self$pattern <- pattern }, #' @description Match a list of headers against that stored #' @param headers (list) named list of headers, e.g,. `list(a = 5, b = 6)` #' @return a boolean matches = function(headers) { if (self$empty_headers(self$pattern)) { self$empty_headers(headers) } else { if (self$empty_headers(headers)) return(FALSE) headers <- private$normalize_headers(headers) out <- c() for (i in seq_along(self$pattern)) { out[i] <- names(self$pattern)[i] %in% names(headers) && self$pattern[[i]] == headers[[names(self$pattern)[i]]] } all(out) } }, #' @description Are headers empty? tests if null or length==0 #' @param headers named list of headers #' @return a boolean empty_headers = function(headers) { is.null(headers) || length(headers) == 0 }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() hdl_lst2(self$pattern) ), private = list( normalize_headers = function(x) { # normalize names names(x) <- tolower(names(x)) # normalize symbols ## underscores to single dash names(x) <- gsub("_", "-", names(x)) return(x) } ) ) #' @title BodyPattern #' @description body matcher #' @export #' @keywords internal #' @examples #' # make a request signature #' bb <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list( #' body = list(foo = "bar", a = 5) #' ) #' ) #' #' # make body pattern object #' ## FALSE #' z <- BodyPattern$new(pattern = list(foo = "bar")) #' z$pattern #' z$matches(bb$body) #' ## TRUE #' z <- BodyPattern$new(pattern = list(foo = "bar", a = 5)) #' z$pattern #' z$matches(bb$body) #' #' # uploads in bodies #' ## upload NOT in a list #' bb <- RequestSignature$new( #' method = "post", uri = "https:/httpbin.org/post", #' options = list(body = crul::upload(system.file("CITATION")))) #' bb$body #' z <- BodyPattern$new(pattern = #' crul::upload(system.file("CITATION"))) #' z$pattern #' z$matches(bb$body) #' #' ## upload in a list #' bb <- RequestSignature$new( #' method = "post", uri = "https:/httpbin.org/post", #' options = list(body = list(y = crul::upload(system.file("CITATION"))))) #' bb$body #' z <- BodyPattern$new(pattern = #' list(y = crul::upload(system.file("CITATION")))) #' z$pattern #' z$matches(bb$body) BodyPattern <- R6::R6Class( 'BodyPattern', public = list( #' @field pattern a list pattern = NULL, #' @description Create a new `BodyPattern` object #' @param pattern (list) a body object #' @return A new `BodyPattern` object initialize = function(pattern) { if (inherits(pattern, "form_file")) self$pattern <- unclass(pattern) else self$pattern <- pattern }, #' @description Match a list of headers against that stored #' @param body (list) the body #' @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(private$body_as_hash(body, content_type), self$pattern) } else { private$empty_string(self$pattern) && private$empty_string(body) || self$pattern == body } }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ), private = list( empty_headers = function(headers) { is.null(headers) || length(headers) == 0 }, empty_string = function(string) { is.null(string) || nchar(string) == 0 }, matching_hashes = function(z, pattern) { if (is.null(z)) return(FALSE) if (!inherits(z, "list")) return(FALSE) if (!all(sort(names(z)) %in% sort(names(pattern)))) return(FALSE) for (i in seq_along(z)) { expected <- pattern[[names(z)[i]]] actual <- z[[i]] if (inherits(actual, "list") && inherits(expected, "list")) { if (private$matching_hashes(actual, expected)) return(FALSE) } else { if (!identical(as.character(actual), as.character(expected))) return(FALSE) } } return(TRUE) }, body_as_hash = function(body, content_type) { if (inherits(body, "form_file")) body <- unclass(body) bctype <- BODY_FORMATS[[content_type]] %||% "" if (bctype == 'json') { jsonlite::fromJSON(body, FALSE) } else if (bctype == 'xml') { check_for_pkg("xml2") xml2::read_xml(body) } else { query_mapper(body) } } ) ) BODY_FORMATS <- list( 'text/xml' = 'xml', 'application/xml' = 'xml', 'application/json' = 'json', 'text/json' = 'json', 'application/javascript' = 'json', 'text/javascript' = 'json', 'text/html' = 'html', 'application/x-yaml' = 'yaml', 'text/yaml' = 'yaml', 'text/plain' = 'plain' ) #' @title UriPattern #' @description uri matcher #' @export #' @keywords internal #' @examples #' # trailing slash #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://foobar.com") # TRUE #' z$matches("http://foobar.com/") # TRUE #' #' # without scheme #' ## matches http by default: does not match https by default #' (z <- UriPattern$new(pattern = "foobar.com")) #' z$matches("http://foobar.com") # TRUE #' z$matches("http://foobar.com/") # TRUE #' z$matches("https://foobar.com") # FALSE #' z$matches("https://foobar.com/") # FALSE #' ## to match https, you'll have to give the complete url #' (z <- UriPattern$new(pattern = "https://foobar.com")) #' z$matches("https://foobar.com/") # TRUE #' z$matches("http://foobar.com/") # FALSE #' #' # default ports #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://foobar.com:80") # TRUE #' z$matches("http://foobar.com:80/") # TRUE #' z$matches("http://foobar.com:443") # TRUE #' z$matches("http://foobar.com:443/") # TRUE #' #' # user info - FIXME, not sure we support this yet #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$matches("http://user:pass@foobar.com") #' #' # regex #' (z <- UriPattern$new(regex_pattern = ".+ample\\..")) #' z$matches("http://sample.org") # TRUE #' z$matches("http://example.com") # TRUE #' z$matches("http://tramples.net") # FALSE #' #' # add query parameters #' (z <- UriPattern$new(pattern = "http://foobar.com")) #' z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) #' z #' z$pattern #' z$matches("http://foobar.com?pizza=cheese&cheese=cheddar") # TRUE #' z$matches("http://foobar.com?pizza=cheese&cheese=swiss") # FALSE #' #' # query parameters in the uri #' (z <- UriPattern$new(pattern = "https://httpbin.org/get?stuff=things")) #' z$add_query_params() # have to run this method to gather query params #' z$matches("https://httpbin.org/get?stuff=things") # TRUE #' z$matches("https://httpbin.org/get?stuff2=things") # FALSE #' #' # regex add query parameters #' (z <- UriPattern$new(regex_pattern = "https://foobar.com/.+/order")) #' z$add_query_params(list(pizza = "cheese")) #' z #' z$pattern #' z$matches("https://foobar.com/pizzas/order?pizza=cheese") # TRUE #' z$matches("https://foobar.com/pizzas?pizza=cheese") # FALSE #' #' # query parameters in the regex uri #' (z <- UriPattern$new(regex_pattern = "https://x.com/.+/order?fruit=apple")) #' z$add_query_params() # have to run this method to gather query params #' z$matches("https://x.com/a/order?fruit=apple") # TRUE #' z$matches("https://x.com/a?fruit=apple") # FALSE #' #' # any pattern #' (z <- UriPattern$new(regex_pattern = "stuff\\.com.+")) #' z$regex #' z$pattern #' z$matches("http://stuff.com") # FALSE #' z$matches("https://stuff.com/stff") # TRUE #' z$matches("https://stuff.com/apple?bears=brown&bats=grey") # TRUE 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, #' @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 list of headers against that stored #' @param uri (character) a uri #' @return a boolean matches = function(uri) { uri <- normalize_uri(uri, self$regex) 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(uri == self$pattern) # not regex grepl(drop_query_params(self$pattern), uri) # regex }, #' @description Match query parameters of a URI #' @param uri (character) a uri #' @return a boolean query_params_matches = function(uri) { 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 (missing(query_params) || is.null(query_params)) { self$query_params <- self$extract_query(self$pattern) } else { self$query_params <- query_params if ( inherits(query_params, "list") || inherits(query_params, "character") ) { pars <- paste0(unname(Map(function(x, y) paste(x, esc(y), sep = "="), names(query_params), query_params)), collapse = "&") self$pattern <- paste0(self$pattern, "?", pars) } } }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ) ) 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) } 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) } ## http method get_method <- function(x) { x <- as.character(x) tmp <- grep( "(get)$|(post)$|(put)$|(delete)$|(options)$|(patch)$|(head)$", tolower(x), value = TRUE) tmp <- sub("httr::", "", tmp) if (length(tmp) == 0) NULL else tmp } ## query and body stuff get_query <- function(x) { if ("query" %in% names(x)) { x[["query"]] } else { NULL } } get_body <- function(x) { if ("body" %in% names(x)) { x[["body"]] } else { NULL } } webmockr/R/HttpLibAdapterRegistry.R0000644000176200001440000000226613665341057017027 0ustar liggesusers#' @title HttpLibAdapaterRegistry #' @description http lib adapter registry #' @export #' @examples #' x <- HttpLibAdapaterRegistry$new() #' x$register(CrulAdapter$new()) #' x #' x$adapters #' x$adapters[[1]]$name HttpLibAdapaterRegistry <- R6::R6Class( 'HttpLibAdapaterRegistry', public = list( #' @field adapters list adapters = NULL, #' @description print method for the `HttpLibAdapaterRegistry` class #' @param x self #' @param ... ignored print = function(x, ...) { cat(" ", sep = "\n") for (i in seq_along(self$adapters)) { cat(sprintf(" %s: webmockr:::%s", self$adapters[[i]]$name, class(self$adapters[[i]])[1]), sep = "\n") } }, #' @description Register an http library adapter #' @param x an http lib adapter, e.g., [CrulAdapter] #' @return nothing, registers the library adapter register = function(x) { # FIXME: when other adapters supported, change this inherits test if (!inherits(x, c("CrulAdapter", "HttrAdapter"))) { stop("'x' must be an adapter, such as CrulAdapter", call. = FALSE) } self$adapters <- c(self$adapters, x) } ) ) webmockr/R/wi_th.R0000644000176200001440000000763213750075161013536 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()] #' @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` or `httr::upload_file`, they both create the #' same object in the end) #' - headers: (list) a named list #' - basic_auth: (character) a length two vector, username and password. #' authentication type (basic/digest/ntlm/etc.) is ignored. that is, #' mocking authenciation right now does not take into account the #' authentication type. 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) #' #' 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")) wi_th <- function(.data, ..., .list = list()) { assert(.data, "StubbedRequest") assert(.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 ) { stop("'wi_th' only accepts query, body, headers, basic_auth") } if (any(duplicated(names(z)))) stop("can not have duplicated names") assert(z$query, "list") if (!all(hz_namez(z$query))) stop("'query' must be a named list") assert(z$headers, "list") if (!all(hz_namez(z$headers))) stop("'headers' must be a named list") assert(z$basic_auth, "character") assert_eq(z$basic_auth, 2) .data$with( query = z$query, body = z$body, headers = z$headers, basic_auth = z$basic_auth ) return(.data) } webmockr/R/RequestRegistry.R0000644000176200001440000001100613665341057015600 0ustar liggesusers#' @title HashCounter #' @description hash with counter, to store requests, and count each time #' it is used #' @export #' @family request-registry #' @examples #' x <- HashCounter$new() #' x$hash #' z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") #' x$put(z) #' x$hash #' x$get(z) #' x$put(z) #' x$get(z) HashCounter <- R6::R6Class( 'HashCounter', public = list( #' @field hash (list) a list for internal use only, with elements #' `key`, `sig`, and `count` hash = list(), #' @description Register a request by it's key #' @param req_sig an object of class `RequestSignature` #' @return nothing returned; registers request and iterates #' internal counter put = function(req_sig) { assert(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(req_sig, "RequestSignature") self$hash[[req_sig$to_s()]]$count %||% 0 } ) ) #' @title RequestRegistry #' @description keeps track of HTTP requests #' @export #' @family request-registry #' @seealso [stub_registry()] and [StubRegistry] #' @examples #' x <- RequestRegistry$new() #' z1 <- RequestSignature$new("get", "http://scottchamberlain.info") #' z2 <- RequestSignature$new("post", "https://httpbin.org/post") #' x$register_request(request = z1) #' x$register_request(request = z1) #' x$register_request(request = z2) #' # print method to list requests #' x #' #' # more complex requests #' w <- RequestSignature$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) #' ) #' w$to_s() #' x$register_request(request = w) #' x #' #' #' # hashes, and number of times each requested #' x$request_signatures$hash #' #' # times_executed method #' pat <- RequestPattern$new( #' method = "get", #' uri = "https:/httpbin.org/get", #' headers = list(`User-Agent` = "foobar", stuff = "things") #' ) #' pat$to_s() #' x$times_executed(pat) #' z <- RequestPattern$new(method = "get", uri = "http://scottchamberlain.info") #' x$times_executed(z) #' w <- RequestPattern$new(method = "post", uri = "https://httpbin.org/post") #' x$times_executed(w) #' #' ## pattern with no matches - returns 0 (zero) #' pat <- RequestPattern$new( #' method = "get", #' uri = "http://recology.info/" #' ) #' pat$to_s() #' x$times_executed(pat) #' #' # reset the request registry #' x$reset() RequestRegistry <- R6::R6Class( 'RequestRegistry', public = list( #' @field request_signatures a HashCounter object request_signatures = HashCounter$new(), #' @description print method for the `RequestRegistry` class #' @param x self #' @param ... ignored print = function(x, ...) { cat(" ", sep = "\n") cat(" Registered Requests", sep = "\n") for (i in seq_along(self$request_signatures$hash)) { cat( sprintf( " %s was made %s times\n", names(self$request_signatures$hash)[i], self$request_signatures$hash[[i]]$count ), sep = "\n" ) } invisible(self$request_signatures$hash) }, #' @description Reset the registry to no registered requests #' @return nothing returned; ressets registry to no requests reset = function() { self$request_signatures <- HashCounter$new() }, #' @description Register a request #' @param request a character string of the request, serialized from #' a `RequestSignature$new(...)$to_s()` #' @return nothing returned; registers the request register_request = function(request) { self$request_signatures$put(request) }, #' @description How many times has a request been made #' @param request_pattern an object of class `RequestPattern` #' @return integer, the number of times the request has been made #' @details if no match is found for the request pattern, 0 is returned times_executed = function(request_pattern) { bools <- c() for (i in seq_along(self$request_signatures$hash)) { bools[i] <- request_pattern$matches(self$request_signatures$hash[[i]]$sig) } if (all(!bools)) return(0) self$request_signatures$hash[bools][[1]]$count } ) ) webmockr/R/flipswitch.R0000644000176200001440000000556014022530740014566 0ustar liggesuserswebmockr_lightswitch <- new.env() webmockr_lightswitch$httr <- FALSE webmockr_lightswitch$crul <- FALSE webmockr_adapters <- c('crul', 'httr') #' Enable or disable webmockr #' #' @export #' @param adapter (character) the adapter name, 'crul' or 'httr'. #' 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) { stop("adapter must be one of 'crul' or 'httr'") } if (!requireNamespace(adapter, quietly = TRUE)) { message(adapter, " not installed, skipping enable") return(invisible(FALSE)) } http_lib_adapter_registry$adapters[[grep(adapter, adnms)]]$enable(quiet) } else { invisible(vapply(http_lib_adapter_registry$adapters, function(z) { pkgname <- z$client # check if package installed first if (!requireNamespace(pkgname, quietly = TRUE)) { message(pkgname, " not installed, skipping enable") FALSE } else { # if instaled, enable z$enable(quiet) } }, logical(1))) } } #' @export #' @rdname enable enabled <- function(adapter = "crul") { if (!adapter %in% webmockr_adapters) { stop("'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) { stop("adapter must be one of 'crul' or 'httr'") } if (!requireNamespace(adapter, quietly = TRUE)) { message(adapter, " not installed, skipping disable") return(invisible(FALSE)) } http_lib_adapter_registry$adapters[[grep(adapter, adnms)]]$disable(quiet) } else { invisible(vapply(http_lib_adapter_registry$adapters, function(z) { pkgname <- z$client # check if package installed first if (!requireNamespace(pkgname, quietly = TRUE)) { message(pkgname, " not installed, skipping disable") FALSE } else { # if instaled, disable z$disable(quiet) } }, logical(1))) } } webmockr/R/webmockr.R0000644000176200001440000000160213734503257014230 0ustar liggesusers#' @title webmockr #' @description Stubbing and setting expectations on HTTP requests #' #' @importFrom R6 R6Class #' @importFrom fauxpas HTTPRequestTimeout #' @importFrom crul mock #' @importFrom base64enc base64encode #' @name webmockr-package #' @aliases webmockr #' @docType package #' @keywords package #' @author Scott Chamberlain \email{myrmecocystus+r@@gmail.com} #' @author Aaron Wolen #' #' @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} and #' \pkg{httr} #' - Integration with HTTP test caching library \pkg{vcr} #' #' @examples #' library(webmockr) #' stub_request("get", "https://httpbin.org/get") #' stub_request("post", "https://httpbin.org/post") #' stub_registry() NULL webmockr/R/request_registry.R0000644000176200001440000000236213665341057016044 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/defunct.R0000644000176200001440000000155313665341057014055 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/adapter.R0000644000176200001440000003117214022547752014043 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} #' @details Note that the documented fields and methods are the same across all #' client-specific adapters. #' @export #' @examples \dontrun{ #' if (requireNamespace("httr", quietly = TRUE)) { #' # library(httr) #' #' # normal httr request, works fine #' # real <- GET("https://httpbin.org/get") #' # real #' #' # with webmockr #' # library(webmockr) #' ## turn on httr mocking #' # httr_mock() #' ## now this request isn't allowed #' # GET("https://httpbin.org/get") #' ## stub the request #' # stub_request('get', uri = 'https://httpbin.org/get') %>% #' # wi_th( #' # headers = list('Accept' = 'application/json, text/xml, application/xml, */*') #' # ) %>% #' # to_return(status = 418, body = "I'm a teapot!", headers = list(a = 5)) #' ## now the request succeeds and returns a mocked response #' # (res <- GET("https://httpbin.org/get")) #' # res$status_code #' # rawToChar(res$content) #' #' # allow real requests while webmockr is loaded #' # webmockr_allow_net_connect() #' # webmockr_net_connect_allowed() #' # GET("https://httpbin.org/get?animal=chicken") #' # webmockr_disable_net_connect() #' # webmockr_net_connect_allowed() #' # GET("https://httpbin.org/get?animal=chicken") #' #' # httr_mock(FALSE) #' } #' } Adapter <- R6::R6Class("Adapter", public = list( #' @field client HTTP client package name client = NULL, #' @field name adapter name name = NULL, #' @description Create a new Adapter object initialize = function() { if (is.null(self$client)) { stop( "Adapter parent class should not be called directly.\n", "Use one of the following package-specific adapters instead:\n", " - CrulAdapter$new()\n", " - HttrAdapter$new()", call. = FALSE ) } }, #' @description Enable the adapter #' @param quiet (logical) suppress messages? default: `FALSE` #' @return `TRUE`, invisibly enable = function(quiet = FALSE) { assert(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) ) }, #' @description Disable the adapter #' @param quiet (logical) suppress messages? default: `FALSE` #' @return `FALSE`, invisibly disable = function(quiet = FALSE) { assert(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) ) }, #' @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 # request = request_signature$to_s() ) if (request_is_in_cache(request_signature)) { # if real requests NOT allowed # even if net connects allowed, we check if stubbed found first ss <- webmockr_stub_registry$find_stubbed_request(request_signature)[[1]] # if user wants to return a partial object # get stub with response and return that resp <- private$build_stub_response(ss) # generate response # VCR: recordable/ignored if (vcr_cassette_inserted()) { # req <- handle_separate_redirects(req) # use RequestHandler - gets current cassette & record interaction resp <- private$request_handler(req)$handle() # if written to disk, see if we should modify file path if (self$client == "crul" && is.character(resp$content)) { resp <- private$update_vcr_disk_path(resp) } # no vcr } else { resp <- private$build_response(req, resp) # add to_return() elements if given resp <- private$add_response_sequences(ss, resp) } # request is not in cache but connections are allowed } else if (webmockr_net_connect_allowed(uri = private$pluck_url(req))) { # if real requests || localhost || certain exceptions ARE # allowed && nothing found above # if vcr loaded: record http interaction into vcr namespace # VCR: recordable if (vcr_loaded()) { # req <- handle_separate_redirects(req) # use RequestHandler instead? - which gets current cassette for us resp <- private$request_handler(req)$handle() # if written to disk, see if we should modify file path if (self$client == "crul" && is.character(resp$content)) { if (file.exists(resp$content)) { resp <- private$update_vcr_disk_path(resp) } } # stub request so next time we match it req_url <- private$pluck_url(req) urip <- crul::url_parse(req_url) m <- vcr::vcr_configuration()$match_requests_on if (all(m %in% c("method", "uri")) && length(m) == 2) { stub_request(req$method, req_url) } else if (all(m %in% c("method", "uri", "query")) && length(m) == 3) { tmp <- stub_request(req$method, req_url) wi_th(tmp, .list = list(query = urip$parameter)) } else if (all(m %in% c("method", "uri", "headers")) && length(m) == 3) { tmp <- stub_request(req$method, req_url) wi_th(tmp, .list = list(headers = req$headers)) } else if (all(m %in% c("method", "uri", "headers", "query")) && length(m) == 4) { tmp <- stub_request(req$method, req_url) wi_th(tmp, .list = list(query = urip$parameter, headers = req$headers)) } # check if new request/response from redirects in vcr # req <- redirects_request(req) # resp <- redirects_response(resp) } else { private$mock(on = FALSE) resp <- private$fetch_request(req) private$mock(on = TRUE) } # request is not in cache and connections are not allowed } else { # throw vcr error: should happen when user not using # use_cassette or insert_cassette if (vcr_loaded()) { private$request_handler(req)$handle() } # no stubs found and net connect not allowed - STOP x <- "Real HTTP connections are disabled.\nUnregistered request:\n " y <- "\n\nYou can stub this request with the following snippet:\n\n " z <- "\n\nregistered request stubs:\n\n" msgx <- paste(x, request_signature$to_s()) msgy <- paste(y, private$make_stub_request_code(request_signature)) if (length(webmockr_stub_registry$request_stubs)) { msgz <- paste( z, paste0(vapply(webmockr_stub_registry$request_stubs, function(z) z$to_s(), ""), collapse = "\n ") ) } else { msgz <- "" } ending <- "\n============================================================" stop(paste0(msgx, msgy, msgz, ending), call. = FALSE) } 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) } if (all(nzchar(hd_str) && nzchar(bd_str))) { with_str <- sprintf(" 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)) req_pat <- RequestPattern$new(method = stub$method, uri = stub$uri, uri_regex = stub$uri_regex, query = stub$query, body = stub$body, headers = stub$request_headers) times_req <- webmockr_request_registry$times_executed(req_pat) - 1 stub_num_get <- times_req + 1 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 req_pat <- RequestPattern$new(method = stub$method, uri = stub$uri, uri_regex = stub$uri_regex, query = stub$query, body = stub$body, headers = stub$request_headers) times_req <- webmockr_request_registry$times_executed(req_pat) - 1 stub_num_get <- times_req + 1 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( respx$body_raw$payload, file = respx$body_raw$path, sep = "\n" ) respx$body_raw <- respx$body_raw$path if (self$client == "httr") { class(respx$body_raw) <- "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" } 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 { response$headers <- httr::insensitive(headers) } } } return(response) } ) ) webmockr/R/remove_request_stub.R0000644000176200001440000000071713414707040016516 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/NEWS.md0000644000176200001440000003135414022762517013175 0ustar liggesuserswebmockr 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 differenc 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 accesed 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/MD50000644000176200001440000001610514023430252012371 0ustar liggesusers028ad1133e233a06d8491911d2a8768d *DESCRIPTION 35bd8606c71dfbfad3ad27387e177ad4 *LICENSE 1d76831b948fa61ba5fe1bcfe3413482 *NAMESPACE d592438fa967ea453a662d08e6d8cfa1 *NEWS.md 04e68d6f38da667d6ff2f44a97fa895f *R/HttpLibAdapterRegistry.R fd8316b4b059db3017ec2e926c7b92dd *R/RequestPattern.R e259cb66d0d1c759085d925e6de3db29 *R/RequestRegistry.R a44c031fdb77f51b5e53985bf9e58e33 *R/RequestSignature.R dce5f8019542ff9668f77926b210ec91 *R/Response.R a83a18e563d63da810cac2935381f270 *R/StubRegistry.R a66f6e82719ccf708c68bc4af06b20a7 *R/StubbedRequest.R c28863c78d0802cf045647313add2617 *R/adapter-crul.R 0d82dc34264378702554c4b7a91a5bed *R/adapter-httr.R bbc76fce74c0953cbff46b8e5947017a *R/adapter.R c106024d861656a99ed8fae3c1620c94 *R/defunct.R 1f12419fd833139ef2be969f322203d2 *R/flipswitch.R d64d3ea6fde479b3e3a7c4114d7abb63 *R/globals.R c4c0b5f41f05d0b04d2cfaa7490e7ac2 *R/headers.R ddefa0a5b28c1aa46e4823d67a5eb14b *R/mock_file.R 5e32e34b58b0f601cf9cbe0196b62d31 *R/mocking-disk-writing.R 583e7f9abbc83abe9f2c44ca0e95349f *R/onload.R f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/pipe.R 0a1fcdd4033bf6d88a73e7327af15b0f *R/pluck_body.R daeed7760bd653cd52477e791314d4cb *R/query_mapper.R 56db156253368fd808bb2fa279befede *R/remove_request_stub.R 1591fbffccf0e3dccd11091bf116ab35 *R/request_is_in_cache.R b706acdfc6b063d3e897eb3be87a657d *R/request_registry.R 430ac23f312c685d9a8b371a24e5bd52 *R/stub_registry.R 625bcfa5857f8355a4dee3d16fc603c3 *R/stub_registry_clear.R d3daeaf011755aceac74e6ae1dacdae6 *R/stub_request.R 8b30d79d7dc010155fb82b33aaa20639 *R/to_raise.R 339d4a9d335f394b31ea82566f61c696 *R/to_return.R 78d1443f02b9efaf6a0589176816aa0f *R/to_timeout.R 439a6d5e50676a39ca8e62f961b27dbf *R/webmockr-opts.R 617e80e27bbd84517561a5294f8d3d62 *R/webmockr.R 4aca567a1967f684b74a9ea5be84d7ff *R/webmockr_reset.R 9fbdfa97aabac4d7d767380badbe039b *R/wi_th.R 31491613d1172652d0bcd4efbf707188 *R/zzz.R bfab6207f448fab82e6cd42ebc3abbf2 *inst/ignore/adapter-httr.R c2dad18498a5fbbfa1ad2b9618072bcb *inst/ignore/sockets.R c81206a6f614a2212d27a237fc1fb18e *man/Adapter.Rd fce34576700cc31a2700f13f26465853 *man/BodyPattern.Rd c8bb95252309c1410205985322bb3b37 *man/HashCounter.Rd e1ea2503cc3ca8eb0021a08ce146b15a *man/HeadersPattern.Rd a3aae78d02e9e2664ca65fe16b9315b9 *man/HttpLibAdapaterRegistry.Rd 3c4ccb5be0468527f4de91f1dc9e371d *man/MethodPattern.Rd 5df95a6a326aef7b37370c7e7f874650 *man/RequestPattern.Rd 81360aaf8873ffbc8d776b6e69b450a2 *man/RequestRegistry.Rd 4b063932ea9bf5082e9680a624431703 *man/RequestSignature.Rd 80cc7d36f86aa36b663cc563239b581f *man/Response.Rd 58989083f6a93d21dee758af5a7cc42a *man/StubRegistry.Rd 0ee9c2791198db1242d755a6b52d0458 *man/StubbedRequest.Rd f12d8f66f805d7ba2ac8ccbe84317738 *man/UriPattern.Rd 58ea5dc971c95c9d289bd2728d429636 *man/build_crul_request.Rd 3150b5130431d33a0854f49107c36124 *man/build_crul_response.Rd 0aa38ec0cf479afaa142cbb5fddc2cc9 *man/build_httr_request.Rd cf1087a981502f25b0c28ccaa46c909f *man/build_httr_response.Rd 98e31353cdc1b20b15e5dc375bb45d3f *man/enable.Rd 6122d9a26c454918566b22d18c442b1a *man/httr_mock.Rd ebfaadcba0c55dafbe78d030064d23e0 *man/mock_file.Rd 178e2c751424415620fe495ea68b9452 *man/mocking-disk-writing.Rd e17f41e959fd90a1736ad0fc8ee7ff81 *man/pipe.Rd 1477b4e8133589afa2521dc2f884294d *man/pluck_body.Rd 4d619ce1b8c5922cac0c2f6767e9fdc3 *man/remove_request_stub.Rd e62b1f979c9b89292cc35a9da34b528d *man/request_registry.Rd 3b96ff03cbe89852e97b48fb1621ce90 *man/stub_registry.Rd 37024434d8cbc7eb698fc4b354a207b3 *man/stub_registry_clear.Rd 8b9700ba6e9eb1525cc1b3566cd96c35 *man/stub_request.Rd 535bc7b7b442f403f3de8e9a9ab9e348 *man/to_raise.Rd 1f60ea3df0fd3455456feeeda08032a3 *man/to_return.Rd 90cbd5a6751fe9042883ffa40fa396d5 *man/to_return_-defunct.Rd b49744ded1577db1eda32787347902fb *man/to_timeout.Rd 6dec78f38272f4437c3b143e9c53c8fc *man/webmockr-defunct.Rd 12715563134890a42a27936a61bfee64 *man/webmockr-package.Rd 3d2914d400d64a8dce82bcad27d55efe *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 6ea07cb91e931294d02a0c08f73ed673 *man/wi_th.Rd 32740100031047c3073973060764fa4b *man/wi_th_-defunct.Rd 6695b4e11699caab8ba7c936ff9d0778 *tests/test-all.R 9b69fa7ce58021b08f11de7c6412b32e *tests/testthat/crul_body_upload_list.rda 9b6c5be18b4fc24baf77fdff0b7af1d0 *tests/testthat/crul_body_upload_no_list.rda 43e9a3a2f19d982c0919de0490556d0c *tests/testthat/crul_obj.rda 30fd0a2b3950040186b1e2772490d9ff *tests/testthat/helper-webmockr.R eb5571d890cfb38097090fe789ef84e1 *tests/testthat/httr_body_upload_list.rda b11125facccee9440f7cf052fdaa33b3 *tests/testthat/httr_body_upload_no_list.rda 6e445177bc7dd6fe536a50a83d8d0c51 *tests/testthat/httr_obj.rda 651e0341d9fba0470f2cf0b81505596d *tests/testthat/httr_obj_auth.rda 78b8368c9d4afd05bf7fb4b53062710b *tests/testthat/test-Adapter.R fb54ec489c01d57db3dadc7412cec6d9 *tests/testthat/test-CrulAdapter.R 8cba825ffc6edce2db9503efaa4cef43 *tests/testthat/test-HashCounter.R 70086b1d1e1de13c71956684e9743cf0 *tests/testthat/test-HttpLibAdapaterRegistry.R 8721dd9a1f2b3519e8316995da683dfb *tests/testthat/test-HttrAdapter.R ca33cfa5e450cf84b8a1b5baf608cb9c *tests/testthat/test-RequestPattern.R 5cbaa8d8f5170a8252056e2619a2b3f8 *tests/testthat/test-RequestRegistry.R fe3d5c12edaacd508c326f14dd11a1d8 *tests/testthat/test-RequestSignature.R 2adc81e7e7d6a44051ab344b4200ed63 *tests/testthat/test-Response.R b0baf6487cf094666681178688a88fd4 *tests/testthat/test-StubRegistry.R aa53cffa6289ddc583d1d1d24f17a087 *tests/testthat/test-StubbedRequest.R 20f3a8cdbdffeb914a690578f47cc83e *tests/testthat/test-auth_handling.R f4224c6fd7e1846f3d71dc754d4ba243 *tests/testthat/test-b-no-cassette-in-use.R ecfb5a3ffafb64de052d3f7ca574d286 *tests/testthat/test-flipswitch.R 2e8d108c47237fc63217dd706bbe1c41 *tests/testthat/test-onload.R ac7c9855aa77246ccc53edf225db62e6 *tests/testthat/test-pluck_body.R d0f0aef9e2c6dd6b01225c9982fb014e *tests/testthat/test-remove_request_stub.R 2ab401ac2459999830e31551d8cfe61f *tests/testthat/test-request_registry.R ddcdc38016f672d2fb7704edb524b3a6 *tests/testthat/test-stub_registry.R cadae6a34534bee1aab60f41d6143c4d *tests/testthat/test-stub_request.R ca78f094ce17e2641a4fd1f038918724 *tests/testthat/test-stub_requests_crul.R c24d49cae84ebb23846bf72d3ecf8161 *tests/testthat/test-to_raise.R ccf0724880b6463a59f62bfbebae8af8 *tests/testthat/test-to_return.R 9f92d8109f878a86758cbec5bb55549a *tests/testthat/test-to_return_body.R 9e35f9dd75b18f18bcc96215c7f840d6 *tests/testthat/test-to_return_then.R 2cb73499631049061b6ad753d97b38f4 *tests/testthat/test-to_timeout.R 2a06dd3cd9b7ce277dfd4e07478c6475 *tests/testthat/test-uri_regex.R d164e049e0cd21276673f5138288a41f *tests/testthat/test-webmockr_reset.R f1e1ce9a8aae50e1b5a6cbc230ccb959 *tests/testthat/test-wi_th.R 0dd04402b142b97ae38c199c92138f6c *tests/testthat/test-within_test_that_blocks.R 36f6188e482a11abf0e26ae2f142f7bc *tests/testthat/test-writing-to-disk-write_disk_path.R 658fa94e4a0b88704981d3484c047855 *tests/testthat/test-writing-to-disk.R bb0513a33a127a0c6ced49ff9aefb40c *tests/testthat/test-zutils.R webmockr/inst/0000755000176200001440000000000014023220041013024 5ustar liggesuserswebmockr/inst/ignore/0000755000176200001440000000000014023220041014307 5ustar liggesuserswebmockr/inst/ignore/adapter-httr.R0000644000176200001440000000520713076516612017060 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/inst/ignore/sockets.R0000644000176200001440000000252212774057045016135 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))) } }