webmockr/0000755000176200001440000000000014377415642012100 5ustar liggesuserswebmockr/NAMESPACE0000644000176200001440000000254214362302441013304 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(StubCounter) 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/LICENSE0000644000176200001440000000005714336066705013104 0ustar liggesusersYEAR: 2022 COPYRIGHT HOLDER: Scott Chamberlain webmockr/man/0000755000176200001440000000000014370732366012651 5ustar liggesuserswebmockr/man/enable.Rd0000644000176200001440000000210014336067430014352 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.Rd0000644000176200001440000000513714336066705015370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \name{HashCounter} \alias{HashCounter} \title{HashCounter} \description{ hash with counter, to store requests, and count each time it is used } \examples{ x <- HashCounter$new() x$hash z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") x$put(z) x$hash x$get(z) x$put(z) x$get(z) } \seealso{ Other request-registry: \code{\link{RequestRegistry}}, \code{\link{request_registry}()} } \concept{request-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{hash}}{(list) a list for internal use only, with elements \code{key}, \code{sig}, and \code{count}} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HashCounter-put}{\code{HashCounter$put()}} \item \href{#method-HashCounter-get}{\code{HashCounter$get()}} \item \href{#method-HashCounter-clone}{\code{HashCounter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HashCounter-put}{}}} \subsection{Method \code{put()}}{ Register a request by it's key \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HashCounter$put(req_sig)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req_sig}}{an object of class \code{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers request and iterates internal counter } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HashCounter-get}{}}} \subsection{Method \code{get()}}{ Get a request by key \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HashCounter$get(req_sig)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req_sig}}{an object of class \code{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ (integer) the count of how many times the request has been made } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HashCounter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HashCounter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/stub_request.Rd0000644000176200001440000001313614300064462015655 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_request.R \name{stub_request} \alias{stub_request} \title{Stub an http request} \usage{ stub_request(method = "get", uri = NULL, uri_regex = NULL) } \arguments{ \item{method}{(character) HTTP method, one of "get", "post", "put", "patch", "head", "delete", "options" - or the special "any" (for any method)} \item{uri}{(character) The request uri. Can be a full or partial uri. \pkg{webmockr} can match uri's without the "http" scheme, but does not match if the scheme is "https". required, unless \code{uri_regex} given. See \link{UriPattern} for more. See the "uri vs. uri_regex" section} \item{uri_regex}{(character) A URI represented as regex. required, if \code{uri} not given. See examples and the "uri vs. uri_regex" section} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub. } \description{ Stub an http request } \details{ Internally, this calls \link{StubbedRequest} which handles the logic See \code{\link[=stub_registry]{stub_registry()}} for listing stubs, \code{\link[=stub_registry_clear]{stub_registry_clear()}} for removing all stubs and \code{\link[=remove_request_stub]{remove_request_stub()}} for removing specific stubs If multiple stubs match the same request, we use the first stub. So if you want to use a stub that was created after an earlier one that matches, remove the earlier one(s). Note on \code{wi_th()}: If you pass \code{query} values are coerced to character class in the recorded stub. You can pass numeric, integer, etc., but all will be coerced to character. See \code{\link[=wi_th]{wi_th()}} for details on request body/query/headers and \code{\link[=to_return]{to_return()}} for details on how response status/body/headers are handled } \note{ Trailing slashes are dropped from stub URIs before matching } \section{uri vs. uri_regex}{ When you use \code{uri}, we compare the URIs without query params AND also the query params themselves without the URIs. When you use \code{uri_regex} we don't compare URIs and query params; we just use your regex string defined in \code{uri_regex} as the pattern for a call to \link{grepl} } \section{Mocking writing to disk}{ See \link{mocking-disk-writing} } \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.Rd0000644000176200001440000000053014113773445017176 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \name{build_crul_response} \alias{build_crul_response} \title{Build a crul response} \usage{ build_crul_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ a crul response } \description{ Build a crul response } webmockr/man/to_timeout.Rd0000644000176200001440000000102514113773445015324 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/to_timeout.R \name{to_timeout} \alias{to_timeout} \title{Set timeout as an expected return on a match} \usage{ to_timeout(.data) } \arguments{ \item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class object} } \value{ an object of class \code{StubbedRequest}, with print method describing the stub } \description{ Set timeout as an expected return on a match } \note{ see examples in \code{\link[=stub_request]{stub_request()}} } webmockr/man/to_raise.Rd0000644000176200001440000000305614336067430014744 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.Rd0000644000176200001440000000125014113773445015267 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.Rd0000644000176200001440000001151714336066705016132 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-RequestPattern-new}{\code{RequestPattern$new()}} \item \href{#method-RequestPattern-matches}{\code{RequestPattern$matches()}} \item \href{#method-RequestPattern-to_s}{\code{RequestPattern$to_s()}} \item \href{#method-RequestPattern-clone}{\code{RequestPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{RequestPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$new( method, uri = NULL, uri_regex = NULL, query = NULL, body = NULL, headers = NULL )}\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-RequestPattern-matches}{}}} \subsection{Method \code{matches()}}{ does a request signature match the selected matchers? \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$matches(request_signature)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_signature}}{a \link{RequestSignature} object} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/build_httr_request.Rd0000644000176200001440000000050714113773445017050 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{build_httr_request} \alias{build_httr_request} \title{Build a httr request} \usage{ build_httr_request(x) } \arguments{ \item{x}{an unexecuted httr request object} } \value{ a httr request } \description{ Build a httr request } webmockr/man/UriPattern.Rd0000644000176200001440000001762614336066705015250 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-UriPattern-new}{\code{UriPattern$new()}} \item \href{#method-UriPattern-matches}{\code{UriPattern$matches()}} \item \href{#method-UriPattern-pattern_matches}{\code{UriPattern$pattern_matches()}} \item \href{#method-UriPattern-query_params_matches}{\code{UriPattern$query_params_matches()}} \item \href{#method-UriPattern-extract_query}{\code{UriPattern$extract_query()}} \item \href{#method-UriPattern-add_query_params}{\code{UriPattern$add_query_params()}} \item \href{#method-UriPattern-to_s}{\code{UriPattern$to_s()}} \item \href{#method-UriPattern-clone}{\code{UriPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{UriPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$new(pattern = NULL, regex_pattern = NULL)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) a uri, as a character string. if scheme is missing, it is added (we assume http)} \item{\code{regex_pattern}}{(character) a uri as a regex character string, see \link[base:regex]{base::regex}. if scheme is missing, it is added (we assume http)} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{UriPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-matches}{}}} \subsection{Method \code{matches()}}{ Match a uri against a pattern \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$matches(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-pattern_matches}{}}} \subsection{Method \code{pattern_matches()}}{ Match a URI \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$pattern_matches(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-query_params_matches}{}}} \subsection{Method \code{query_params_matches()}}{ Match query parameters of a URI \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$query_params_matches(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-extract_query}{}}} \subsection{Method \code{extract_query()}}{ Extract query parameters as a named list \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$extract_query(uri)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{uri}}{(character) a uri} } \if{html}{\out{
}} } \subsection{Returns}{ named list, or \code{NULL} if no query parameters } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-add_query_params}{}}} \subsection{Method \code{add_query_params()}}{ Add query parameters to the URI \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$add_query_params(query_params)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{query_params}}{(list|character) list or character} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned, updates uri pattern } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-UriPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{UriPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/build_httr_response.Rd0000644000176200001440000000053014113773445017212 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-httr.R \name{build_httr_response} \alias{build_httr_response} \title{Build a httr response} \usage{ build_httr_response(req, resp) } \arguments{ \item{req}{a request} \item{resp}{a response} } \value{ a httr response } \description{ Build a httr response } webmockr/man/webmockr_enable-defunct.Rd0000644000176200001440000000040514113773445017702 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{webmockr_enable} \alias{webmockr_enable} \title{This function is defunct.} \usage{ webmockr_enable(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/stub_registry.Rd0000644000176200001440000000165414113773445016051 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_registry.R \name{stub_registry} \alias{stub_registry} \title{List stubs in the stub registry} \usage{ stub_registry() } \value{ an object of class \code{StubRegistry}, print method gives the stubs in the registry } \description{ List stubs in the stub registry } \examples{ # make a stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = "success!", status = 200) # check the stub registry, there should be one in there stub_registry() # make another stub stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = "woopsy", status = 404) # check the stub registry, now there are two there stub_registry() # to clear the stub registry stub_registry_clear() } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}()}, \code{\link{stub_registry_clear}()} } \concept{stub-registry} webmockr/man/wi_th.Rd0000644000176200001440000000641314113773445014254 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.Rd0000644000176200001440000000404614113773445017202 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.Rd0000644000176200001440000002215114336067430014514 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-CrulAdapter-clone}{\code{CrulAdapter$clone()}} } } \if{html}{\out{
Inherited methods
}} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-CrulAdapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{CrulAdapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } \section{Super class}{ \code{\link[webmockr:Adapter]{webmockr::Adapter}} -> \code{HttrAdapter} } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HttrAdapter-clone}{\code{HttrAdapter$clone()}} } } \if{html}{\out{
Inherited methods
}} \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttrAdapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttrAdapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{client}}{HTTP client package name} \item{\code{name}}{adapter name} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-Adapter-new}{\code{Adapter$new()}} \item \href{#method-Adapter-enable}{\code{Adapter$enable()}} \item \href{#method-Adapter-disable}{\code{Adapter$disable()}} \item \href{#method-Adapter-handle_request}{\code{Adapter$handle_request()}} \item \href{#method-Adapter-remove_stubs}{\code{Adapter$remove_stubs()}} \item \href{#method-Adapter-clone}{\code{Adapter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-new}{}}} \subsection{Method \code{new()}}{ Create a new Adapter object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$new()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-enable}{}}} \subsection{Method \code{enable()}}{ Enable the adapter \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$enable(quiet = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{quiet}}{(logical) suppress messages? default: \code{FALSE}} } \if{html}{\out{
}} } \subsection{Returns}{ \code{TRUE}, invisibly } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-disable}{}}} \subsection{Method \code{disable()}}{ Disable the adapter \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$disable(quiet = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{quiet}}{(logical) suppress messages? default: \code{FALSE}} } \if{html}{\out{
}} } \subsection{Returns}{ \code{FALSE}, invisibly } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-handle_request}{}}} \subsection{Method \code{handle_request()}}{ All logic for handling a request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$handle_request(req)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req}}{a request} } \if{html}{\out{
}} } \subsection{Returns}{ various outcomes } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-remove_stubs}{}}} \subsection{Method \code{remove_stubs()}}{ Remove all stubs \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$remove_stubs()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; removes all request stubs } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Adapter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Adapter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/to_return_-defunct.Rd0000644000176200001440000000036614113773445016751 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{to_return_} \alias{to_return_} \title{This function is defunct.} \usage{ to_return_(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/wi_th_-defunct.Rd0000644000176200001440000000035214113773445016035 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{wi_th_} \alias{wi_th_} \title{This function is defunct.} \usage{ wi_th_(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/webmockr-package.Rd0000644000176200001440000000151414336067430016336 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.Rd0000644000176200001440000001013514336067430015154 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.Rd0000644000176200001440000000103614113773445015130 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.Rd0000644000176200001440000000041014113773445020053 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{webmockr_disable} \alias{webmockr_disable} \title{This function is defunct.} \usage{ webmockr_disable(...) } \description{ This function is defunct. } \keyword{internal} webmockr/man/Response.Rd0000644000176200001440000002336014336066705014741 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/Response.R \name{Response} \alias{Response} \title{Response} \description{ custom webmockr http response class } \examples{ \dontrun{ (x <- Response$new()) x$set_url("https://httpbin.org/get") x x$set_request_headers(list('Content-Type' = "application/json")) x x$request_headers x$set_response_headers(list('Host' = "httpbin.org")) x x$response_headers x$set_status(404) x x$get_status() x$set_body("hello world") x x$get_body() # raw body x$set_body(charToRaw("hello world")) x x$get_body() x$set_exception("exception") x x$get_exception() } } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{url}}{(character) a url} \item{\code{body}}{(various) list, character, etc} \item{\code{content}}{(various) response content/body} \item{\code{request_headers}}{(list) a named list} \item{\code{response_headers}}{(list) a named list} \item{\code{options}}{(character) list} \item{\code{status_code}}{(integer) an http status code} \item{\code{exception}}{(character) an exception message} \item{\code{should_timeout}}{(logical) should the response timeout?} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-Response-new}{\code{Response$new()}} \item \href{#method-Response-print}{\code{Response$print()}} \item \href{#method-Response-set_url}{\code{Response$set_url()}} \item \href{#method-Response-get_url}{\code{Response$get_url()}} \item \href{#method-Response-set_request_headers}{\code{Response$set_request_headers()}} \item \href{#method-Response-get_request_headers}{\code{Response$get_request_headers()}} \item \href{#method-Response-set_response_headers}{\code{Response$set_response_headers()}} \item \href{#method-Response-get_respone_headers}{\code{Response$get_respone_headers()}} \item \href{#method-Response-set_body}{\code{Response$set_body()}} \item \href{#method-Response-get_body}{\code{Response$get_body()}} \item \href{#method-Response-set_status}{\code{Response$set_status()}} \item \href{#method-Response-get_status}{\code{Response$get_status()}} \item \href{#method-Response-set_exception}{\code{Response$set_exception()}} \item \href{#method-Response-get_exception}{\code{Response$get_exception()}} \item \href{#method-Response-clone}{\code{Response$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{Response} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$new(options = list())}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{options}}{(list) a list of options} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{Response} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{Response} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_url}{}}} \subsection{Method \code{set_url()}}{ set the url for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_url(url)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{url}}{(character) a url} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets url } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_url}{}}} \subsection{Method \code{get_url()}}{ get the url for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_url()}\if{html}{\out{
}} } \subsection{Returns}{ (character) a url } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_request_headers}{}}} \subsection{Method \code{set_request_headers()}}{ set the request headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_request_headers(headers, capitalize = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{(list) named list} \item{\code{capitalize}}{(logical) whether to capitalize first letters of each header; default: \code{TRUE}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets request headers on the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_request_headers}{}}} \subsection{Method \code{get_request_headers()}}{ get the request headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_request_headers()}\if{html}{\out{
}} } \subsection{Returns}{ (list) request headers, a named list } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_response_headers}{}}} \subsection{Method \code{set_response_headers()}}{ set the response headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_response_headers(headers, capitalize = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{(list) named list} \item{\code{capitalize}}{(logical) whether to capitalize first letters of each header; default: \code{TRUE}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets response headers on the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_respone_headers}{}}} \subsection{Method \code{get_respone_headers()}}{ get the response headers for the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_respone_headers()}\if{html}{\out{
}} } \subsection{Returns}{ (list) response headers, a named list } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_body}{}}} \subsection{Method \code{set_body()}}{ set the body of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_body(body, disk = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{body}}{(various types)} \item{\code{disk}}{(logical) whether its on disk; default: \code{FALSE}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets body on the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_body}{}}} \subsection{Method \code{get_body()}}{ get the body of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_body()}\if{html}{\out{
}} } \subsection{Returns}{ various } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_status}{}}} \subsection{Method \code{set_status()}}{ set the http status of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_status(status)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{status}}{(integer) the http status} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets the http status of the response } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_status}{}}} \subsection{Method \code{get_status()}}{ get the http status of the response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_status()}\if{html}{\out{
}} } \subsection{Returns}{ (integer) the http status } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-set_exception}{}}} \subsection{Method \code{set_exception()}}{ set an exception \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$set_exception(exception)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{exception}}{(character) an exception string} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets an exception } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-get_exception}{}}} \subsection{Method \code{get_exception()}}{ get the exception, if set \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$get_exception()}\if{html}{\out{
}} } \subsection{Returns}{ (character) an exception } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-Response-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{Response$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/StubCounter.Rd0000644000176200001440000000445514362302636015417 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/StubbedRequest.R \name{StubCounter} \alias{StubCounter} \title{StubCounter} \description{ hash with counter to store requests and count number of requests made against the stub } \examples{ x <- StubCounter$new() x x$hash x$count() z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") x$put(z) x$count() x$put(z) x$count() } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{hash}}{(list) a list for internal use only, with elements \code{key}, \code{sig}, and \code{count}} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-StubCounter-put}{\code{StubCounter$put()}} \item \href{#method-StubCounter-count}{\code{StubCounter$count()}} \item \href{#method-StubCounter-clone}{\code{StubCounter$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubCounter-put}{}}} \subsection{Method \code{put()}}{ Register a request by it's key \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubCounter$put(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{an object of class \code{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers request & iterates internal counter } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubCounter-count}{}}} \subsection{Method \code{count()}}{ Get the count of number of times any matching request has been made against this stub \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubCounter$count()}\if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubCounter-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubCounter$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/build_crul_request.Rd0000644000176200001440000000050714113773445017034 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/adapter-crul.R \name{build_crul_request} \alias{build_crul_request} \title{Build a crul request} \usage{ build_crul_request(x) } \arguments{ \item{x}{an unexecuted crul request object} } \value{ a crul request } \description{ Build a crul request } webmockr/man/request_registry.Rd0000644000176200001440000000261214113773445016557 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/request_registry.R \name{request_registry} \alias{request_registry} \alias{request_registry_clear} \title{List or clear requests in the request registry} \usage{ request_registry() request_registry_clear() } \value{ an object of class \code{RequestRegistry}, print method gives the requests in the registry and the number of times each one has been performed } \description{ List or clear requests in the request registry } \details{ \code{request_registry()} lists the requests that have been made that webmockr knows about; \code{request_registry_clear()} resets the request registry (removes all recorded requests) } \examples{ webmockr::enable() stub_request("get", "https://httpbin.org/get") \%>\% to_return(body = "success!", status = 200) # nothing in the request registry request_registry() # make the request z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") # check the request registry - the request was made 1 time request_registry() # do the request again z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") # check the request registry - now it's been made 2 times, yay! request_registry() # clear the request registry request_registry_clear() webmockr::disable() } \seealso{ Other request-registry: \code{\link{HashCounter}}, \code{\link{RequestRegistry}} } \concept{request-registry} webmockr/man/webmockr-defunct.Rd0000644000176200001440000000112114113773445016370 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/defunct.R \name{webmockr-defunct} \alias{webmockr-defunct} \title{Defunct functions in \pkg{webmockr}} \description{ \itemize{ \item \code{\link[=webmockr_enable]{webmockr_enable()}}: Function removed, see \code{\link[=enable]{enable()}} \item \code{\link[=webmockr_disable]{webmockr_disable()}}: Function removed, see \code{\link[=disable]{disable()}} \item \link{to_return_}: Only \code{\link[=to_return]{to_return()}} is available now \item \link{wi_th_}: Only \code{\link[=wi_th]{wi_th()}} is available now } } webmockr/man/stub_registry_clear.Rd0000644000176200001440000000110014113773445017201 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/stub_registry_clear.R \name{stub_registry_clear} \alias{stub_registry_clear} \title{stub_registry_clear} \usage{ stub_registry_clear() } \value{ an empty list invisibly } \description{ Clear all stubs in the stub registry } \examples{ (x <- stub_request("get", "https://httpbin.org/get")) stub_registry() stub_registry_clear() stub_registry() } \seealso{ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}()}, \code{\link{stub_registry}()} } \concept{stub-registry} webmockr/man/pipe.Rd0000644000176200001440000000031714113773445014074 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/pipe.R \name{\%>\%} \alias{\%>\%} \title{Pipe operator} \usage{ lhs \%>\% rhs } \description{ Pipe operator } \keyword{internal} webmockr/man/mock_file.Rd0000644000176200001440000000075214113773445015072 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.Rd0000644000176200001440000001171514336066705016325 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestRegistry.R \name{RequestRegistry} \alias{RequestRegistry} \title{RequestRegistry} \description{ keeps track of HTTP requests } \examples{ x <- RequestRegistry$new() z1 <- RequestSignature$new("get", "http://scottchamberlain.info") z2 <- RequestSignature$new("post", "https://httpbin.org/post") x$register_request(request = z1) x$register_request(request = z1) x$register_request(request = z2) # print method to list requests x # more complex requests w <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) w$to_s() x$register_request(request = w) x # hashes, and number of times each requested x$request_signatures$hash # times_executed method pat <- RequestPattern$new( method = "get", uri = "https:/httpbin.org/get", headers = list(`User-Agent` = "foobar", stuff = "things") ) pat$to_s() x$times_executed(pat) z <- RequestPattern$new(method = "get", uri = "http://scottchamberlain.info") x$times_executed(z) w <- RequestPattern$new(method = "post", uri = "https://httpbin.org/post") x$times_executed(w) ## pattern with no matches - returns 0 (zero) pat <- RequestPattern$new( method = "get", uri = "http://recology.info/" ) pat$to_s() x$times_executed(pat) # reset the request registry x$reset() } \seealso{ \code{\link[=stub_registry]{stub_registry()}} and \link{StubRegistry} Other request-registry: \code{\link{HashCounter}}, \code{\link{request_registry}()} } \concept{request-registry} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{request_signatures}}{a HashCounter object} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-RequestRegistry-print}{\code{RequestRegistry$print()}} \item \href{#method-RequestRegistry-reset}{\code{RequestRegistry$reset()}} \item \href{#method-RequestRegistry-register_request}{\code{RequestRegistry$register_request()}} \item \href{#method-RequestRegistry-times_executed}{\code{RequestRegistry$times_executed()}} \item \href{#method-RequestRegistry-clone}{\code{RequestRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{RequestRegistry} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-reset}{}}} \subsection{Method \code{reset()}}{ Reset the registry to no registered requests \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$reset()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; ressets registry to no requests } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-register_request}{}}} \subsection{Method \code{register_request()}}{ Register a request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$register_request(request)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request}}{a character string of the request, serialized from a \code{RequestSignature$new(...)$to_s()}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers the request } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-times_executed}{}}} \subsection{Method \code{times_executed()}}{ How many times has a request been made \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$times_executed(request_pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_pattern}}{an object of class \code{RequestPattern}} } \if{html}{\out{
}} } \subsection{Details}{ if no match is found for the request pattern, 0 is returned } \subsection{Returns}{ integer, the number of times the request has been made } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestRegistry-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestRegistry$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/webmockr_configure.Rd0000644000176200001440000000364514370732366017022 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr-opts.R \name{webmockr_configure} \alias{webmockr_configure} \alias{webmockr_configure_reset} \alias{webmockr_configuration} \alias{webmockr_allow_net_connect} \alias{webmockr_disable_net_connect} \alias{webmockr_net_connect_allowed} \title{webmockr configuration} \usage{ webmockr_configure( allow_net_connect = FALSE, allow_localhost = FALSE, allow = NULL, show_stubbing_instructions = TRUE ) webmockr_configure_reset() webmockr_configuration() webmockr_allow_net_connect() webmockr_disable_net_connect(allow = NULL) webmockr_net_connect_allowed(uri = NULL) } \arguments{ \item{allow_net_connect}{(logical) Default: \code{FALSE}} \item{allow_localhost}{(logical) Default: \code{FALSE}} \item{allow}{(character) one or more URI/URL to allow (and by extension all others are not allowed)} \item{show_stubbing_instructions}{(logical) Default: \code{TRUE}. If \code{FALSE}, stubbing instructions are not shown} \item{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.Rd0000644000176200001440000000707014361011740015361 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-BodyPattern-new}{\code{BodyPattern$new()}} \item \href{#method-BodyPattern-matches}{\code{BodyPattern$matches()}} \item \href{#method-BodyPattern-to_s}{\code{BodyPattern$to_s()}} \item \href{#method-BodyPattern-clone}{\code{BodyPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{BodyPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$new(pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(list) a body object} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{BodyPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-matches}{}}} \subsection{Method \code{matches()}}{ Match a request body pattern against a pattern \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$matches(body, content_type = "")}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{body}}{(list) the body} \item{\code{content_type}}{(character) content type} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-BodyPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{BodyPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/webmockr_crul_fetch.Rd0000644000176200001440000000050114113773445017141 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \name{webmockr_crul_fetch} \alias{webmockr_crul_fetch} \title{execute a curl request} \usage{ webmockr_crul_fetch(x) } \arguments{ \item{x}{an object} } \value{ a curl response } \description{ execute a curl request } \keyword{internal} webmockr/man/StubRegistry.Rd0000644000176200001440000001441214362302636015602 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-StubRegistry-print}{\code{StubRegistry$print()}} \item \href{#method-StubRegistry-register_stub}{\code{StubRegistry$register_stub()}} \item \href{#method-StubRegistry-find_stubbed_request}{\code{StubRegistry$find_stubbed_request()}} \item \href{#method-StubRegistry-request_stub_for}{\code{StubRegistry$request_stub_for()}} \item \href{#method-StubRegistry-remove_request_stub}{\code{StubRegistry$remove_request_stub()}} \item \href{#method-StubRegistry-remove_all_request_stubs}{\code{StubRegistry$remove_all_request_stubs()}} \item \href{#method-StubRegistry-is_registered}{\code{StubRegistry$is_registered()}} \item \href{#method-StubRegistry-clone}{\code{StubRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{StubRegistry} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-register_stub}{}}} \subsection{Method \code{register_stub()}}{ Register a stub \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$register_stub(stub)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{stub}}{an object of type \link{StubbedRequest}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers the stub } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-find_stubbed_request}{}}} \subsection{Method \code{find_stubbed_request()}}{ Find a stubbed request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$find_stubbed_request(req)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{req}}{an object of class \link{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ an object of type \link{StubbedRequest}, if matched } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-request_stub_for}{}}} \subsection{Method \code{request_stub_for()}}{ Find a stubbed request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$request_stub_for(request_signature, count = TRUE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{request_signature}}{an object of class \link{RequestSignature}} \item{\code{count}}{(bool) iterate counter or not. default: \code{TRUE}} } \if{html}{\out{
}} } \subsection{Returns}{ logical, 1 or more } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-remove_request_stub}{}}} \subsection{Method \code{remove_request_stub()}}{ Remove a stubbed request by matching request signature \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$remove_request_stub(stub)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{stub}}{an object of type \link{StubbedRequest}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; removes the stub from the registry } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-remove_all_request_stubs}{}}} \subsection{Method \code{remove_all_request_stubs()}}{ Remove all request stubs \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$remove_all_request_stubs()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; removes all request stubs } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-is_registered}{}}} \subsection{Method \code{is_registered()}}{ Find a stubbed request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubRegistry$is_registered(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{an object of class \link{RequestSignature}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; registers the stub } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubRegistry-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.Rd0000644000176200001440000000121114113773445016144 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/webmockr_reset.R \name{webmockr_reset} \alias{webmockr_reset} \title{webmockr_reset} \usage{ webmockr_reset() } \value{ nothing } \description{ Clear all stubs and the request counter } \details{ this function runs \code{\link[=stub_registry_clear]{stub_registry_clear()}} and \code{\link[=request_registry_clear]{request_registry_clear()}} - so you can run those two yourself to achieve the same thing } \examples{ # webmockr_reset() } \seealso{ \code{\link[=stub_registry_clear]{stub_registry_clear()}} \code{\link[=request_registry_clear]{request_registry_clear()}} } webmockr/man/HttpLibAdapaterRegistry.Rd0000644000176200001440000000472414336066705017707 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/HttpLibAdapterRegistry.R \name{HttpLibAdapaterRegistry} \alias{HttpLibAdapaterRegistry} \title{HttpLibAdapaterRegistry} \description{ http lib adapter registry } \examples{ x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) x x$adapters x$adapters[[1]]$name } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{adapters}}{list} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HttpLibAdapaterRegistry-print}{\code{HttpLibAdapaterRegistry$print()}} \item \href{#method-HttpLibAdapaterRegistry-register}{\code{HttpLibAdapaterRegistry$register()}} \item \href{#method-HttpLibAdapaterRegistry-clone}{\code{HttpLibAdapaterRegistry$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttpLibAdapaterRegistry-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{HttpLibAdapaterRegistry} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttpLibAdapaterRegistry$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttpLibAdapaterRegistry-register}{}}} \subsection{Method \code{register()}}{ Register an http library adapter \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttpLibAdapaterRegistry$register(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{an http lib adapter, e.g., \link{CrulAdapter}} } \if{html}{\out{
}} } \subsection{Returns}{ nothing, registers the library adapter } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HttpLibAdapaterRegistry-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HttpLibAdapaterRegistry$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/StubbedRequest.Rd0000644000176200001440000002127114362302441016070 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} \item{\code{counter}}{a StubCounter object} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-StubbedRequest-new}{\code{StubbedRequest$new()}} \item \href{#method-StubbedRequest-print}{\code{StubbedRequest$print()}} \item \href{#method-StubbedRequest-with}{\code{StubbedRequest$with()}} \item \href{#method-StubbedRequest-to_return}{\code{StubbedRequest$to_return()}} \item \href{#method-StubbedRequest-to_timeout}{\code{StubbedRequest$to_timeout()}} \item \href{#method-StubbedRequest-to_raise}{\code{StubbedRequest$to_raise()}} \item \href{#method-StubbedRequest-to_s}{\code{StubbedRequest$to_s()}} \item \href{#method-StubbedRequest-reset}{\code{StubbedRequest$reset()}} \item \href{#method-StubbedRequest-clone}{\code{StubbedRequest$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{StubbedRequest} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$new(method, uri = NULL, uri_regex = NULL)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{the HTTP method (any, head, get, post, put, patch, or delete). "any" matches any HTTP method. required.} \item{\code{uri}}{(character) request URI. either this or \code{uri_regex} required. \pkg{webmockr} can match uri's without the "http" scheme, but does not match if the scheme is "https". required, unless \code{uri_regex} given. See \link{UriPattern} for more.} \item{\code{uri_regex}}{(character) request URI as regex. either this or \code{uri} required} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{StubbedRequest} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{StubbedRequest} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$print(x, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-with}{}}} \subsection{Method \code{with()}}{ Set expectations for what's given in HTTP request \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$with( query = NULL, body = NULL, headers = NULL, basic_auth = NULL )}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{query}}{(list) request query params, as a named list. optional} \item{\code{body}}{(list) request body, as a named list. optional} \item{\code{headers}}{(list) request headers as a named list. optional.} \item{\code{basic_auth}}{(character) basic authentication. optional.} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned; sets only } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_return}{}}} \subsection{Method \code{to_return()}}{ Set expectations for what's returned in HTTP response \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_return(status, body, headers)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{status}}{(numeric) an HTTP status code} \item{\code{body}}{(list) response body, one of: \code{character}, \code{json}, \code{list}, \code{raw}, \code{numeric}, \code{NULL}, \code{FALSE}, or a file connection (other 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-StubbedRequest-to_timeout}{}}} \subsection{Method \code{to_timeout()}}{ Response should time out \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_timeout()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_raise}{}}} \subsection{Method \code{to_raise()}}{ Response should raise an exception \code{x} \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_raise(x)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{(character) an exception message} } \if{html}{\out{
}} } \subsection{Returns}{ nothing returned } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-to_s}{}}} \subsection{Method \code{to_s()}}{ Response as a character string \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ (character) the response as a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-reset}{}}} \subsection{Method \code{reset()}}{ Reset the counter for the stub \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$reset()}\if{html}{\out{
}} } \subsection{Returns}{ nothing returned; resets stub counter to no requests } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-StubbedRequest-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{StubbedRequest$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/MethodPattern.Rd0000644000176200001440000000576214336066705015727 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{MethodPattern} \alias{MethodPattern} \title{MethodPattern} \description{ method matcher } \details{ Matches regardless of case. e.g., POST will match to post } \examples{ (x <- MethodPattern$new(pattern = "post")) x$pattern x$matches(method = "post") x$matches(method = "POST") # all matches() calls should be TRUE (x <- MethodPattern$new(pattern = "any")) x$pattern x$matches(method = "post") x$matches(method = "GET") x$matches(method = "HEAD") } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) an http method} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-MethodPattern-new}{\code{MethodPattern$new()}} \item \href{#method-MethodPattern-matches}{\code{MethodPattern$matches()}} \item \href{#method-MethodPattern-to_s}{\code{MethodPattern$to_s()}} \item \href{#method-MethodPattern-clone}{\code{MethodPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{MethodPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$new(pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(character) a HTTP method, lowercase} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{MethodPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-matches}{}}} \subsection{Method \code{matches()}}{ test if the pattern matches a given http method \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$matches(method)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(character) a HTTP method, lowercase} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-MethodPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{MethodPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/HeadersPattern.Rd0000644000176200001440000001045714336066705016057 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestPattern.R \name{HeadersPattern} \alias{HeadersPattern} \title{HeadersPattern} \description{ headers matcher } \details{ \code{webmockr} normalises headers and treats all forms of same headers as equal: i.e the following two sets of headers are equal: \code{list(Header1 = "value1", content_length = 123, X_CuStOm_hEAder = "foo")} and \code{list(header1 = "value1", "Content-Length" = 123, "x-cuSTOM-HeAder" = "foo")} } \examples{ (x <- HeadersPattern$new(pattern = list(a = 5))) x$pattern x$matches(list(a = 5)) # different cases (x <- HeadersPattern$new(pattern = list(Header1 = "value1"))) x$pattern x$matches(list(header1 = "value1")) x$matches(list(header1 = "value2")) # different symbols (x <- HeadersPattern$new(pattern = list(`Hello_World` = "yep"))) x$pattern x$matches(list(`hello-world` = "yep")) x$matches(list(`hello-worlds` = "yep")) headers <- list( 'User-Agent' = 'Apple', 'Accept-Encoding' = 'gzip, deflate', 'Accept' = 'application/json, text/xml, application/xml, */*') (x <- HeadersPattern$new(pattern = headers)) x$to_s() x$pattern x$matches(headers) } \keyword{internal} \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{a list} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-HeadersPattern-new}{\code{HeadersPattern$new()}} \item \href{#method-HeadersPattern-matches}{\code{HeadersPattern$matches()}} \item \href{#method-HeadersPattern-empty_headers}{\code{HeadersPattern$empty_headers()}} \item \href{#method-HeadersPattern-to_s}{\code{HeadersPattern$to_s()}} \item \href{#method-HeadersPattern-clone}{\code{HeadersPattern$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{HeadersPattern} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$new(pattern)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{pattern}}{(list) a pattern, as a named list, must be named, e.g,. \code{list(a = 5, b = 6)}} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{HeadersPattern} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-matches}{}}} \subsection{Method \code{matches()}}{ Match a list of headers against that stored \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$matches(headers)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{(list) named list of headers, e.g,. \code{list(a = 5, b = 6)}} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-empty_headers}{}}} \subsection{Method \code{empty_headers()}}{ Are headers empty? tests if null or length==0 \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$empty_headers(headers)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{headers}}{named list of headers} } \if{html}{\out{
}} } \subsection{Returns}{ a boolean } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-to_s}{}}} \subsection{Method \code{to_s()}}{ Print pattern for easy human consumption \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a string } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-HeadersPattern-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{HeadersPattern$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/RequestSignature.Rd0000644000176200001440000001023214336066705016447 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/RequestSignature.R \name{RequestSignature} \alias{RequestSignature} \title{RequestSignature} \description{ General purpose request signature builder } \examples{ # make request signature x <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") # method x$method # uri x$uri # request signature to string x$to_s() # headers w <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) ) w w$headers w$to_s() # headers and body bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list( headers = list(`User-Agent` = "foobar", stuff = "things"), body = list(a = "tables") ) ) bb bb$headers bb$body bb$to_s() # with disk path f <- tempfile() bb <- RequestSignature$new( method = "get", uri = "https:/httpbin.org/get", options = list(disk = f) ) bb bb$disk bb$to_s() } \section{Public fields}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{(character) an http method} \item{\code{uri}}{(character) a uri} \item{\code{body}}{(various) request body} \item{\code{headers}}{(list) named list of headers} \item{\code{proxies}}{(list) proxies as a named list} \item{\code{auth}}{(list) authentication details, as a named list} \item{\code{url}}{internal use} \item{\code{disk}}{(character) if writing to disk, the path} \item{\code{fields}}{(various) request body details} \item{\code{output}}{(various) request output details, disk, memory, etc} } \if{html}{\out{
}} } \section{Methods}{ \subsection{Public methods}{ \itemize{ \item \href{#method-RequestSignature-new}{\code{RequestSignature$new()}} \item \href{#method-RequestSignature-print}{\code{RequestSignature$print()}} \item \href{#method-RequestSignature-to_s}{\code{RequestSignature$to_s()}} \item \href{#method-RequestSignature-clone}{\code{RequestSignature$clone()}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-new}{}}} \subsection{Method \code{new()}}{ Create a new \code{RequestSignature} object \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$new(method, uri, options = list())}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{method}}{the HTTP method (any, head, options, get, post, put, patch, trace, or delete). "any" matches any HTTP method. required.} \item{\code{uri}}{(character) request URI. required.} \item{\code{options}}{(list) options. optional. See Details.} } \if{html}{\out{
}} } \subsection{Returns}{ A new \code{RequestSignature} object } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-print}{}}} \subsection{Method \code{print()}}{ print method for the \code{RequestSignature} class \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$print()}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{x}}{self} \item{\code{...}}{ignored} } \if{html}{\out{
}} } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-to_s}{}}} \subsection{Method \code{to_s()}}{ Request signature to a string \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$to_s()}\if{html}{\out{
}} } \subsection{Returns}{ a character string representation of the request signature } } \if{html}{\out{
}} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-RequestSignature-clone}{}}} \subsection{Method \code{clone()}}{ The objects of this class are cloneable with this method. \subsection{Usage}{ \if{html}{\out{
}}\preformatted{RequestSignature$clone(deep = FALSE)}\if{html}{\out{
}} } \subsection{Arguments}{ \if{html}{\out{
}} \describe{ \item{\code{deep}}{Whether to make a deep clone.} } \if{html}{\out{
}} } } } webmockr/man/remove_request_stub.Rd0000644000176200001440000000124714113773445017244 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/DESCRIPTION0000644000176200001440000000340314377415642013606 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.9.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 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.2.3 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: 2023-02-28 14:32:51 UTC; sckott Author: Scott Chamberlain [aut, cre] (), Aaron Wolen [ctb] (), rOpenSci [fnd] (https://ropensci.org) Maintainer: Scott Chamberlain Repository: CRAN Date/Publication: 2023-02-28 15:20:02 UTC webmockr/tests/0000755000176200001440000000000014113773445013236 5ustar liggesuserswebmockr/tests/test-all.R0000644000176200001440000000005314113773445015104 0ustar liggesuserslibrary("testthat") test_check("webmockr") webmockr/tests/testthat/0000755000176200001440000000000014377303202015066 5ustar liggesuserswebmockr/tests/testthat/test-StubbedRequest.R0000644000176200001440000001400514113773445021137 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.R0000644000176200001440000000473014113773445020173 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.R0000644000176200001440000001246414364046756020234 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") }) stub_to_return_status_code <- function() { stub_registry()$request_stubs[[1]]$responses_sequences[[1]]$status } stub_registry_clear() enable() test_that("stub_request status accepts numeric or integer values", { stub_status_type_a <- stub_request("get", "https://httpbin.org/get") expect_s3_class(to_return(stub_status_type_a, status = 200), "StubbedRequest") expect_type(stub_to_return_status_code(), "double") # numeric = double stub_registry_clear() stub_status_type_b <- stub_request("get", "https://httpbin.org/get") expect_s3_class(to_return(stub_status_type_b, status = 200L), "StubbedRequest") expect_type(stub_to_return_status_code(), "integer") }) disable() webmockr/tests/testthat/httr_obj_auth.rda0000644000176200001440000000055714113773445020431 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.R0000644000176200001440000001514714370732366017542 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("config options: show_stubbing_instructions") test_that("show_stubbing_instructions", { x = crul::HttpClient$new("https://httpbin.org/get") # DO show stubbing instructions webmockr_configure(show_stubbing_instructions = TRUE) err_mssg <- as.character(tryCatch(x$get(), error = function(e) e)) expect_true(grepl("snippet", err_mssg, perl = TRUE)) # DO NOT show stubbing instructions webmockr_configure(show_stubbing_instructions = FALSE) err_mssg <- as.character(tryCatch(x$get(), error = function(e) e)) expect_false(grepl("^((?!snippet).)*$", err_mssg, perl = TRUE)) # reset to default webmockr_configure(show_stubbing_instructions = TRUE) }) context("util fxns: webmockr_configuration") test_that("webmockr_configuration", { expect_is(webmockr_configuration(), "webmockr_config") expect_named( webmockr_configuration(), c('show_stubbing_instructions', 'allow', 'allow_net_connect', 'allow_localhost') ) # errors when an argument passed expect_error(webmockr_configuration(5), "unused argument") }) context("util fxns: webmockr_configure_reset") test_that("webmockr_configure_reset", { # webmockr_configure_reset does the same thing as webmockr_configure expect_identical(webmockr_configure(), webmockr_configure_reset()) # errors when an argument passed expect_error(webmockr_configure_reset(5), "unused argument") }) context("util fxns: defunct") test_that("webmockr_disable", { expect_error(webmockr_disable(), "disable", class = "error") }) test_that("webmockr_enable", { expect_error(webmockr_enable(), "enable", class = "error") }) context("util fxns: hdl_lst") test_that("hdl_lst works", { expect_equal(hdl_lst(NULL), "") expect_equal(hdl_lst(character(0)), "") expect_equal(hdl_lst(raw(0)), "") expect_equal(hdl_lst(raw(5)), "raw bytes, length: 5") expect_error(hdl_lst(), "argument \"x\" is missing") expect_equal(hdl_lst(list(foo = "bar")), "foo=bar") expect_equal(hdl_lst(list(foo = "5")), "foo=5") expect_equal(hdl_lst(list(foo = "5", bar = "a")), "foo=5, bar=a") expect_equal(hdl_lst(1.5), 1.5) }) context("util fxns: hdl_lst2") test_that("hdl_lst2 works", { expect_equal(hdl_lst2(NULL), "") expect_equal(hdl_lst2(character(0)), "") expect_equal(hdl_lst2(raw(5)), "") expect_equal(hdl_lst2(charToRaw("hello")), "hello") expect_error(hdl_lst2(), "argument \"x\" is missing") expect_equal(hdl_lst2(list(foo = "bar")), "foo=\"bar\"") expect_equal(hdl_lst2(list(foo = 5)), "foo=5") expect_equal(hdl_lst2(list(foo = 5, bar = "a")), "foo=5, bar=\"a\"") expect_equal(hdl_lst2(list(foo = "bar", stuff = FALSE)), "foo=\"bar\", stuff=FALSE") expect_equal(hdl_lst2(1.5), 1.5) }) context("query_mapper") test_that("query_mapper", { expect_is(query_mapper, "function") expect_null(query_mapper(NULL)) expect_equal(query_mapper(5), 5) expect_equal(query_mapper('aaa'), 'aaa') expect_equal(query_mapper(mtcars), mtcars) }) webmockr/tests/testthat/httr_obj.rda0000644000176200001440000000050314113773445017377 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.R0000644000176200001440000000317114113773445020354 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.R0000644000176200001440000000165414113773445022306 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.R0000644000176200001440000000170114113773445021210 0ustar liggesuserscontext("webmockr_reset") stub_registry_clear() request_registry_clear() enable() test_that("webmockr_reset works", { # before any stubs creatd expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) expect_null(webmockr_reset()) expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) # after a stub creatd stub_request("get", "https://scottchamberlain.info") crul::HttpClient$new("https://scottchamberlain.info")$get() expect_equal(length(stub_registry()$request_stubs), 1) expect_equal(length(request_registry()$request_signatures$hash), 1) webmockr_reset() expect_equal(length(stub_registry()$request_stubs), 0) expect_equal(length(request_registry()$request_signatures$hash), 0) }) test_that("webmockr_reset fails well", { expect_error(webmockr_reset(4), "unused argument") }) disable() webmockr/tests/testthat/httr_body_upload_list.rda0000644000176200001440000000065714113773445022173 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.R0000644000176200001440000000431514113773445020334 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.R0000644000176200001440000000622514113773445020651 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.rda0000644000176200001440000000257414113773445022667 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.R0000644000176200001440000000201314113773445020415 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.R0000644000176200001440000000247714113773445021015 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.R0000644000176200001440000000752414113773445020004 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.R0000644000176200001440000000570614113773445021241 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.R0000644000176200001440000000275214113773445021111 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.R0000644000176200001440000000106614113773445022043 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.R0000644000176200001440000000212314113773445020364 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.R0000644000176200001440000000102514113773445020305 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.R0000644000176200001440000000253514113773445020730 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.R0000644000176200001440000000317614113773445023123 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.R0000644000176200001440000001364214113773445020412 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.R0000644000176200001440000000367314113773445021245 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.R0000644000176200001440000000410414113773445021234 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.R0000644000176200001440000002605714360715661020432 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 nested list bodies work", { skip_on_cran() httr_mock() stub_registry_clear() body = list(id = ' ', method = 'x', params = list(pwd = 'p', user = 'a')) z <- stub_request("post", uri = "https://httpbin.org/post") %>% wi_th(body = body) %>% to_return(body = "asdffsdsdf") x <- httr::POST("https://httpbin.org/post", body = body) expect_true(httr::content(x, "text", encoding="UTF-8") == "asdffsdsdf") # now with allow net connect stub_registry_clear() webmockr_allow_net_connect() x <- httr::POST("https://httpbin.org/post", body = jsonlite::toJSON(body), httr::content_type_json()) expect_equal( jsonlite::fromJSON(rawToChar(x$content))$json, body) webmockr_disable_net_connect() }) test_that("httr requests with JSON-encoded bodies work", { skip_on_cran() on.exit(disable(adapter = "httr")) enable(adapter = "httr") stub_registry_clear() body <- list(foo = "bar") z <- stub_request("post", uri = "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.R0000644000176200001440000000664414113773445024421 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.rda0000644000176200001440000000062214113773445022147 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.R0000644000176200001440000000275514113773445020014 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.R0000644000176200001440000000725214113773445022141 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.R0000644000176200001440000000033214113773445017554 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.R0000644000176200001440000000151514113773445021620 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.rda0000644000176200001440000000036614113773445017372 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.rda0000644000176200001440000002167714113773445022660 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.R0000644000176200001440000001363514300064462021162 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") 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.R0000644000176200001440000000227214113773445021362 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.R0000644000176200001440000000123214113773445017450 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.R0000644000176200001440000000257614113773445021522 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.R0000644000176200001440000000261514113773445022743 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/0000755000176200001440000000000014370732366012277 5ustar liggesuserswebmockr/R/stub_request.R0000644000176200001440000001335214300064462015137 0ustar liggesusers#' Stub an http request #' #' @export #' @param method (character) HTTP method, one of "get", "post", "put", "patch", #' "head", "delete", "options" - or the special "any" (for any method) #' @param uri (character) The request uri. Can be a full or partial uri. #' \pkg{webmockr} can match uri's without the "http" scheme, but does #' not match if the scheme is "https". required, unless `uri_regex` given. #' See [UriPattern] for more. See the "uri vs. uri_regex" section #' @param uri_regex (character) A URI represented as regex. required, if `uri` #' not given. See examples and the "uri vs. uri_regex" section #' @return an object of class `StubbedRequest`, with print method describing #' the stub. #' @details Internally, this calls [StubbedRequest] which handles the logic #' #' See [stub_registry()] for listing stubs, [stub_registry_clear()] #' for removing all stubs and [remove_request_stub()] for removing specific #' stubs #' #' If multiple stubs match the same request, we use the first stub. So if you #' want to use a stub that was created after an earlier one that matches, #' remove the earlier one(s). #' #' Note on `wi_th()`: If you pass `query` values are coerced to character #' class in the recorded stub. You can pass numeric, integer, etc., but #' all will be coerced to character. #' #' See [wi_th()] for details on request body/query/headers and #' [to_return()] for details on how response status/body/headers #' are handled #' #' @note Trailing slashes are dropped from stub URIs before matching #' #' @section uri vs. uri_regex: #' When you use `uri`, we compare the URIs without query params AND #' also the query params themselves without the URIs. #' #' When you use `uri_regex` we don't compare URIs and query params; #' we just use your regex string defined in `uri_regex` as the pattern #' for a call to [grepl] #' #' @section Mocking writing to disk: #' See [mocking-disk-writing] #' @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.R0000644000176200001440000002765614362302553015373 0ustar liggesusers#' @title StubCounter #' @description hash with counter to store requests and count number #' of requests made against the stub #' @export #' @examples #' x <- StubCounter$new() #' x #' x$hash #' x$count() #' z <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get") #' x$put(z) #' x$count() #' x$put(z) #' x$count() StubCounter <- R6::R6Class( 'StubCounter', public = list( #' @field hash (list) a list for internal use only, with elements #' `key`, `sig`, and `count` hash = list(), #' @description Register a request by it's key #' @param x an object of class `RequestSignature` #' @return nothing returned; registers request & iterates internal counter put = function(x) { assert(x, "RequestSignature") key <- x$to_s() self$hash[[key]] <- list(key = key, sig = x) private$total <- private$total + 1 }, #' @description Get the count of number of times any matching request has #' been made against this stub count = function() { private$total } ), private = list( total = 0 ) ) #' @title StubbedRequest #' @description stubbed request class underlying [stub_request()] #' @export #' @seealso [stub_request()] #' @examples \dontrun{ #' x <- StubbedRequest$new(method = "get", uri = "api.crossref.org") #' x$method #' x$uri #' x$with(headers = list('User-Agent' = 'R', apple = "good")) #' x$to_return(status = 200, body = "foobar", headers = list(a = 5)) #' x #' x$to_s() #' #' # 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, #' @field counter a StubCounter object counter = NULL, #' @description Create a new `StubbedRequest` object #' @param method the HTTP method (any, head, get, post, put, #' patch, or delete). "any" matches any HTTP method. required. #' @param uri (character) request URI. either this or `uri_regex` #' required. \pkg{webmockr} can match uri's without the "http" scheme, #' but does not match if the scheme is "https". required, unless #' `uri_regex` given. See [UriPattern] for more. #' @param uri_regex (character) request URI as regex. either this or `uri` #' required #' @return A new `StubbedRequest` object initialize = function(method, uri = NULL, uri_regex = NULL) { if (!missing(method)) { verb <- match.arg(tolower(method), http_verbs) self$method <- verb } if (is.null(uri) && is.null(uri_regex)) { 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) self$counter <- StubCounter$new() }, #' @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 { "" } )) }, #' @description Reset the counter for the stub #' @return nothing returned; resets stub counter to no requests reset = function() { self$counter <- StubCounter$new() } ), private = list( append_response = function(x) { self$responses_sequences <- cc(c(self$responses_sequences, list(x))) }, response = function(status = NULL, body = NULL, headers = NULL, body_raw = NULL, timeout = FALSE, raise = FALSE, exceptions = list() ) { list( status = status, body = body, headers = headers, body_raw = body_raw, timeout = timeout, raise = raise, exceptions = exceptions ) } ) ) 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.R0000644000176200001440000000566014113773445015012 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.R0000644000176200001440000000242114113773445014032 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.R0000644000176200001440000001362114113773445013260 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.R0000644000176200001440000000072114113773445015433 0ustar liggesusers#' @title webmockr_reset #' @description Clear all stubs and the request counter #' @export #' @return nothing #' @seealso [stub_registry_clear()] [request_registry_clear()] #' @details this function runs [stub_registry_clear()] and #' [request_registry_clear()] - so you can run those two yourself #' to achieve the same thing #' @examples #' # webmockr_reset() webmockr_reset <- function() { stub_registry_clear() request_registry_clear() invisible(NULL) } webmockr/R/StubRegistry.R0000644000176200001440000001145114362302630015056 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] #' @param count (bool) iterate counter or not. default: `TRUE` #' @return logical, 1 or more request_stub_for = function(request_signature, count = TRUE) { stubs <- c(self$global_stubs, self$request_stubs) mtchs <- vapply(stubs, function(z) { tmp <- RequestPattern$new(method = z$method, uri = z$uri, uri_regex = z$uri_regex, query = z$query, body = z$body, headers = z$request_headers) tmp$matches(request_signature) }, logical(1)) if (count) { for (i in seq_along(stubs)) { if (mtchs[i]) stubs[[i]]$counter$put(request_signature) } } return(mtchs) }, #' @description Remove a stubbed request by matching request signature #' @param stub an object of type [StubbedRequest] #' @return nothing returned; removes the stub from the registry remove_request_stub = function(stub) { xx <- vapply(self$request_stubs, function(x) x$to_s(), "") if (stub$to_s() %in% xx) { self$request_stubs <- self$request_stubs[-which(stub$to_s() %in% xx)] } else { 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() { for (stub in self$request_stubs) { if (inherits(stub, "StubbedRequest")) stub$reset() } 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, count = FALSE)) ) ) 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.R0000644000176200001440000000337514336067430014232 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.R0000644000176200001440000000121414336067430013667 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.R0000644000176200001440000000011614113773445014041 0ustar liggesusersif (base::getRversion() >= "2.15.1") { utils::globalVariables(c("vcr_c")) } webmockr/R/query_mapper.R0000644000176200001440000000024114113773445015126 0ustar liggesusers# query mapper for BodyPattern # attempt to convert input to an R object regardless of format query_mapper <- function(x) { if (is.null(x)) return(NULL) x } webmockr/R/Response.R0000644000176200001440000001310214113773445014213 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.R0000644000176200001440000001225114113773445015733 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.R0000644000176200001440000000126714113773445015333 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.R0000644000176200001440000000412514113773445016462 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.R0000644000176200001440000000060414113773445014610 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.R0000644000176200001440000000734714113775302015024 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.R0000644000176200001440000000753714364044742014454 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, c("numeric", "integer")) 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.R0000644000176200001440000000022014113773445016406 0ustar liggesusers# Check if request is in cache request_is_in_cache <- function(request_signature) { webmockr_stub_registry$is_registered(request_signature) } webmockr/R/pluck_body.R0000644000176200001440000000320214113773445014550 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.R0000644000176200001440000000125114113773445014347 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.R0000644000176200001440000000060414113773445016473 0ustar liggesusers#' @title stub_registry_clear #' @description Clear all stubs in the stub registry #' @export #' @return an empty list invisibly #' @family stub-registry #' @examples #' (x <- stub_request("get", "https://httpbin.org/get")) #' stub_registry() #' stub_registry_clear() #' stub_registry() stub_registry_clear <- function() { invisible(webmockr_stub_registry$remove_all_request_stubs()) } webmockr/R/pipe.R0000644000176200001440000000021314113773445013351 0ustar liggesusers#' Pipe operator #' #' @name %>% #' @rdname pipe #' @keywords internal #' @export #' @importFrom magrittr %>% #' @usage lhs \%>\% rhs NULL webmockr/R/webmockr-opts.R0000644000176200001440000001040214370732366015213 0ustar liggesusers#' webmockr configuration #' #' @export #' @param allow_net_connect (logical) Default: `FALSE` #' @param allow_localhost (logical) Default: `FALSE` #' @param allow (character) one or more URI/URL to allow (and by extension #' all others are not allowed) #' @param show_stubbing_instructions (logical) Default: `TRUE`. If `FALSE`, #' stubbing instructions are not shown #' @param 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, show_stubbing_instructions = TRUE) { opts <- list( allow_net_connect = allow_net_connect, allow_localhost = allow_localhost, allow = allow, show_stubbing_instructions = show_stubbing_instructions ) 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(" show_stubbing_instructions: ", x$show_stubbing_instructions), sep = "\n") } webmockr_conf_env <- new.env() webmockr/R/RequestPattern.R0000644000176200001440000005356314361011361015405 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 request body pattern against a pattern #' @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)) || all(self$pattern == body) } }, #' @description Print pattern for easy human consumption #' @return a string to_s = function() self$pattern ), private = list( empty_string = function(string) { is.null(string) || !nzchar(string) }, matching_hashes = function(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 uri against a pattern #' @param uri (character) a uri #' @return a boolean matches = function(uri) { uri <- normalize_uri(uri, self$regex) if (self$regex) grepl(self$pattern, uri) else self$pattern_matches(uri) && self$query_params_matches(uri) }, #' @description Match a URI #' @param uri (character) a uri #' @return a boolean pattern_matches = function(uri) { if (!self$regex) return(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 (self$regex) return(NULL) if (missing(query_params) || is.null(query_params)) { self$query_params <- self$extract_query(self$pattern) } else { self$query_params <- query_params 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.R0000644000176200001440000000226614336067430017023 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.R0000644000176200001440000000763214113773445013542 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.R0000644000176200001440000001100614362300705015566 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.R0000644000176200001440000000556014336067430014577 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.R0000644000176200001440000000160214336067430014225 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.R0000644000176200001440000000236214113773445016043 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.R0000644000176200001440000000155314113773445014054 0ustar liggesusers#' This function is defunct. #' @export #' @rdname webmockr_enable-defunct #' @keywords internal webmockr_enable <- function(...) .Defunct("enable") #' This function is defunct. #' @export #' @rdname webmockr_disable-defunct #' @keywords internal webmockr_disable <- function(...) .Defunct("disable") #' This function is defunct. #' @export #' @rdname to_return_-defunct #' @keywords internal to_return_ <- function(...) .Defunct("to_return") #' This function is defunct. #' @export #' @rdname wi_th_-defunct #' @keywords internal wi_th_ <- function(...) .Defunct("wi_th") #' Defunct functions in \pkg{webmockr} #' #' - [webmockr_enable()]: Function removed, see [enable()] #' - [webmockr_disable()]: Function removed, see [disable()] #' - [to_return_]: Only [to_return()] is available now #' - [wi_th_]: Only [wi_th()] is available now #' #' @name webmockr-defunct NULL webmockr/R/adapter.R0000644000176200001440000003033114370732366014042 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 <- "" if (webmockr_conf_env$show_stubbing_instructions) { 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)) stub_num_get <- stub$counter$count() if (stub_num_get > length(stub$responses_sequences)) { stub_num_get <- length(stub$responses_sequences) } respx <- stub$responses_sequences[[stub_num_get]] # if user set to_timeout or to_raise, do that if (!is.null(respx)) { if (respx$timeout || respx$raise) { if (respx$timeout) { x <- fauxpas::HTTPRequestTimeout$new() resp$set_status(x$status_code) x$do_verbose(resp) } if (respx$raise) { x <- respx$exceptions[[1]]$new() resp$set_status(x$status_code) x$do_verbose(resp) } } } return(resp) }, add_response_sequences = function(stub, response) { # TODO: assert HttpResponse (is it ever a crul response?) stopifnot(inherits(stub, "StubbedRequest")) # FIXME: temporary fix, change to using request registry counter # to decide which responses_sequence entry to use # choose which response to return stub_num_get <- stub$counter$count() if (stub_num_get > length(stub$responses_sequences)) { stub_num_get <- length(stub$responses_sequences) } respx <- stub$responses_sequences[[stub_num_get]] # remove NULLs toadd <- cc(respx) if (is.null(toadd)) return(response) # remove timeout, raise, exceptions fields toadd <- toadd[!names(toadd) %in% c('timeout', 'raise', 'exceptions')] for (i in seq_along(toadd)) { if (names(toadd)[i] == "status") { response$status_code <- as.integer(toadd[[i]]) } if (names(toadd)[i] == "body") { if (inherits(respx$body_raw, "mock_file")) { cat( 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.R0000644000176200001440000000071714113773445016527 0ustar liggesusers#' Remove a request stub #' #' @export #' @param stub a request stub, of class `StubbedRequest` #' @return logical, `TRUE` if removed, `FALSE` if not removed #' @family stub-registry #' @examples #' (x <- stub_request("get", "https://httpbin.org/get")) #' stub_registry() #' remove_request_stub(x) #' stub_registry() remove_request_stub <- function(stub) { stopifnot(inherits(stub, "StubbedRequest")) webmockr_stub_registry$remove_request_stub(stub = stub) } webmockr/NEWS.md0000644000176200001440000003410614377277267013213 0ustar liggesuserswebmockr 0.9.0 ============== ### BUG FIXES * `to_return()` supports returning multiple responses to match many requests to the same matching stub. however, the internals were broken for this, but is now fixed (#115) thanks @kenahoo for the report * matching stubs with specifying a request body to match on (e.g., `stub_request('post', 'https://httpbin.org/post') %>% wi_th(body = list(a=5))`) was not working in some cases; internal matching logic was borked. now fixed. (#118) thanks @konradoberwimmer for the report * The `status` parameter in `to_return()` was documented to accept an integer, but it errored when an integer was passed (e.g., `to_return(status=200L)`). This bug is now fixed (#117) thanks @maelle for the report ### MINOR IMPROVEMENTS * Config options changes (see `webmockr_configure()`). Three options that were presentg but not implemented are now removed: `show_body_diff`, ` query_values_notation`, ` net_http_connect_on_start`. One option that was present but not implemented yet is now implemented: ` show_stubbing_instructions` (#27) (#120) ### DOCUMENTATION * `StubCounter` added to pkgdown docs page at (#119) @maelle webmockr 0.8.2 ============== ### BUG FIXES * change to `UriPattern` to make sure regex matching is working as intended (#114) thanks @kenahoo webmockr 0.8.0 ============== ### NEW FEATURES * `enable()` and the `enable()` method on the `Adapter` R6 class gain new parameter `quiet` to toggle whether messages are printed or not (#112) ### MINOR IMPROVEMENTS * to re-create http response objects for both httr and crul we were using the url from the request object; now we use the url from the response object, BUT if there is no url in the response object we fall back to using the url from the request object (#110) (#113) * improve docs: add further explanation to manual files for both `to_raise()` and `to_return()` to explain the 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/MD50000644000176200001440000001617214377415642012417 0ustar liggesusers8d4c381d7b6c45c76df60cc3105f2cf3 *DESCRIPTION ae9eebb8e6b4268115c8ef982c37b485 *LICENSE 72e0b2f1d423e9adb12daeacd5fa693c *NAMESPACE c668e31e45ad905dc5d0c5247e6da6f2 *NEWS.md 04e68d6f38da667d6ff2f44a97fa895f *R/HttpLibAdapterRegistry.R 0a0496ab4ca3ffee5981dc1455de4291 *R/RequestPattern.R e259cb66d0d1c759085d925e6de3db29 *R/RequestRegistry.R a44c031fdb77f51b5e53985bf9e58e33 *R/RequestSignature.R dce5f8019542ff9668f77926b210ec91 *R/Response.R e13e851ca7656513af2382dc5fcdaea8 *R/StubRegistry.R 985d69084226354b4f73eb1d0ffd0a6e *R/StubbedRequest.R c28863c78d0802cf045647313add2617 *R/adapter-crul.R 0d82dc34264378702554c4b7a91a5bed *R/adapter-httr.R 45ddcc2eb00ade98f2626e35985f802e *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 dee7a783baaf88925c5b1b09853743e1 *R/stub_request.R 8b30d79d7dc010155fb82b33aaa20639 *R/to_raise.R 6de24b78dc36244bb2a336cea86ed40a *R/to_return.R 78d1443f02b9efaf6a0589176816aa0f *R/to_timeout.R 5bd800330fb68213b164bd2449de3314 *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 441c024a34886e42d9390f9d36aad4a2 *man/Adapter.Rd 27f3f8a27cffa3b331eaec746ebddf5d *man/BodyPattern.Rd 7fd0badad2fc9a9e9f35d4d672b5c19e *man/HashCounter.Rd dd6f6c48551800b942d0a56980229ff7 *man/HeadersPattern.Rd 20a9b2c1e8ee5bc95ba3f919d9d9ab59 *man/HttpLibAdapaterRegistry.Rd b7e221806660cae439fc4c5804ab80e4 *man/MethodPattern.Rd 57079eb5d70492ae0f5bcd54e945eaba *man/RequestPattern.Rd b344448669c6dec574be8ae593584377 *man/RequestRegistry.Rd c870d0c6695ae2b6bcb54caa1c6be9af *man/RequestSignature.Rd a4568741e2c449f5985047909f207e98 *man/Response.Rd 5cbe5328f5ea5c70fb92dcb57a6b0da4 *man/StubCounter.Rd ef172b7a7906056b58ba6fe17da0ddba *man/StubRegistry.Rd f9335286b83288acf0f10d03cb2da5bc *man/StubbedRequest.Rd 5e94f406c95c2a694481dd91954d530c *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 f9b0f45c23246db02d5a5ec4919dafd4 *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 2c6e66dbe84d90eff80ea2d264a4179f *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 b1ba049b8047522af6fca9574971a5d6 *tests/testthat/test-HttrAdapter.R a8e2b957fb9205f15f4bbfabff7deec2 *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 28c001f78df2e575fa7ba28bdc78efd0 *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 2505328739a274080f01c477c1fcb3dd *tests/testthat/test-zutils.R webmockr/inst/0000755000176200001440000000000014113773445013051 5ustar liggesuserswebmockr/inst/ignore/0000755000176200001440000000000014113773445014334 5ustar liggesuserswebmockr/inst/ignore/adapter-httr.R0000644000176200001440000000520714113773445017062 0ustar liggesusers#' httr library adapter #' #' @export #' @family http_lib_adapters #' @details This adapter modifies \pkg{httr} to allow mocking HTTP requests #' when one is using \pkg{httr} in their code HttrAdapter <- R6::R6Class( 'HttrAdapter', public = list( name = "httr_adapter", enable = function() { message("HttrAdapter enabled!") webmockr_lightswitch$httr <- TRUE }, disable = function() { message("HttrAdapter disabled!") webmockr_lightswitch$httr <- FALSE }, build_request_signature = function(x) { RequestSignature$new( method = x$method, uri = x$url, options = list( body = x$body %||% NULL, headers = x$headers %||% NULL ) ) }, handle_request = function() { "fadfas" } ) ) # httr methods to override ## request_perform -> changes: ## - look in cache for matching request (given user specified matchers) ## - if it's a match, return the response (body, headers, etc.) ## - if no match, proceed with http request as normal request_perform <- function(req, handle, refresh = TRUE) { stopifnot(httr:::is.request(req), inherits(handle, "curl_handle")) req <- httr:::request_prepare(req) curl::handle_setopt(handle, .list = req$options) if (!is.null(req$fields)) curl::handle_setform(handle, .list = req$fields) curl::handle_setheaders(handle, .list = req$headers) on.exit(curl::handle_reset(handle), add = TRUE) # put request in cache request_signature <- HttrAdapter$build_request_signature(req) webmockr_request_registry$register_request(request_signature) if (request_is_in_cache(req)) { StubRegistry$find_stubbed_request(req) } else { resp <- httr:::request_fetch(req$output, req$url, handle) # If return 401 and have auth token, refresh it and then try again needs_refresh <- refresh && resp$status_code == 401L && !is.null(req$auth_token) && req$auth_token$can_refresh() if (needs_refresh) { message("Auto-refreshing stale OAuth token.") req$auth_token$refresh() return(httr:::request_perform(req, handle, refresh = FALSE)) } all_headers <- httr:::parse_headers(resp$headers) headers <- httr:::last(all_headers)$headers if (!is.null(headers$date)) { date <- httr:::parse_http_date(headers$Date) } else { date <- Sys.time() } httr:::response( url = resp$url, status_code = resp$status_code, headers = headers, all_headers = all_headers, cookies = curl::handle_cookies(handle), content = resp$content, date = date, times = resp$times, request = req, handle = handle ) } } webmockr/inst/ignore/sockets.R0000644000176200001440000000252214113773445016133 0ustar liggesuserswbenv <- new.env() bucket <- new.env() start_server <- function(x) { app <- list( call = function(req) { wsUrl = paste(sep = '', '"', "ws://", ifelse(is.null(req$HTTP_HOST), req$SERVER_NAME, req$HTTP_HOST), '"') tmp <- list( status = 200L, headers = list( 'Content-Type' = 'application/json' ), body = sprintf('{ "http_method": "%s", "url": "%s", "port": "%s", "query": "%s", "user_agent": "%s" }', req$REQUEST_METHOD, req$SERVER_NAME, req$SERVER_PORT, req$QUERY_STRING, req$HTTP_USER_AGENT) ) assign(basename(tempfile()), tmp, envir = bucket) tmp } ) wbenv$server <- startDaemonizedServer("0.0.0.0", 9200, app) #wbenv$server <- startDaemonizedServer("80", 9200, app) message("server started") } stop_server <- function(x = NULL) { stopDaemonizedServer(if (is.null(x)) wbenv$server else x) } bucket_list <- function(x) ls(envir = bucket) bucket_unique <- function(x) { hashes <- vapply(ls(envir = bucket), function(z) digest::digest(get(z, envir = bucket)), "") if (any(duplicated(hashes))) { torm <- names(hashes)[duplicated(hashes)] invisible(lapply(torm, function(z) rm(list = z, envir = bucket))) } }