#> method: get
#> uri: https://httpbin.org/get
#> with:
#> query:
#> body:
#> request_headers: Accept=application/json, te...
#> to_return:
#> status: 418
#> body: I'm a teapot!!!
#> response_headers: im_a=teapot
#> should_timeout: FALSE
#> should_raise: FALSE
```
now returns mocked response
```r
(res <- GET("https://httpbin.org/get"))
res$status_code
#> [1] 418
res$headers
#> $im_a
#> [1] "teapot"
```
## Writing to disk
Write to a file before mocked request
```r
## make a temp file
f <- tempfile(fileext = ".json")
## write something to the file
cat("{\"hello\":\"world\"}\n", file = f)
readLines(f)
#> [1] "{\"hello\":\"world\"}"
## make the stub
invisible(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)
readLines(file(f))
#> [1] "{\"hello\":\"world\"}"
```
OR - you can use `mock_file()` to have `webmockr` handle file and contents
```r
g <- tempfile(fileext = ".json")
## make the stub
invisible(stub_request("get", "https://httpbin.org/get") %>%
to_return(body = mock_file(g, "{\"hello\":\"mars\"}\n")))
## make a request
out <- crul::HttpClient$new("https://httpbin.org/get")$get(disk = g)
readLines(out$content)
#> [1] "{\"hello\":\"world\"}"
```
Writing to disk is supported in both `crul` and `httr`
## Meta
* Please [report any issues or bugs](https://github.com/ropensci/webmockr/issues).
* License: MIT
* Get citation information for `webmockr` in R doing `citation(package = 'webmockr')`
* Please note that this project is released with a [Contributor Code of Conduct][coc].
By participating in this project you agree to abide by its terms.
[](https://ropensci.org)
[vcr]: https://github.com/ropensci/vcr
[coc]: https://github.com/ropensci/webmockr/blob/master/CODE_OF_CONDUCT.md
webmockr/man/ 0000755 0001762 0000144 00000000000 13571575147 012655 5 ustar ligges users webmockr/man/enable.Rd 0000644 0001762 0000144 00000001740 13457524755 014376 0 ustar ligges users % 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())
enabled(adapter = "crul")
disable(adapter = NULL, options = list())
}
\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.}
}
\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.Rd 0000644 0001762 0000144 00000004522 13571510275 015361 0 ustar ligges users % 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$put("foo bar")
x$put("foo bar")
x$put("hello world")
x$put("hello world")
x$put("hello world")
x$hash
}
\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}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-put}{\code{HashCounter$put()}}
\item \href{#method-get}{\code{HashCounter$get()}}
\item \href{#method-clone}{\code{HashCounter$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{put()}}{
Register a request by it's key
\subsection{Usage}{
\if{html}{\out{}}\preformatted{HashCounter$put(key)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{key}}{a character string of the request, serialized from
\link{CrulAdapter} or another adapter}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
nothing returned; registers request and iterates
internal counter
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{get()}}{
Get a request by key
\subsection{Usage}{
\if{html}{\out{}}\preformatted{HashCounter$get(key)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{key}}{a character string of the request, serialized from
\link{CrulAdapter} or another adapter}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
(character) an http request as a string
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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.Rd 0000644 0001762 0000144 00000007351 13571350262 015664 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/stub_request.R
\name{stub_request}
\alias{stub_request}
\title{Stub an http request}
\usage{
stub_request(method = "get", uri = NULL, uri_regex = NULL)
}
\arguments{
\item{method}{(character) HTTP method, one of "get", "post", "put", "patch",
"head", "delete", "options" - or the special "any" (for any method)}
\item{uri}{(character) The request uri. Can be a full uri, partial, or a
regular expression to match many incantations of a uri. required.}
\item{uri_regex}{(character) A URI represented as regex. See examples}
}
\value{
an object of class \code{StubbedRequest}, with print method describing
the stub.
}
\description{
Stub an http request
}
\details{
Internally, this calls \link{StubbedRequest} which handles the logic
See \code{\link[=stub_registry]{stub_registry()}} for listing stubs, \code{\link[=stub_registry_clear]{stub_registry_clear()}}
for removing all stubs and \code{\link[=remove_request_stub]{remove_request_stub()}} for removing specific
stubs
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).
}
\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'))
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'))
# 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))
# 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.Rd 0000644 0001762 0000144 00000000530 13145163224 017166 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000001025 13241473156 015321 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000001662 13241664137 014746 0 ustar ligges users % 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()}}
}
webmockr/man/RequestPattern.Rd 0000644 0001762 0000144 00000010011 13571506002 016103 0 ustar ligges users % 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 = "https://httpbin.org/get"))
x$body_pattern
x$headers_pattern
x$method_pattern
x$uri_pattern
x$to_s()
# make a request signature
rs <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get")
# check if it matches
x$matches(rs)
# regex uri
(x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org"))
x$uri_pattern
x$uri_pattern$to_s()
x$to_s()
# uri with query parameters
(x <- RequestPattern$new(
method = "get", uri = "https://httpbin.org/get",
query = list(foo = "bar")
))
x$to_s()
# 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)
}
}
\seealso{
pattern classes for HTTP method \link{MethodPattern}, headers
\link{HeadersPattern}, body \link{BodyPattern}, and URI/URL \link{UriPattern}
}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{method_pattern}}{xxx}
\item{\code{uri_pattern}}{xxx}
\item{\code{body_pattern}}{xxx}
\item{\code{headers_pattern}}{xxx}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{RequestPattern$new()}}
\item \href{#method-matches}{\code{RequestPattern$matches()}}
\item \href{#method-to_s}{\code{RequestPattern$to_s()}}
\item \href{#method-clone}{\code{RequestPattern$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000000507 13415716025 017043 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000010272 13571521416 015231 0 ustar ligges users % 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")
z$matches("http://foobar.com/")
# default ports
(z <- UriPattern$new(pattern = "http://foobar.com"))
z$matches("http://foobar.com:80")
z$matches("http://foobar.com:80/")
z$matches("http://foobar.com:443")
z$matches("http://foobar.com:443/")
# user info
(z <- UriPattern$new(pattern = "http://foobar.com"))
z$matches("http://user:pass@foobar.com")
# regex
(z <- UriPattern$new(regex_pattern = ".+ample\\\\.."))
z$matches("http://sample.org")
z$matches("http://example.com")
z$matches("http://tramples.net")
# add query parameters
(z <- UriPattern$new(pattern = "http://foobar.com"))
z$add_query_params(list(pizza = "cheese", cheese = "cheddar"))
z$pattern
(z <- UriPattern$new(pattern = "http://foobar.com"))
z$pattern
z$add_query_params(list(pizza = "deep dish", cheese = "cheddar"))
z$pattern
# any pattern
(z <- UriPattern$new(regex_pattern = ".+"))
z$regex
z$pattern
z$matches("http://stuff.com")
z$matches("https://stuff.com")
z$matches("https://stuff.com/stff")
z$matches("https://stuff.com/apple?bears=3")
}
\keyword{internal}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{pattern}}{(character) pattern holder}
\item{\code{regex}}{a logical}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{UriPattern$new()}}
\item \href{#method-matches}{\code{UriPattern$matches()}}
\item \href{#method-add_query_params}{\code{UriPattern$add_query_params()}}
\item \href{#method-to_s}{\code{UriPattern$to_s()}}
\item \href{#method-clone}{\code{UriPattern$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\subsection{Method \code{matches()}}{
Match a list of headers against that stored
\subsection{Usage}{
\if{html}{\out{}}\preformatted{UriPattern$matches(uri)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{uri}}{(character) a uri}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
a boolean
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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/CrulAdapter.Rd 0000644 0001762 0000144 00000005224 13571521323 015340 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adapter-crul.R
\name{CrulAdapter}
\alias{CrulAdapter}
\title{CrulAdapter}
\description{
\pkg{crul} library adapter
}
\details{
This adapter modifies \pkg{crul} to allow mocking HTTP requests
}
\seealso{
Other http_lib_adapters:
\code{\link{HttrAdapter}}
}
\concept{http_lib_adapters}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{name}}{adapter name}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-enable}{\code{CrulAdapter$enable()}}
\item \href{#method-disable}{\code{CrulAdapter$disable()}}
\item \href{#method-handle_request}{\code{CrulAdapter$handle_request()}}
\item \href{#method-remove_crul_stubs}{\code{CrulAdapter$remove_crul_stubs()}}
\item \href{#method-clone}{\code{CrulAdapter$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{enable()}}{
Enable the adapter
\subsection{Usage}{
\if{html}{\out{}}\preformatted{CrulAdapter$enable()}\if{html}{\out{
}}
}
\subsection{Returns}{
\code{TRUE}, invisibly
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{disable()}}{
Disable the adapter
\subsection{Usage}{
\if{html}{\out{}}\preformatted{CrulAdapter$disable()}\if{html}{\out{
}}
}
\subsection{Returns}{
\code{FALSE}, invisibly
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{handle_request()}}{
All logic for handling a request
\subsection{Usage}{
\if{html}{\out{}}\preformatted{CrulAdapter$handle_request(req)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{req}}{a crul request}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
various outcomes
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{remove_crul_stubs()}}{
Remove all crul stubs
\subsection{Usage}{
\if{html}{\out{}}\preformatted{CrulAdapter$remove_crul_stubs()}\if{html}{\out{
}}
}
\subsection{Returns}{
nothing returned; removes all crul request stubs
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{
}}
}
}
}
webmockr/man/build_httr_response.Rd 0000644 0001762 0000144 00000000530 13415716025 017205 0 ustar ligges users % 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/HttrAdapter.Rd 0000644 0001762 0000144 00000007215 13571521323 015356 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/adapter-httr.R
\name{HttrAdapter}
\alias{HttrAdapter}
\title{HttrAdapter}
\description{
\code{httr} library adapter
}
\details{
This adapter modifies \pkg{httr} to allow mocking HTTP requests
}
\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)
}
}
}
\seealso{
Other http_lib_adapters:
\code{\link{CrulAdapter}}
}
\concept{http_lib_adapters}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{name}}{adapter name}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-enable}{\code{HttrAdapter$enable()}}
\item \href{#method-disable}{\code{HttrAdapter$disable()}}
\item \href{#method-handle_request}{\code{HttrAdapter$handle_request()}}
\item \href{#method-remove_httr_stubs}{\code{HttrAdapter$remove_httr_stubs()}}
\item \href{#method-clone}{\code{HttrAdapter$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{enable()}}{
Enable the adapter
\subsection{Usage}{
\if{html}{\out{}}\preformatted{HttrAdapter$enable()}\if{html}{\out{
}}
}
\subsection{Returns}{
\code{TRUE}, invisibly
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{disable()}}{
Disable the adapter
\subsection{Usage}{
\if{html}{\out{}}\preformatted{HttrAdapter$disable()}\if{html}{\out{
}}
}
\subsection{Returns}{
\code{FALSE}, invisibly
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{handle_request()}}{
All logic for handling a request
\subsection{Usage}{
\if{html}{\out{}}\preformatted{HttrAdapter$handle_request(req)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{req}}{a httr request}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
various outcomes
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\subsection{Method \code{remove_httr_stubs()}}{
Remove all crul stubs
\subsection{Usage}{
\if{html}{\out{}}\preformatted{HttrAdapter$remove_httr_stubs()}\if{html}{\out{
}}
}
\subsection{Returns}{
nothing returned; removes all httr request stubs
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{
}}
}
}
}
webmockr/man/webmockr_enable-defunct.Rd 0000644 0001762 0000144 00000000405 13242424030 017663 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000001654 13571350775 016055 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000003373 13457524755 014266 0 ustar ligges users % 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}.}
\item{.list}{named list, has to be one of 'query', 'body',
and/or 'headers'. 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, and/or request headers
}
\details{
\code{with} is a function in the \code{base} package, so we went with
\code{wi_th}
Values for query, body, and headers:
\itemize{
\item query: (list) a named list
\item body: various, including character string, list, raw, numeric, etc
\item headers: (list) a named list
}
}
\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)
# 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")))
}
webmockr/man/mocking-disk-writing.Rd 0000644 0001762 0000144 00000004046 13571350775 017206 0 ustar ligges users % 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/to_return_-defunct.Rd 0000644 0001762 0000144 00000000366 13457524755 016761 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000000352 13457524755 016045 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000001551 13457524755 016352 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/webmockr.R
\docType{package}
\name{webmockr-package}
\alias{webmockr-package}
\alias{webmockr}
\title{Stubbing and setting expectations on HTTP requests}
\description{
Stubbing and setting expectations on HTTP requests
}
\section{Features}{
\itemize{
\item Stubbing HTTP requests at low http client lib level
\item Setting and verifying expectations on HTTP requests
\item Matching requests based on method, URI, headers and body
\item 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}
}
\keyword{package}
webmockr/man/to_return.Rd 0000644 0001762 0000144 00000004031 13571350262 015150 0 ustar ligges users % 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())
}
\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}
}
\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()}}
}
\examples{
# first, make a stub object
(req <- stub_request("post", "https://httpbin.org/post"))
# add status, body and/or headers
to_return(req, status = 200)
to_return(req, body = "stuff")
to_return(req, body = list(a = list(b = "world")))
to_return(req, headers = list(a = 5))
to_return(req, status = 200, body = "stuff", headers = list(a = 5))
# .list - pass in a named list instead
to_return(req, .list = list(body = list(foo = "bar")))
}
webmockr/man/httr_mock.Rd 0000644 0001762 0000144 00000000643 13415716025 015126 0 ustar ligges users % 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}
\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 sets a callback that routes httr request
through webmockr
}
\description{
Turn on httr mocking
}
webmockr/man/webmockr_disable-defunct.Rd 0000644 0001762 0000144 00000000410 13242424030 020034 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000021077 13571507246 014744 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/Response.R
\name{Response}
\alias{Response}
\title{Response}
\description{
custom webmockr http response class
}
\examples{
\dontrun{
(x <- Response$new())
x$set_url("https://httpbin.org/get")
x
x$set_request_headers(list('Content-Type' = "application/json"))
x
x$request_headers
x$set_response_headers(list('Host' = "httpbin.org"))
x
x$response_headers
x$set_status(404)
x
x$get_status()
x$set_body("hello world")
x
x$get_body()
# raw body
x$set_body(charToRaw("hello world"))
x
x$get_body()
x$set_exception("exception")
x
x$get_exception()
}
}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{url}}{(character) a url}
\item{\code{body}}{(various) list, character, etc}
\item{\code{content}}{(various) response content/body}
\item{\code{request_headers}}{(list) a named list}
\item{\code{response_headers}}{(list) a named list}
\item{\code{options}}{(character) list}
\item{\code{status_code}}{(integer) an http status code}
\item{\code{exception}}{(character) an exception message}
\item{\code{should_timeout}}{(logical) should the response timeout?}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{Response$new()}}
\item \href{#method-print}{\code{Response$print()}}
\item \href{#method-set_url}{\code{Response$set_url()}}
\item \href{#method-get_url}{\code{Response$get_url()}}
\item \href{#method-set_request_headers}{\code{Response$set_request_headers()}}
\item \href{#method-get_request_headers}{\code{Response$get_request_headers()}}
\item \href{#method-set_response_headers}{\code{Response$set_response_headers()}}
\item \href{#method-get_respone_headers}{\code{Response$get_respone_headers()}}
\item \href{#method-set_body}{\code{Response$set_body()}}
\item \href{#method-get_body}{\code{Response$get_body()}}
\item \href{#method-set_status}{\code{Response$set_status()}}
\item \href{#method-get_status}{\code{Response$get_status()}}
\item \href{#method-set_exception}{\code{Response$set_exception()}}
\item \href{#method-get_exception}{\code{Response$get_exception()}}
\item \href{#method-clone}{\code{Response$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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{}}
\subsection{Method \code{clone()}}{
The objects of this class are cloneable with this method.
\subsection{Usage}{
\if{html}{\out{}}\preformatted{Response$clone(deep = FALSE)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{deep}}{Whether to make a deep clone.}
}
\if{html}{\out{
}}
}
}
}
webmockr/man/build_crul_request.Rd 0000644 0001762 0000144 00000000507 13145357177 017040 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000002570 13571575147 016570 0 ustar ligges users % 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 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 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.Rd 0000644 0001762 0000144 00000001121 13457524755 016400 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000001147 13571350775 017220 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/stub_registry_clear.R
\name{stub_registry_clear}
\alias{stub_registry_clear}
\title{Clear the stub registry}
\usage{
stub_registry_clear()
}
\value{
nothing, well technically an empty list invisibly, but
it's not anything useful
}
\description{
Clear all stubs
}
\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.Rd 0000644 0001762 0000144 00000000317 13107235041 014057 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000000752 13571350775 015076 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000005737 13571514572 016334 0 ustar ligges users % 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()
x$register_request(request = "GET http://scottchamberlain.info")
x$register_request(request = "GET http://scottchamberlain.info")
x$register_request(request = "POST https://httpbin.org/post")
# print method to list requests
x
# hashes, and number of times each requested
x$request_signatures$hash
# reset the request registry
x$reset()
}
\seealso{
\code{\link[=stub_registry]{stub_registry()}} and \link{StubRegistry}
Other request-registry:
\code{\link{HashCounter}},
\code{\link{request_registry}()}
}
\concept{request-registry}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{request_signatures}}{a HashCounter object}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-print}{\code{RequestRegistry$print()}}
\item \href{#method-reset}{\code{RequestRegistry$reset()}}
\item \href{#method-register_request}{\code{RequestRegistry$register_request()}}
\item \href{#method-clone}{\code{RequestRegistry$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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
\link{CrulAdapter} or another adapter}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
nothing returned; registers the request
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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.Rd 0000644 0001762 0000144 00000004317 13571350775 017021 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/webmockr-opts.R
\name{webmockr_configure}
\alias{webmockr_configure}
\alias{webmockr_configure_reset}
\alias{webmockr_configuration}
\alias{webmockr_allow_net_connect}
\alias{webmockr_disable_net_connect}
\alias{webmockr_net_connect_allowed}
\title{webmockr configuration}
\usage{
webmockr_configure(
allow_net_connect = FALSE,
allow_localhost = FALSE,
allow = NULL,
net_http_connect_on_start = FALSE,
show_stubbing_instructions = FALSE,
query_values_notation = FALSE,
show_body_diff = FALSE
)
webmockr_configure_reset()
webmockr_configuration()
webmockr_allow_net_connect()
webmockr_disable_net_connect(allow = NULL)
webmockr_net_connect_allowed(uri = NULL)
}
\arguments{
\item{allow_net_connect}{(logical) Default: \code{FALSE}}
\item{allow_localhost}{(logical) Default: \code{FALSE}}
\item{allow}{(character) one or more URI/URL to allow (and by extension
all others are not allowed)}
\item{net_http_connect_on_start}{(logical) Default: \code{FALSE}. ignored for
now}
\item{show_stubbing_instructions}{(logical) Default: \code{FALSE}. ignored for
now}
\item{query_values_notation}{(logical) Default: \code{FALSE}. ignored for
now}
\item{show_body_diff}{(logical) Default: \code{FALSE}. ignored for
now}
\item{uri}{(character) a URI/URL as a character string - to determine
whether or not it is allowed}
}
\description{
webmockr configuration
}
\section{webmockr_allow_net_connect}{
If there are stubs found for a request, even if net connections are
allowed (by running \code{webmockr_allow_net_connect()}) the stubbed
response will be returned. If no stub is found, and net connections
are allowed, then a real HTTP request can be made.
}
\examples{
\dontrun{
webmockr_configure()
webmockr_configure(
allow_localhost = TRUE
)
webmockr_configuration()
webmockr_configure_reset()
webmockr_allow_net_connect()
webmockr_net_connect_allowed()
# disable net connect for any URIs
webmockr_disable_net_connect()
### gives NULL with no URI passed
webmockr_net_connect_allowed()
# disable net connect EXCEPT FOR given URIs
webmockr_disable_net_connect(allow = "google.com")
### is a specific URI allowed?
webmockr_net_connect_allowed("google.com")
}
}
webmockr/man/BodyPattern.Rd 0000644 0001762 0000144 00000005062 13571506002 015362 0 ustar ligges users % 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
z <- BodyPattern$new(pattern = list(foo = "bar"))
z$pattern
z$matches(bb$body)
}
\keyword{internal}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{pattern}}{a list}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{BodyPattern$new()}}
\item \href{#method-matches}{\code{BodyPattern$matches()}}
\item \href{#method-to_s}{\code{BodyPattern$to_s()}}
\item \href{#method-clone}{\code{BodyPattern$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\subsection{Method \code{matches()}}{
Match a list of headers against that stored
\subsection{Usage}{
\if{html}{\out{}}\preformatted{BodyPattern$matches(body, content_type = "")}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{body}}{(list) the body}
\item{\code{content_type}}{(character) content type}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
a boolean
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000000501 13270161742 017133 0 ustar ligges users % 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.Rd 0000644 0001762 0000144 00000012667 13571514572 015621 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/StubRegistry.R
\name{StubRegistry}
\alias{StubRegistry}
\title{StubRegistry}
\description{
stub registry to keep track of \link{StubbedRequest} stubs
}
\examples{
\dontrun{
# Make a stub
stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
stub1$with(headers = list('User-Agent' = 'R'))
stub1$to_return(status = 200, body = "foobar", headers = list())
stub1
# Make another stub
stub2 <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
stub2
# Put both stubs in the stub registry
reg <- StubRegistry$new()
reg$register_stub(stub = stub1)
reg$register_stub(stub = stub2)
reg
reg$request_stubs
}
}
\seealso{
Other stub-registry:
\code{\link{remove_request_stub}()},
\code{\link{stub_registry_clear}()},
\code{\link{stub_registry}()}
}
\concept{stub-registry}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{request_stubs}}{(list) list of request stubs}
\item{\code{global_stubs}}{(list) list of global stubs}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-print}{\code{StubRegistry$print()}}
\item \href{#method-register_stub}{\code{StubRegistry$register_stub()}}
\item \href{#method-find_stubbed_request}{\code{StubRegistry$find_stubbed_request()}}
\item \href{#method-request_stub_for}{\code{StubRegistry$request_stub_for()}}
\item \href{#method-remove_request_stub}{\code{StubRegistry$remove_request_stub()}}
\item \href{#method-remove_all_request_stubs}{\code{StubRegistry$remove_all_request_stubs()}}
\item \href{#method-is_registered}{\code{StubRegistry$is_registered()}}
\item \href{#method-clone}{\code{StubRegistry$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\subsection{Method \code{request_stub_for()}}{
Find a stubbed request
\subsection{Usage}{
\if{html}{\out{}}\preformatted{StubRegistry$request_stub_for(request_signature)}\if{html}{\out{
}}
}
\subsection{Arguments}{
\if{html}{\out{}}
\describe{
\item{\code{request_signature}}{an object of class \link{RequestSignature}}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
logical, 1 or more
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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/HttpLibAdapaterRegistry.Rd 0000644 0001762 0000144 00000004154 13571352126 017677 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/HttpLibAdapterRegistry.R
\name{HttpLibAdapaterRegistry}
\alias{HttpLibAdapaterRegistry}
\title{HttpLibAdapaterRegistry}
\description{
http lib adapter registry
}
\examples{
x <- HttpLibAdapaterRegistry$new()
x$register(CrulAdapter$new())
x
x$adapters
x$adapters[[1]]$name
}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{adapters}}{list}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-print}{\code{HttpLibAdapaterRegistry$print()}}
\item \href{#method-register}{\code{HttpLibAdapaterRegistry$register()}}
\item \href{#method-clone}{\code{HttpLibAdapaterRegistry$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000015347 13571515356 016113 0 ustar ligges users % 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()
# 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()
# 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
x$to_s()
# to timeout
(x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org"))
x$to_s()
x$to_timeout()
x$to_s()
# to raise
library(fauxpas)
(x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org"))
x$to_s()
x$to_raise(HTTPBadGateway)
x$to_s()
}
}
\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{request_headers}}{(xx) xx}
\item{\code{response_headers}}{(xx) xx}
\item{\code{responses_sequences}}{(xx) xx}
\item{\code{status_code}}{(xx) xx}
\item{\code{timeout}}{(xx) xx}
\item{\code{exceptions}}{(xx) xx}
\item{\code{raise}}{(xx) xx}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{StubbedRequest$new()}}
\item \href{#method-print}{\code{StubbedRequest$print()}}
\item \href{#method-with}{\code{StubbedRequest$with()}}
\item \href{#method-to_return}{\code{StubbedRequest$to_return()}}
\item \href{#method-to_timeout}{\code{StubbedRequest$to_timeout()}}
\item \href{#method-to_raise}{\code{StubbedRequest$to_raise()}}
\item \href{#method-to_s}{\code{StubbedRequest$to_s()}}
\item \href{#method-clone}{\code{StubbedRequest$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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}
\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{}}
\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{}}
\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)}\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.}
}
\if{html}{\out{
}}
}
\subsection{Returns}{
nothing returned; sets only
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000005217 13571506002 015707 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/RequestPattern.R
\name{MethodPattern}
\alias{MethodPattern}
\title{MethodPattern}
\description{
method matcher
}
\details{
Matches regardless of case. e.g., POST will match to post
}
\examples{
(x <- MethodPattern$new(pattern = "post"))
x$pattern
x$matches(method = "post")
x$matches(method = "POST")
# all matches() calls should be TRUE
(x <- MethodPattern$new(pattern = "any"))
x$pattern
x$matches(method = "post")
x$matches(method = "GET")
x$matches(method = "HEAD")
}
\keyword{internal}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{pattern}}{(character) an http method}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{MethodPattern$new()}}
\item \href{#method-matches}{\code{MethodPattern$matches()}}
\item \href{#method-to_s}{\code{MethodPattern$to_s()}}
\item \href{#method-clone}{\code{MethodPattern$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000007534 13571521416 016054 0 ustar ligges users % Generated by roxygen2: do not edit by hand
% Please edit documentation in R/RequestPattern.R
\name{HeadersPattern}
\alias{HeadersPattern}
\title{HeadersPattern}
\description{
headers matcher
}
\details{
\code{webmockr} normalises headers and treats all forms of same headers as equal:
i.e the following two sets of headers are equal:
\code{list(Header1 = "value1", content_length = 123, X_CuStOm_hEAder = "foo")}
and
\code{list(header1 = "value1", "Content-Length" = 123, "x-cuSTOM-HeAder" = "foo")}
}
\examples{
(x <- HeadersPattern$new(pattern = list(a = 5)))
x$pattern
x$matches(list(a = 5))
# different cases
(x <- HeadersPattern$new(pattern = list(Header1 = "value1")))
x$pattern
x$matches(list(header1 = "value1"))
x$matches(list(header1 = "value2"))
# different symbols
(x <- HeadersPattern$new(pattern = list(`Hello_World` = "yep")))
x$pattern
x$matches(list(`hello-world` = "yep"))
x$matches(list(`hello-worlds` = "yep"))
headers <- list(
'User-Agent' = 'Apple',
'Accept-Encoding' = 'gzip, deflate',
'Accept' = 'application/json, text/xml, application/xml, */*')
(x <- HeadersPattern$new(pattern = headers))
x$to_s()
x$pattern
x$matches(headers)
}
\keyword{internal}
\section{Public fields}{
\if{html}{\out{}}
\describe{
\item{\code{pattern}}{a list}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{HeadersPattern$new()}}
\item \href{#method-matches}{\code{HeadersPattern$matches()}}
\item \href{#method-empty_headers}{\code{HeadersPattern$empty_headers()}}
\item \href{#method-to_s}{\code{HeadersPattern$to_s()}}
\item \href{#method-clone}{\code{HeadersPattern$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000007224 13571523506 016453 0 ustar ligges users % 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}
}
\if{html}{\out{
}}
}
\section{Methods}{
\subsection{Public methods}{
\itemize{
\item \href{#method-new}{\code{RequestSignature$new()}}
\item \href{#method-print}{\code{RequestSignature$print()}}
\item \href{#method-to_s}{\code{RequestSignature$to_s()}}
\item \href{#method-clone}{\code{RequestSignature$clone()}}
}
}
\if{html}{\out{
}}
\if{html}{\out{}}
\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{}}
\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{}}
\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{}}
\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.Rd 0000644 0001762 0000144 00000001247 13571350775 017250 0 ustar ligges users % 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/DESCRIPTION 0000644 0001762 0000144 00000003106 13572030423 013570 0 ustar ligges users Package: 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.5.0
Authors@R: c(
person("Scott", "Chamberlain", role = c("aut", "cre"), email =
"myrmecocystus+r@gmail.com", comment = c(ORCID="0000-0003-1444-9135")),
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)
BugReports: https://github.com/ropensci/webmockr/issues
LazyData: true
Encoding: UTF-8
Language: en-US
Imports: curl, jsonlite, magrittr (>= 1.5), R6 (>= 2.1.3), urltools (>=
1.6.0), fauxpas, crul (>= 0.7.0)
Suggests: roxygen2 (>= 7.0.2), testthat, xml2, vcr, httr
RoxygenNote: 7.0.2
X-schema.org-applicationCategory: Web
X-schema.org-keywords: http, https, API, web-services, curl, mock,
mocking, fakeweb, http-mocking, testing, testing-tools, tdd
X-schema.org-isPartOf: https://ropensci.org
NeedsCompilation: no
Packaged: 2019-12-04 21:57:25 UTC; sckott
Author: Scott Chamberlain [aut, cre] (),
rOpenSci [fnd] (https://ropensci.org)
Maintainer: Scott Chamberlain
Repository: CRAN
Date/Publication: 2019-12-04 22:20:03 UTC
webmockr/tests/ 0000755 0001762 0000144 00000000000 13572025705 013233 5 ustar ligges users webmockr/tests/test-all.R 0000644 0001762 0000144 00000000053 13077016675 015107 0 ustar ligges users library("testthat")
test_check("webmockr")
webmockr/tests/testthat/ 0000755 0001762 0000144 00000000000 13572025705 015073 5 ustar ligges users webmockr/tests/testthat/test-StubbedRequest.R 0000644 0001762 0000144 00000012467 13571350262 021144 0 ustar ligges users context("StubbedRequest")
test_that("StubbedRequest: works", {
expect_is(StubbedRequest, "R6ClassGenerator")
aa <- StubbedRequest$new(method = "get", uri = "https:/httpbin.org/get")
expect_is(aa, "StubbedRequest")
expect_null(aa$host)
expect_null(aa$query)
expect_null(aa$body)
expect_null(aa$request_headers)
expect_null(aa$response_headers)
expect_null(aa$response)
expect_null(aa$response_sequences)
expect_is(aa$method, "character")
expect_equal(aa$method, "get")
expect_is(aa$uri, "character")
expect_equal(aa$uri, "https:/httpbin.org/get")
expect_is(aa$uri_parts, "list")
expect_equal(aa$uri_parts$domain, "https")
expect_equal(aa$uri_parts$path, "httpbin.org/get")
expect_is(aa$to_s, "function")
expect_equal(aa$to_s(), "GET: https:/httpbin.org/get")
# with
expect_is(aa$with, "function")
expect_null(aa$query)
aa$with(query = list(foo = "bar"))
expect_is(aa$query, "list")
expect_named(aa$query, "foo")
# to_return
expect_is(aa$to_return, "function")
expect_null(aa$body)
aa$to_return(
status = 404,
body = list(hello = "world"),
headers = list(a = 5)
)
expect_is(aa$responses_sequences, "list")
expect_is(aa$responses_sequences$body, "list")
expect_named(aa$responses_sequences$body, "hello")
})
test_that("StubbedRequest: 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...")
})
webmockr/tests/testthat/test-to_return.R 0000644 0001762 0000144 00000011053 13516121243 020204 0 ustar ligges users context("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_named(aa$responses_sequences, c("status", "body", "headers", "body_raw"))
expect_equal(aa$responses_sequences$status, 200)
expect_equal(aa$responses_sequences$body, "stuff")
})
test_that("stubs exist after stub_request called", {
expect_equal(length(stub_registry()$request_stubs), 1)
})
test_that("stub_request fails well", {
expect_error(to_return(), "argument \".data\" is missing")
expect_error(to_return(5), ".data must be of class StubbedRequest")
zzz <- stub_request("get", "https://httpbin.org/get")
# status
expect_error(to_return(zzz, status = "foo"), "must be of class numeric")
# headers
expect_error(to_return(zzz, headers = list(5, 6)), "'headers' must be a named list")
expect_error(to_return(zzz, headers = list(a = 5, 6)), "'headers' must be a named list")
expect_error(to_return(zzz, .list = 4), ".list must be of class list")
})
stub_registry_clear()
enable()
context("to_return: response headers returned all lowercase")
test_that("to_return (response) headers are all lowercase, crul", {
stub <- stub_request(uri = "http://httpbin.org/get") %>%
to_return(headers = list("Foo-Bar" = "baz"))
cli <- crul::HttpClient$new(url = "http://httpbin.org/")
x <- cli$get("get")
expect_is(x$response_headers, "list")
expect_named(x$response_headers, "foo-bar")
})
stub_registry_clear()
test_that("to_return (response) headers are all lowercase, httr", {
loadNamespace("httr")
stub <- stub_request(uri = "http://httpbin.org/get") %>%
to_return(headers = list("Foo-Bar" = "baz"))
x <- httr::GET("http://httpbin.org/get")
expect_is(x$headers, "list")
expect_named(x$headers, "foo-bar")
})
disable()
stub_registry_clear()
enable()
context("to_return: response header values are all character")
test_that("to_return response header values are all character, crul", {
cli <- crul::HttpClient$new(url = "http://httpbin.org/")
stub_request(uri = "http://httpbin.org/get") %>%
to_return(headers = list("Foo-Bar" = 10))
x <- cli$get("get")
expect_is(x$response_headers, "list")
expect_named(x$response_headers, "foo-bar")
expect_is(x$response_headers$`foo-bar`, "character")
expect_equal(x$response_headers$`foo-bar`, "10")
stub_registry_clear()
stub_request(uri = "http://httpbin.org/get") %>%
to_return(headers = list(
a = 10, b = 234233434, c = 2344.342342,
d = "brown", e = as.factor("blue")
))
z <- cli$get("get")
expect_is(z$response_headers, "list")
expect_named(z$response_headers, letters[1:5])
invisible(
vapply(z$response_headers, function(z) expect_is(z, "character"), "")
)
expect_equal(z$response_headers$c, "2344.342342")
expect_equal(z$response_headers$e, "blue")
})
stub_registry_clear()
test_that("to_return response header values are all character, httr", {
loadNamespace("httr")
stub_request(uri = "http://httpbin.org/get") %>%
to_return(headers = list("Foo-Bar" = 10))
x <- httr::GET("http://httpbin.org/get")
expect_is(x$headers, "list")
expect_named(x$headers, "foo-bar")
expect_is(x$headers$`foo-bar`, "character")
expect_equal(x$headers$`foo-bar`, "10")
stub_registry_clear()
stub_request(uri = "http://httpbin.org/get") %>%
to_return(headers = list(
a = 10, b = 234233434, c = 2344.342342,
d = "brown", e = as.factor("blue")
))
z <- httr::GET("http://httpbin.org/get")
expect_is(z$headers, "list")
expect_named(z$headers, letters[1:5])
invisible(
vapply(z$headers, function(z) expect_is(z, "character"), "")
)
expect_equal(z$headers$c, "2344.342342")
expect_equal(z$headers$e, "blue")
})
disable()
context("to_return_: defunct")
test_that("to_return_: defunct", {
expect_error(to_return_(), "to_return", class = "error")
})
webmockr/tests/testthat/httr_obj_auth.rda 0000644 0001762 0000144 00000000557 13570002016 020412 0 ustar ligges users ‹ ]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.R 0000644 0001762 0000144 00000014015 13516121243 017516 0 ustar ligges users context("util fxns: normalize_uri")
test_that("normalize_uri", {
# prunes trailing slash
expect_is(normalize_uri("example.com/"), "character")
expect_match(normalize_uri("example.com/"), "example.com")
# prunes ports 80 and 443
expect_match(normalize_uri("example.com:80"), "example.com")
expect_match(normalize_uri("example.com:443"), "example.com")
# escapes special characters
expect_match(normalize_uri("example.com/foo/bar"),
"example.com/foo%2Fbar")
expect_match(normalize_uri("example.com/foo+bar"),
"example.com/foo%2Bbar")
expect_match(normalize_uri("example.com/foo*bar"),
"example.com/foo%2Abar")
})
context("util fxns: net_connect_explicit_allowed")
test_that("net_connect_explicit_allowed", {
aa <- net_connect_explicit_allowed(
allowed = "example.com",
uri = "http://example.com")
expect_is(aa, "logical")
expect_equal(length(aa), 1)
# works with lists
expect_true(
net_connect_explicit_allowed(
list("example.com", "foobar.org"),
"example.com"
)
)
expect_false(
net_connect_explicit_allowed(
list("example.com", "foobar.org"),
"stuff.io"
)
)
# no uri passed, returns FALSE
expect_false(net_connect_explicit_allowed("google.com"))
# empty character string uri passed, returns FALSE
expect_false(net_connect_explicit_allowed("google.com", ""))
# no allowed passed, errors
expect_error(net_connect_explicit_allowed(),
"argument \"allowed\" is missing")
})
context("util fxns: webmockr_net_connect_allowed")
test_that("webmockr_net_connect_allowed", {
# works with character strings
expect_false(webmockr_net_connect_allowed("example.com"))
expect_false(webmockr_net_connect_allowed("http://example.com"))
expect_false(webmockr_net_connect_allowed("https://example.com"))
# no uri passed, returns FALSE
expect_false(webmockr_net_connect_allowed())
# nonense passed, returns FALSE
expect_false(webmockr_net_connect_allowed(""))
expect_false(webmockr_net_connect_allowed("asdfadfafsd"))
# errors when of wrong class
expect_error(webmockr_net_connect_allowed(mtcars),
"uri must be of class character, list")
})
context("util fxns: webmockr_disable_net_connect")
test_that("webmockr_disable_net_connect", {
# nothing passed
expect_null(sm(webmockr_disable_net_connect()))
expect_message(webmockr_disable_net_connect(), "net connect disabled")
# single uri passed
expect_message(webmockr_disable_net_connect("google.com"), "net connect disabled")
expect_is(sm(webmockr_disable_net_connect("google.com")), "character")
expect_equal(sm(webmockr_disable_net_connect("google.com")), "google.com")
# many uri's passed
expect_message(webmockr_disable_net_connect(c("google.com", "nytimes.com")),
"net connect disabled")
expect_is(sm(webmockr_disable_net_connect(c("google.com", "nytimes.com"))),
"character")
expect_equal(sm(webmockr_disable_net_connect(c("google.com", "nytimes.com"))),
c("google.com", "nytimes.com"))
# errors when of wrong class
expect_error(webmockr_disable_net_connect(5),
"allow must be of class character")
expect_error(webmockr_disable_net_connect(mtcars),
"allow must be of class character")
})
context("util fxns: webmockr_allow_net_connect")
test_that("webmockr_allow_net_connect", {
# first call, sets to TRUE, and returns message
# nothing passed
expect_message(z <- webmockr_allow_net_connect(), "net connect allowed")
expect_true(z)
# check if net collect allowed afterwards, should be TRUE
expect_true(webmockr_net_connect_allowed())
# errors when an argument passed
expect_error(webmockr_allow_net_connect(5), "unused argument")
})
context("util fxns: webmockr_configuration")
test_that("webmockr_configuration", {
expect_is(webmockr_configuration(), "webmockr_config")
expect_named(
webmockr_configuration(),
c('show_stubbing_instructions', 'show_body_diff', 'query_values_notation',
'allow', 'net_http_connect_on_start', 'allow_net_connect',
'allow_localhost')
)
# errors when an argument passed
expect_error(webmockr_configuration(5), "unused argument")
})
context("util fxns: webmockr_configure_reset")
test_that("webmockr_configure_reset", {
# webmockr_configure_reset does the same thing as webmockr_configure
expect_identical(webmockr_configure(), webmockr_configure_reset())
# errors when an argument passed
expect_error(webmockr_configure_reset(5), "unused argument")
})
context("util fxns: defunct")
test_that("webmockr_disable", {
expect_error(webmockr_disable(), "disable", class = "error")
})
test_that("webmockr_enable", {
expect_error(webmockr_enable(), "enable", class = "error")
})
context("util fxns: hdl_lst")
test_that("hdl_lst works", {
expect_equal(hdl_lst(NULL), "")
expect_equal(hdl_lst(character(0)), "")
expect_equal(hdl_lst(raw(0)), "")
expect_equal(hdl_lst(raw(5)), "raw bytes, length: 5")
expect_error(hdl_lst(), "argument \"x\" is missing")
expect_equal(hdl_lst(list(foo = "bar")), "foo=bar")
expect_equal(hdl_lst(list(foo = "5")), "foo=5")
expect_equal(hdl_lst(list(foo = "5", bar = "a")), "foo=5, bar=a")
expect_equal(hdl_lst(1.5), 1.5)
})
context("util fxns: hdl_lst2")
test_that("hdl_lst2 works", {
expect_equal(hdl_lst2(NULL), "")
expect_equal(hdl_lst2(character(0)), "")
expect_equal(hdl_lst2(raw(5)), "")
expect_equal(hdl_lst2(charToRaw("hello")), "hello")
expect_error(hdl_lst2(), "argument \"x\" is missing")
expect_equal(hdl_lst2(list(foo = "bar")), "foo=\"bar\"")
expect_equal(hdl_lst2(list(foo = 5)), "foo=5")
expect_equal(hdl_lst2(list(foo = 5, bar = "a")), "foo=5, bar=\"a\"")
expect_equal(hdl_lst2(list(foo = "bar", stuff = FALSE)), "foo=\"bar\", stuff=FALSE")
expect_equal(hdl_lst2(1.5), 1.5)
})
context("query_mapper")
test_that("query_mapper", {
expect_is(query_mapper, "function")
expect_null(query_mapper(NULL))
expect_equal(query_mapper(5), 5)
expect_equal(query_mapper('aaa'), 'aaa')
expect_equal(query_mapper(mtcars), mtcars)
})
webmockr/tests/testthat/httr_obj.rda 0000644 0001762 0000144 00000000503 13457524755 017407 0 ustar ligges users ‹ ]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÷ ÞŸsHO webmockr/tests/testthat/test-flipswitch.R 0000644 0001762 0000144 00000003171 13457524755 020364 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000001654 13570002016 022267 0 ustar ligges users context("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-StubRegistry.R 0000644 0001762 0000144 00000006225 13571523714 020650 0 ustar ligges users context("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/test-HashCounter.R 0000644 0001762 0000144 00000001571 13107060333 020410 0 ustar ligges users context("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()
x$put("foo bar")
expect_length(x$hash, 1)
expect_equal(x$hash$`foo bar`, 1)
x$put("foo bar")
expect_length(x$hash, 1)
expect_equal(x$hash$`foo bar`, 2)
x$put("hello world")
expect_length(x$hash, 2)
expect_equal(x$hash$`hello world`, 1)
x$put("hello world")
x$put("hello world")
expect_length(x$hash, 2)
expect_equal(x$hash$`hello world`, 3)
})
test_that("HashCounter fails well", {
x <- HashCounter$new()
expect_error(x$get(), "'key' required")
expect_error(x$put(), "'key' required")
})
webmockr/tests/testthat/test-Response.R 0000644 0001762 0000144 00000006474 13415716025 020002 0 ustar ligges users context("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")
aa$set_body(body = "stuff")
expect_equal(aa$body, "stuff")
aa$set_exception(exception = "stop, wait, listen")
expect_equal(aa$exception, "stop, wait, listen")
aa$set_request_headers(headers = list(a = "howdy"))
expect_equal(aa$request_headers[[1]], "howdy")
aa$set_response_headers(headers = list(b = 6))
expect_equal(aa$get_respone_headers()[[1]], "6")
aa$set_status(status = 410)
expect_equal(aa$status_code, 410)
aa$set_url(url = "foobar.com")
expect_equal(aa$url, "foobar.com")
})
test_that("Response fails well", {
expect_error(aa$set_body(), "argument \"body\" is missing")
expect_error(aa$set_exception(), "argument \"exception\" is missing")
expect_error(aa$set_request_headers(), "argument \"headers\" is missing")
expect_error(aa$set_response_headers(), "argument \"headers\" is missing")
expect_error(aa$set_status(), "argument \"status\" is missing")
expect_error(aa$set_url(), "argument \"url\" is missing")
})
webmockr/tests/testthat/test-writing-to-disk.R 0000644 0001762 0000144 00000005706 13571350262 021234 0 ustar ligges users context("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-b-no-cassette-in-use.R 0000644 0001762 0000144 00000001066 13457524755 022053 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000002064 13457524755 020400 0 ustar ligges users context("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_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")
# to_timeout expected stuff
expect_true(aa$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.R 0000644 0001762 0000144 00000001025 13272757522 020310 0 ustar ligges users sm <- 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.R 0000644 0001762 0000144 00000002535 13571350262 020723 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000003243 13457524755 023126 0 ustar ligges users context("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")
library("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()
})
unloadNamespace("crul")
webmockr/tests/testthat/test-CrulAdapter.R 0000644 0001762 0000144 00000011014 13415716025 020374 0 ustar ligges users context("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_crul_stubs, "function")
expect_is(aa$name, "character")
expect_equal(aa$name, "crul_adapter")
})
test_that("CrulAdapter behaves correctly", {
skip_on_cran()
expect_message(aa$enable(), "CrulAdapter enabled!")
expect_message(aa$disable(), "CrulAdapter disabled!")
})
test_that("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")
})
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'
# )
# ))
})
webmockr/tests/testthat/test-to_return_body.R 0000644 0001762 0000144 00000003705 13242646670 021242 0 ustar ligges users context("to_return: response body types behave correctly for crul pkg")
test_that("to_return: setting body behaves correctly", {
webmockr::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-HttrAdapter.R 0000644 0001762 0000144 00000021640 13571565321 020422 0 ustar ligges users context("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_httr_stubs, "function")
expect_is(aa$name, "character")
expect_equal(aa$name, "httr_adapter")
})
test_that("HttrAdapter behaves correctly", {
skip_on_cran()
expect_message(aa$enable(), "HttrAdapter enabled!")
expect_message(aa$disable(), "HttrAdapter disabled!")
})
test_that("build_httr_request/response fail well", {
skip_on_cran()
expect_error(build_httr_request(), "argument \"x\" is missing")
expect_error(build_httr_response(), "argument \"req\" is missing")
})
# library(httr)
# z <- GET("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", 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()
})
webmockr/tests/testthat/test-to_raise.R 0000644 0001762 0000144 00000002701 13274216310 017771 0 ustar ligges users context("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_null(aa$responses_sequences)
expect_false(aa$timeout)
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
expect_true(aa$raise)
expect_is(aa$exceptions, "list")
expect_is(aa$exceptions[[1]], "R6ClassGenerator")
expect_equal(aa$exceptions[[1]]$classname, "HTTPAccepted")
expect_equal(aa$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.R 0000644 0001762 0000144 00000007252 13320534135 022127 0 ustar ligges users context("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-request_registry.R 0000644 0001762 0000144 00000001507 13570002016 021602 0 ustar ligges users context("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]], 'numeric')
})
webmockr/tests/testthat/crul_obj.rda 0000644 0001762 0000144 00000000366 13107754664 017376 0 ustar ligges users ‹ mPM Â0 ëüšA¼yõàZ'âÇÙ_ài7鶲)u•¶ûûj»™CJš¤y/yÍå ^è€!p ]Ç\=palü(–¿Šèn 3[¬½ÅL[¸E¦õó„11å™Pút$„à”i 47€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 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")
})
# cleanup
stub_registry_clear()
context("wi_th_: defunct")
test_that("wi_th_: defunct", {
expect_error(wi_th_(), "wi_th", class = "error")
})
webmockr/tests/testthat/test-RequestPattern.R 0000644 0001762 0000144 00000011420 13516121243 021147 0 ustar ligges users context("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")
})
webmockr/tests/testthat/test-RequestRegistry.R 0000644 0001762 0000144 00000002263 13107067702 021354 0 ustar ligges users context("RequestRegistry")
test_that("RequestRegistry: structure", {
expect_is(RequestRegistry, "R6ClassGenerator")
aa <- RequestRegistry$new()
expect_is(aa, "RequestRegistry")
expect_is(aa$clone, "function")
expect_is(aa$print, "function")
expect_is(aa$register_request, "function")
expect_null(aa$request)
expect_is(aa$request_signatures, "HashCounter")
expect_is(aa$reset, "function")
})
test_that("RequestRegistry: behaves as expected", {
aa <- RequestRegistry$new()
aa$reset()
expect_length(aa$request_signatures$hash, 0)
aa$register_request(request = "GET https://scottchamberlain.info")
aa$register_request(request = "GET https://scottchamberlain.info")
expect_length(aa$request_signatures$hash, 1)
expect_equal(
aa$request_signatures$hash$`GET https://scottchamberlain.info`,
2
)
expect_output(
print(aa), "Registered Requests"
)
expect_output(
print(aa), "GET https://scottchamberlain.info was made"
)
# reset the request registry
aa$reset()
expect_length(aa$request_signatures$hash, 0)
})
test_that("RequestRegistry fails well", {
x <- RequestRegistry$new()
expect_error(x$register_request(), "'key' required")
})
webmockr/tests/testthat/test-onload.R 0000644 0001762 0000144 00000001232 13415716025 017443 0 ustar ligges users context("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.R 0000644 0001762 0000144 00000002332 13415716025 021503 0 ustar ligges users context("RequestSignature")
test_that("RequestSignature: works", {
expect_is(RequestSignature, "R6ClassGenerator")
aa <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get")
expect_is(aa, "RequestSignature")
expect_null(aa$auth)
expect_null(aa$body)
expect_null(aa$headers)
expect_null(aa$proxies)
expect_is(aa$method, "character")
expect_equal(aa$method, "get")
expect_is(aa$uri, "character")
expect_equal(aa$uri, "https:/httpbin.org/get")
expect_is(aa$to_s, "function")
expect_equal(aa$to_s(), "GET: https:/httpbin.org/get")
})
test_that("RequestSignature: different methods work", {
aa <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get")
aa$headers <- list(Accept = "application/json")
aa$body <- list(foo = "bar")
expect_is(aa$method, "character")
expect_is(aa$uri, "character")
expect_is(aa$headers, "list")
expect_is(aa$body, "list")
})
test_that("RequestSignature fails well", {
expect_error(RequestSignature$new(), "argument \"method\" is missing")
expect_error(RequestSignature$new(method = "adf"),
"'arg' should be one of")
expect_error(RequestSignature$new(method = "get"),
"argument \"uri\" is missing")
})
webmockr/tests/testthat/test-HttpLibAdapaterRegistry.R 0000644 0001762 0000144 00000002621 13415716025 022733 0 ustar ligges users context("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, "crul_adapter")
expect_output(print(aa), "HttpLibAdapaterRegistry")
expect_output(print(aa), "crul_adapter")
})
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, "httr_adapter")
expect_output(print(aa), "HttpLibAdapaterRegistry")
expect_output(print(aa), "httr_adapter")
})
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/ 0000755 0001762 0000144 00000000000 13571575147 012303 5 ustar ligges users webmockr/R/stub_request.R 0000644 0001762 0000144 00000007512 13571350262 015145 0 ustar ligges users #' Stub an http request
#'
#' @export
#' @param method (character) HTTP method, one of "get", "post", "put", "patch",
#' "head", "delete", "options" - or the special "any" (for any method)
#' @param uri (character) The request uri. Can be a full uri, partial, or a
#' regular expression to match many incantations of a uri. required.
#' @param uri_regex (character) A URI represented as regex. See examples
#' @return an object of class `StubbedRequest`, with print method describing
#' the stub.
#' @details Internally, this calls [StubbedRequest] which handles the logic
#'
#' See [stub_registry()] for listing stubs, [stub_registry_clear()]
#' for removing all stubs and [remove_request_stub()] for removing specific
#' stubs
#'
#' 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).
#' @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'))
#' 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'))
#'
#' # 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))
#'
#' # 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.R 0000644 0001762 0000144 00000020402 13571515351 015354 0 ustar ligges users #' @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()
#'
#' # 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()
#'
#' # 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
#' x$to_s()
#'
#' # to timeout
#' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org"))
#' x$to_s()
#' x$to_timeout()
#' x$to_s()
#'
#' # to raise
#' library(fauxpas)
#' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org"))
#' x$to_s()
#' x$to_raise(HTTPBadGateway)
#' x$to_s()
#' }
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 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 timeout (xx) xx
timeout = FALSE,
#' @field exceptions (xx) xx
exceptions = list(),
#' @field raise (xx) xx
raise = FALSE,
#' @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
#' @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 <- if (!is.null(uri)) uri else uri_regex
self$uri <- uri
self$uri_regex <- uri_regex
if (!is.null(uri)) self$uri_parts <- parseurl(self$uri)
},
#' @description print method for the `StubbedRequest` class
#' @param x self
#' @param ... ignored
print = function(x, ...) {
cat(" ", sep = "\n")
cat(paste0(" method: ", self$method), sep = "\n")
cat(paste0(" uri: ", self$uri %||% self$uri_regex), sep = "\n")
cat(" with: ", sep = "\n")
cat(paste0(" query: ", hdl_lst(self$query)), sep = "\n")
cat(paste0(" body: ", hdl_lst(self$body)), sep = "\n")
cat(paste0(" request_headers: ", hdl_lst(self$request_headers)),
sep = "\n")
cat(" to_return: ", sep = "\n")
cat(paste0(" status: ", hdl_lst(self$responses_sequences$status)),
sep = "\n")
cat(paste0(" body: ", hdl_lst(self$responses_sequences$body)),
sep = "\n")
cat(paste0(" response_headers: ",
hdl_lst(self$responses_sequences$headers)),
sep = "\n")
cat(paste0(" should_timeout: ", self$timeout), sep = "\n")
cat(paste0(" should_raise: ",
if (self$raise)
paste0(vapply(self$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.
#' @return nothing returned; sets only
with = function(query = NULL, body = NULL, headers = NULL) {
self$query <- query
self$body <- body
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
self$responses_sequences <- list(
status = status,
body = body,
headers = headers
)
self$responses_sequences$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))
}
}
},
#' @description Response should time out
#' @return nothing returned
to_timeout = function() {
self$timeout <- TRUE
},
#' @description Response should raise an exception `x`
#' @param x (character) an exception message
#' @return nothing returned
to_raise = function(x) {
self$exceptions <- if (inherits(x, "list")) x else list(x)
self$raise <- TRUE
},
#' @description Response as a character string
#' @return (character) the response as a string
to_s = function() {
toret <- c(
make_body(self$responses_sequences$body),
make_status(self$responses_sequences$status),
make_headers(self$responses_sequences$headers)
)
gsub("^\\s+|\\s+$", "", sprintf(
" %s: %s %s %s %s %s %s",
toupper(self$method),
url_builder(self$uri %||% self$uri_regex, self$query),
make_body(self$body),
make_headers(self$request_headers),
if (any(nchar(toret) > 0)) {
sprintf("| to_return: %s %s %s", toret[1], toret[2], toret[3])
} else {
""
},
if (self$timeout) "| should_timeout: TRUE" else "",
if (self$raise)
paste0("| to_raise: ",
paste0(vapply(self$exceptions, "[[", "", "classname"),
collapse = ", ")) else ""
))
}
)
)
webmockr/R/adapter-crul.R 0000644 0001762 0000144 00000025170 13571521313 015000 0 ustar ligges users #' @title CrulAdapter
#' @description \pkg{crul} library adapter
#' @export
#' @family http_lib_adapters
#' @details This adapter modifies \pkg{crul} to allow mocking HTTP requests
CrulAdapter <- R6::R6Class(
'CrulAdapter',
public = list(
#' @field name adapter name
name = "crul_adapter",
#' @description Enable the adapter
#' @return `TRUE`, invisibly
enable = function() {
message("CrulAdapter enabled!")
webmockr_lightswitch$crul <- TRUE
crul::mock(TRUE)
invisible(TRUE)
},
#' @description Disable the adapter
#' @return `FALSE`, invisibly
disable = function() {
message("CrulAdapter disabled!")
webmockr_lightswitch$crul <- FALSE
crul::mock(FALSE)
self$remove_crul_stubs()
invisible(FALSE)
},
#' @description All logic for handling a request
#' @param req a crul request
#' @return various outcomes
handle_request = function(req) {
# put request in request registry
request_signature <- build_crul_request(req)
webmockr_request_registry$register_request(
request = request_signature$to_s()
)
if (request_is_in_cache(request_signature)) {
# if real requests NOT allowed
# even if net connects allowed, we check if stubbed found first
# if user wants to return a partial object
# get stub with response and return that
ss <-
webmockr_stub_registry$find_stubbed_request(request_signature)[[1]]
resp <- Response$new()
resp$set_url(ss$uri)
resp$set_body(ss$body)
resp$set_request_headers(ss$request_headers)
resp$set_response_headers(ss$response_headers)
resp$set_status(ss$status_code %||% 200)
# if user set to_timeout or to_raise, do that
if (ss$timeout || ss$raise) {
if (ss$timeout) {
x <- fauxpas::HTTPRequestTimeout$new()
resp$set_status(x$status_code)
x$do_verbose(resp)
}
if (ss$raise) {
x <- ss$exceptions[[1]]$new()
resp$set_status(x$status_code)
x$do_verbose(resp)
}
}
# generate crul response
# VCR: recordable/ignored
if ("package:vcr" %in% search()) {
cas <- vcr::current_cassette()
if (length(cas$previously_recorded_interactions()) == 0) {
# using vcr, but no recorded interactions to the cassette yet
# use RequestHandler - gets current cassette & record interaction
crul_resp <- vcr::RequestHandlerCrul$new(req)$handle()
}
} else {
crul_resp <- build_crul_response(req, resp)
# add to_return() elements if given
if (length(cc(ss$responses_sequences)) != 0) {
# remove NULLs
toadd <- cc(ss$responses_sequences)
# modify responses
for (i in seq_along(toadd)) {
if (names(toadd)[i] == "status") {
crul_resp$status_code <- toadd[[i]]
}
if (names(toadd)[i] == "body") {
if (inherits(ss$responses_sequences$body_raw, "mock_file")) {
cat(ss$responses_sequences$body_raw$payload,
file = ss$responses_sequences$body_raw$path,
sep = "\n")
ss$responses_sequences$body_raw <-
ss$responses_sequences$body_raw$path
}
crul_resp$content <- ss$responses_sequences$body_raw
}
if (names(toadd)[i] == "headers") {
crul_resp$response_headers <-
names_to_lower(as_character(toadd[[i]]))
crul_resp$response_headers_all <-
list(crul_resp$response_headers)
}
}
}
}
# if vcr loaded: record http interaction into vcr namespace
# VCR: recordable/stubbed_by_vcr ??
if ("package:vcr" %in% search()) {
# get current cassette
cas <- vcr::current_cassette()
crul_resp <- vcr::RequestHandlerCrul$new(req)$handle()
} # vcr is not loaded, skip
# if written to disk, see if we should modify file path
if ("package:vcr" %in% search()) {
if (is.character(crul_resp$content)) {
write_disk_path <- vcr::vcr_configuration()$write_disk_path
write_disk_path <- normalizePath(write_disk_path, mustWork=TRUE)
crul_resp$content <- file.path(write_disk_path, basename(crul_resp$content))
}
}
} else if (webmockr_net_connect_allowed(uri = req$url$url)) {
# if real requests || localhost || certain exceptions ARE
# allowed && nothing found above
tmp <- crul::HttpClient$new(url = req$url$url)
tmp2 <- webmockr_crul_fetch(req)
crul_resp <- build_crul_response(req, tmp2)
# if vcr loaded: record http interaction into vcr namespace
# VCR: recordable
if ("package:vcr" %in% search()) {
# if written to disk, see if we should modify file path
if (is.character(crul_resp$content)) {
if (file.exists(crul_resp$content)) {
write_disk_path <- vcr::vcr_configuration()$write_disk_path
write_disk_path <- normalizePath(write_disk_path, mustWork=TRUE)
crul_resp$content <- file.path(write_disk_path, basename(crul_resp$content))
}
}
# stub request so next time we match it
urip <- crul::url_parse(req$url$url)
m <- vcr::vcr_configuration()$match_requests_on
if (all(m %in% c("method", "uri")) && length(m) == 2) {
stub_request(req$method, req$url$url)
} else if (all(m %in% c("method", "uri", "query")) && length(m) == 3) {
tmp <- stub_request(req$method, req$url$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$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$url)
wi_th(tmp, .list = list(query = urip$parameter, headers = req$headers))
}
# use RequestHandler instead? - which gets current cassette for us
vcr::RequestHandlerCrul$new(req)$handle()
}
} else {
# throw vcr error: should happen when user not using
# use_cassette or insert_cassette
if ("package:vcr" %in% search()) {
vcr::RequestHandlerCrul$new(req)$handle()
}
# no stubs found and net connect not allowed - STOP
x <- "Real HTTP connections are disabled.\nUnregistered request:\n "
y <- "\n\nYou can stub this request with the following snippet:\n\n "
z <- "\n\nregistered request stubs:\n\n"
msgx <- paste(x, request_signature$to_s())
msgy <- paste(y, private$make_stub_request_code(request_signature))
if (length(webmockr_stub_registry$request_stubs)) {
msgz <- paste(
z,
paste0(vapply(webmockr_stub_registry$request_stubs, function(z)
z$to_s(), ""), collapse = "\n ")
)
} else {
msgz <- ""
}
ending <- "\n============================================================"
stop(paste0(msgx, msgy, msgz, ending), call. = FALSE)
}
return(crul_resp)
},
#' @description Remove all crul stubs
#' @return nothing returned; removes all crul request stubs
remove_crul_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 (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 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,
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) {
RequestSignature$new(
method = x$method,
uri = x$url$url,
options = list(
body = x$fields %||% NULL,
headers = x$headers %||% NULL,
proxies = x$proxies %||% NULL,
auth = x$auth %||% NULL,
disk = x$disk %||% NULL
)
)
}
webmockr/R/headers.R 0000644 0001762 0000144 00000002421 13270175254 014027 0 ustar ligges users # 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.R 0000644 0001762 0000144 00000010207 13571350262 013250 0 ustar ligges users http_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, "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, "list")) {
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 = 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)
}
}
}
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)]]
}
webmockr/R/StubRegistry.R 0000644 0001762 0000144 00000010572 13571514564 015075 0 ustar ligges users #' @title StubRegistry
#' @description stub registry to keep track of [StubbedRequest] stubs
#' @export
#' @family stub-registry
#' @examples \dontrun{
#' # Make a stub
#' stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
#' stub1$with(headers = list('User-Agent' = 'R'))
#' stub1$to_return(status = 200, body = "foobar", headers = list())
#' stub1
#'
#' # Make another stub
#' stub2 <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
#' stub2
#'
#' # Put both stubs in the stub registry
#' reg <- StubRegistry$new()
#' reg$register_stub(stub = stub1)
#' reg$register_stub(stub = stub2)
#' reg
#' reg$request_stubs
#' }
StubRegistry <- R6::R6Class(
"StubRegistry",
public = list(
#' @field request_stubs (list) list of request stubs
request_stubs = list(),
#' @field global_stubs (list) list of global stubs
global_stubs = list(),
#' @description print method for the `StubRegistry` class
#' @param x self
#' @param ... ignored
print = function(x, ...) {
cat(" ", sep = "\n")
cat(" Registered Stubs", sep = "\n")
for (i in seq_along(self$request_stubs)) {
cat(" ", self$request_stubs[[i]]$to_s(), "\n")
}
invisible(self$request_stubs)
},
#' @description Register a stub
#' @param stub an object of type [StubbedRequest]
#' @return nothing returned; registers the stub
register_stub = function(stub) {
self$request_stubs <- Filter(length, c(self$request_stubs, stub))
},
#' @description Find a stubbed request
#' @param req an object of class [RequestSignature]
#' @return an object of type [StubbedRequest], if matched
find_stubbed_request = function(req) {
stubs <- c(self$global_stubs, self$request_stubs)
stubs[self$request_stub_for(req)]
},
# response_for_request = function(request_signature) {
# stub <- self$request_stub_for(request_signature)
# evaluate_response_for_request(stub$response, request_signature) %||% NULL
# },
#' @description Find a stubbed request
#' @param request_signature an object of class [RequestSignature]
#' @return logical, 1 or more
request_stub_for = function(request_signature) {
stubs <- c(self$global_stubs, self$request_stubs)
vapply(stubs, function(z) {
tmp <- RequestPattern$new(method = z$method, uri = z$uri,
uri_regex = z$uri_regex, query = z$query,
body = z$body, headers = z$request_headers)
tmp$matches(request_signature)
}, logical(1))
},
#' @description Remove a stubbed request by matching request signature
#' @param stub an object of type [StubbedRequest]
#' @return nothing returned; removes the stub from the registry
remove_request_stub = function(stub) {
xx <- vapply(self$request_stubs, function(x) x$to_s(), "")
if (stub$to_s() %in% xx) {
self$request_stubs <- self$request_stubs[-which(stub$to_s() %in% xx)]
} else {
stop(
"Request stub \n\n ",
stub$to_s(),
"\n\n is not registered.",
call. = FALSE
)
}
},
#' @description Remove all request stubs
#' @return nothing returned; removes all request stubs
remove_all_request_stubs = function() {
self$request_stubs <- list()
},
#' @description Find a stubbed request
#' @param x an object of class [RequestSignature]
#' @return nothing returned; registers the stub
is_registered = function(x) any(self$request_stub_for(x))
)
)
# initialize empty stub registry on package load
webmockr_stub_registry <- new.env()
webmockr_stub_registry <- StubRegistry$new()
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 (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.R 0000644 0001762 0000144 00000002205 13457524755 014234 0 ustar ligges users #' 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
#' @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.R 0000644 0001762 0000144 00000000571 13457524755 013707 0 ustar ligges users http_lib_adapter_registry <- NULL # nocov start
.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
} # nocov end
webmockr/R/globals.R 0000644 0001762 0000144 00000000116 13242617054 014034 0 ustar ligges users if (base::getRversion() >= "2.15.1") {
utils::globalVariables(c("vcr_c"))
}
webmockr/R/query_mapper.R 0000644 0001762 0000144 00000000241 13272667167 015136 0 ustar ligges users # 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.R 0000644 0001762 0000144 00000013001 13571507230 014203 0 ustar ligges users #' @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.null(body) && is.character(body)) {
if (disk) body else charToRaw(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.R 0000644 0001762 0000144 00000012041 13571523477 015735 0 ustar ligges users #' @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,
#' @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")
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")
}
},
#' @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) {
if ('body' %in% names(options)) {
if (!is.null(options$body) && length(options)) {
self$body <- options$body
}
}
if ('headers' %in% names(options)) {
if (!is.null(options$headers) && length(options)) {
self$headers <- options$headers
}
}
if ('proxies' %in% names(options)) {
if (!is.null(options$proxies) && length(options)) {
self$proxies <- options$proxies
}
}
if ('auth' %in% names(options)) {
if (!is.null(options$auth) && length(options)) {
self$auth <- options$auth
}
}
if ('disk' %in% names(options)) {
if (!is.null(options$disk) && length(options)) {
self$disk <- options$disk
}
}
}
)
)
cat_foo <- function(x) {
cat(paste0(" ",
paste0(paste(names(x), x, sep = ": "),
collapse = "\n ")), sep = "\n")
}
to_string <- function(x) {
if (inherits(x, "list") && all(nchar(names(x)) > 0)) {
tmp <- paste0(paste(names(x), x, sep = ": "), collapse = ", ")
} else if (inherits(x, "list") && any(nchar(names(x)) == 0)) {
tmp <- paste0(paste(names(x), x, sep = ": "), collapse = ", ")
} else {
tmp <- paste0(x, collapse = ", ")
}
return(sprintf("{%s}", tmp))
}
webmockr/R/stub_registry.R 0000644 0001762 0000144 00000001267 13242621430 015317 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000004125 13571350262 016455 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000000604 13457524755 014620 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000031015 13571565116 015020 0 ustar ligges users #' @title HttrAdapter
#' @description `httr` library adapter
#' @export
#' @family http_lib_adapters
#' @details This adapter modifies \pkg{httr} to allow mocking HTTP requests
#' @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)
#' }
#' }
HttrAdapter <- R6::R6Class(
'HttrAdapter',
public = list(
#' @field name adapter name
name = "httr_adapter",
#' @description Enable the adapter
#' @return `TRUE`, invisibly
enable = function() {
message("HttrAdapter enabled!")
webmockr_lightswitch$httr <- TRUE
httr_mock(TRUE)
invisible(TRUE)
},
#' @description Disable the adapter
#' @return `FALSE`, invisibly
disable = function() {
message("HttrAdapter disabled!")
webmockr_lightswitch$httr <- FALSE
httr_mock(FALSE)
self$remove_httr_stubs()
invisible(FALSE)
},
#' @description All logic for handling a request
#' @param req a httr request
#' @return various outcomes
handle_request = function(req) {
# put request in request registry
request_signature <- build_httr_request(req)
webmockr_request_registry$register_request(
request = request_signature$to_s()
)
if (request_is_in_cache(request_signature)) {
# if real requests NOT allowed
# even if net connects allowed, we check if stubbed found first
# if user wants to return a partial object
# get stub with response and return that
ss <-
webmockr_stub_registry$find_stubbed_request(request_signature)[[1]]
resp <- Response$new()
resp$set_url(ss$uri)
resp$set_body(ss$body)
resp$set_request_headers(ss$request_headers)
resp$set_response_headers(ss$response_headers)
resp$set_status(as.integer(ss$status_code %||% 200))
# if user set to_timeout or to_raise, do that
if (ss$timeout || ss$raise) {
if (ss$timeout) {
x <- fauxpas::HTTPRequestTimeout$new()
resp$set_status(x$status_code)
x$do_verbose(resp)
}
if (ss$raise) {
x <- ss$exceptions[[1]]$new()
resp$set_status(x$status_code)
x$do_verbose(resp)
}
}
# generate httr response
# VCR: recordable/ignored
if ("package:vcr" %in% search()) {
cas <- vcr::current_cassette()
if (length(cas$previously_recorded_interactions()) == 0) {
# using vcr, but no recorded interactions to the cassette yet
# use RequestHandler - gets current cassette & record interaction
httr_resp <- vcr::RequestHandlerHttr$new(req)$handle()
}
} else {
httr_resp <- build_httr_response(req, resp)
# add to_return() elements if given
if (length(cc(ss$responses_sequences)) != 0) {
# remove NULLs
toadd <- cc(ss$responses_sequences)
# modify responses
for (i in seq_along(toadd)) {
if (names(toadd)[i] == "status") {
httr_resp$status_code <- as.integer(toadd[[i]])
}
if (names(toadd)[i] == "body") {
if (inherits(ss$responses_sequences$body_raw, "mock_file")) {
cat(ss$responses_sequences$body_raw$payload,
file = ss$responses_sequences$body_raw$path,
sep = "\n")
ss$responses_sequences$body_raw <-
structure(ss$responses_sequences$body_raw$path,
class = "path")
}
if (
(attr(ss$responses_sequences$body_raw, "type") %||% "")
== "file"
) {
attr(ss$responses_sequences$body_raw, "type") <- NULL
ss$responses_sequences$body_raw <-
structure(ss$responses_sequences$body_raw, class = "path")
}
httr_resp$content <- ss$responses_sequences$body_raw
}
if (names(toadd)[i] == "headers") {
httr_resp$headers <-
httr::insensitive(names_to_lower(as_character(toadd[[i]])))
}
}
}
}
# if vcr loaded: record http interaction into vcr namespace
# VCR: recordable/stubbed_by_vcr ??
if ("package:vcr" %in% search()) {
# get current cassette
cas <- vcr::current_cassette()
httr_resp <- vcr::RequestHandlerHttr$new(req)$handle()
} # vcr is not loaded, skip
} else if (webmockr_net_connect_allowed(uri = req$url)) {
# if real requests || localhost || certain exceptions ARE
# allowed && nothing found above
httr_mock(FALSE)
httr_resp <- eval(parse(text = paste0("httr::", req$method)))(
req$url,
body = get_httr_body(req),
do.call(httr::config, req$options),
httr::add_headers(req$headers),
if (!is.null(req$output$path)) httr::write_disk(req$output$path, TRUE)
)
httr_mock(TRUE)
# if vcr loaded: record http interaction into vcr namespace
# VCR: recordable
if ("package:vcr" %in% search()) {
# stub request so next time we match it
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))
}
vcr::RequestHandlerHttr$new(req)$handle()
}
} else {
# throw vcr error: should happen when user not using
# use_cassette or insert_cassette
if ("package:vcr" %in% search()) {
vcr::RequestHandlerHttr$new(req)$handle()
}
# no stubs found and net connect not allowed - STOP
x <- "Real HTTP connections are disabled.\nUnregistered request:\n "
y <- "\n\nYou can stub this request with the following snippet:\n\n "
z <- "\n\nregistered request stubs:\n\n"
msgx <- paste(x, request_signature$to_s())
msgy <- paste(y, private$make_stub_request_code(request_signature))
if (length(webmockr_stub_registry$request_stubs)) {
msgz <- paste(
z,
paste0(vapply(webmockr_stub_registry$request_stubs, function(z)
z$to_s(), ""), collapse = "\n ")
)
} else {
msgz <- ""
}
ending <- "\n============================================================"
stop(paste0(msgx, msgy, msgz, ending), call. = FALSE)
}
return(httr_resp)
},
#' @description Remove all crul stubs
#' @return nothing returned; removes all httr request stubs
remove_httr_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 (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 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(req$url$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)) {
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
}
#' Build a httr request
#' @export
#' @param x an unexecuted httr request object
#' @return a httr request
build_httr_request = function(x) {
RequestSignature$new(
method = x$method,
uri = x$url,
options = list(
body = x$fields %||% NULL,
headers = as.list(x$headers) %||% NULL,
proxies = x$proxies %||% NULL,
auth = x$auth %||% NULL,
disk = x$disk %||% NULL
)
)
}
#' Turn on httr mocking
#' @export
#' @param on (logical) set to `TRUE` to turn on, and `FALSE`
#' to turn off. default: `TRUE`
#' @return silently sets a callback that routes httr request
#' through webmockr
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)
}
}
# copied over from vcr
get_httr_body <- function(x) {
if (
is.null(x$fields) && {
if (is.null(x$options$postfieldsize)) return(FALSE)
x$options$postfieldsize == 0
}
) {
return(NULL)
}
if (!is.null(x$fields)) {
form_file_comp <- vapply(x$fields, inherits, logical(1), "form_file")
if (any(form_file_comp)) {
ff <- x$fields[form_file_comp][[1]]
return(ff)
} else {
return(x$fields)
}
}
if (!is.null(x$options$postfields)) {
if (is.raw(x$options$postfields)) return(rawToChar(x$options$postfields))
}
}
webmockr/R/to_return.R 0000644 0001762 0000144 00000004527 13571350262 014444 0 ustar ligges users #' 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
#' @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.
#' @examples
#' # first, make a stub object
#' (req <- stub_request("post", "https://httpbin.org/post"))
#'
#' # add status, body and/or headers
#' to_return(req, status = 200)
#' to_return(req, body = "stuff")
#' to_return(req, body = list(a = list(b = "world")))
#' to_return(req, headers = list(a = 5))
#' to_return(req, status = 200, body = "stuff", headers = list(a = 5))
#'
#' # .list - pass in a named list instead
#' to_return(req, .list = list(body = list(foo = "bar")))
to_return <- 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("status", "body", "headers") %in% names(z)) &&
length(z) != 0
) {
stop("'to_return' only accepts status, body, headers")
}
assert(z$status, "numeric")
assert(z$headers, "list")
if (!all(hz_namez(z$headers))) stop("'headers' must be a named list")
.data$to_return(
status = z$status,
body = z$body,
headers = z$headers
)
return(.data)
}
webmockr/R/request_is_in_cache.R 0000644 0001762 0000144 00000000220 13076516661 016410 0 ustar ligges users # Check if request is in cache
request_is_in_cache <- function(request_signature) {
webmockr_stub_registry$is_registered(request_signature)
}
webmockr/R/mock_file.R 0000644 0001762 0000144 00000001251 13571350262 014342 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000000640 13242621472 016465 0 ustar ligges users #' Clear the stub registry
#'
#' Clear all stubs
#'
#' @export
#' @return nothing, well technically an empty list invisibly, but
#' it's not anything useful
#' @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.R 0000644 0001762 0000144 00000000213 13040740114 013332 0 ustar ligges users #' Pipe operator
#'
#' @name %>%
#' @rdname pipe
#' @keywords internal
#' @export
#' @importFrom magrittr %>%
#' @usage lhs \%>\% rhs
NULL
webmockr/R/webmockr-opts.R 0000644 0001762 0000144 00000011661 13570002016 015202 0 ustar ligges users #' webmockr configuration
#'
#' @export
#' @param allow_net_connect (logical) Default: `FALSE`
#' @param allow_localhost (logical) Default: `FALSE`
#' @param allow (character) one or more URI/URL to allow (and by extension
#' all others are not allowed)
#' @param net_http_connect_on_start (logical) Default: `FALSE`. ignored for
#' now
#' @param show_stubbing_instructions (logical) Default: `FALSE`. ignored for
#' now
#' @param query_values_notation (logical) Default: `FALSE`. ignored for
#' now
#' @param show_body_diff (logical) Default: `FALSE`. ignored for
#' now
#' @param uri (character) a URI/URL as a character string - to determine
#' whether or not it is allowed
#'
#' @section webmockr_allow_net_connect:
#' If there are stubs found for a request, even if net connections are
#' allowed (by running `webmockr_allow_net_connect()`) the stubbed
#' response will be returned. If no stub is found, and net connections
#' are allowed, then a real HTTP request can be made.
#'
#' @examples \dontrun{
#' webmockr_configure()
#' webmockr_configure(
#' allow_localhost = TRUE
#' )
#' webmockr_configuration()
#' webmockr_configure_reset()
#'
#' webmockr_allow_net_connect()
#' webmockr_net_connect_allowed()
#'
#' # disable net connect for any URIs
#' webmockr_disable_net_connect()
#' ### gives NULL with no URI passed
#' webmockr_net_connect_allowed()
#' # disable net connect EXCEPT FOR given URIs
#' webmockr_disable_net_connect(allow = "google.com")
#' ### is a specific URI allowed?
#' webmockr_net_connect_allowed("google.com")
#' }
webmockr_configure <- function(
allow_net_connect = FALSE,
allow_localhost = FALSE,
allow = NULL,
net_http_connect_on_start = FALSE,
show_stubbing_instructions = FALSE,
query_values_notation = FALSE,
show_body_diff = FALSE) {
opts <- list(
allow_net_connect = allow_net_connect,
allow_localhost = allow_localhost,
allow = allow,
net_http_connect_on_start = net_http_connect_on_start,
show_stubbing_instructions = show_stubbing_instructions,
query_values_notation = query_values_notation,
show_body_diff = show_body_diff
)
for (i in seq_along(opts)) {
assign(names(opts)[i], opts[[i]], envir = webmockr_conf_env)
}
webmockr_configuration()
}
#' @export
#' @rdname webmockr_configure
webmockr_configure_reset <- function() webmockr_configure()
#' @export
#' @rdname webmockr_configure
webmockr_configuration <- function() {
structure(as.list(webmockr_conf_env), class = "webmockr_config")
}
#' @export
#' @rdname webmockr_configure
webmockr_allow_net_connect <- function() {
if (!webmockr_net_connect_allowed()) {
message("net connect allowed")
assign('allow_net_connect', TRUE, envir = webmockr_conf_env)
}
}
#' @export
#' @rdname webmockr_configure
webmockr_disable_net_connect <- function(allow = NULL) {
assert(allow, "character")
message("net connect disabled")
assign('allow_net_connect', FALSE, envir = webmockr_conf_env)
assign('allow', allow, envir = webmockr_conf_env)
}
#' @export
#' @rdname webmockr_configure
webmockr_net_connect_allowed <- function(uri = NULL) {
assert(uri, c("character", "list"))
if (is.null(uri)) return(webmockr_conf_env$allow_net_connect)
uri <- normalize_uri(uri)
webmockr_conf_env$allow_net_connect ||
(webmockr_conf_env$allow_localhost && is_localhost(uri) ||
`!!`(webmockr_conf_env$allow) &&
net_connect_explicit_allowed(webmockr_conf_env$allow, uri))
}
net_connect_explicit_allowed <- function(allowed, uri = NULL) {
if (is.null(allowed)) return(FALSE)
if (is.null(uri)) return(FALSE)
z <- parse_a_url(uri)
if (is.na(z$domain)) return(FALSE)
if (inherits(allowed, "list")) {
any(vapply(allowed, net_connect_explicit_allowed, logical(1), uri = uri))
} else if (inherits(allowed, "character")) {
if (length(allowed) == 1) {
allowed == uri ||
allowed == z$domain ||
allowed == sprintf("%s:%s", z$domain, z$port) ||
allowed == sprintf("%s://%s:%s", z$scheme, z$domain, z$port) ||
allowed == sprintf("%s://%s", z$scheme, z$domain) &&
z$port == z$default_port
} else {
any(vapply(allowed, net_connect_explicit_allowed, logical(1), uri = uri))
}
}
}
#' @export
print.webmockr_config <- function(x, ...) {
cat("", sep = "\n")
cat(paste0(" crul enabled?: ", webmockr_lightswitch$crul), sep = "\n")
cat(paste0(" httr enabled?: ", webmockr_lightswitch$httr), sep = "\n")
cat(paste0(" allow_net_connect?: ", x$allow_net_connect), sep = "\n")
cat(paste0(" allow_localhost?: ", x$allow_localhost), sep = "\n")
cat(paste0(" allow: ", x$allow %||% ""), sep = "\n")
cat(paste0(" net_http_connect_on_start: ", x$net_http_connect_on_start),
sep = "\n")
cat(paste0(" show_stubbing_instructions: ", x$show_stubbing_instructions),
sep = "\n")
cat(paste0(" query_values_notation: ", x$query_values_notation), sep = "\n")
cat(paste0(" show_body_diff: ", x$show_body_diff), sep = "\n")
}
webmockr_conf_env <- new.env()
webmockr/R/RequestPattern.R 0000644 0001762 0000144 00000043331 13571521412 015402 0 ustar ligges users #' @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 = "https://httpbin.org/get"))
#' x$body_pattern
#' x$headers_pattern
#' x$method_pattern
#' x$uri_pattern
#' x$to_s()
#'
#' # make a request signature
#' rs <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get")
#'
#' # check if it matches
#' x$matches(rs)
#'
#' # regex uri
#' (x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org"))
#' x$uri_pattern
#' x$uri_pattern$to_s()
#' x$to_s()
#'
#' # uri with query parameters
#' (x <- RequestPattern$new(
#' method = "get", uri = "https://httpbin.org/get",
#' query = list(foo = "bar")
#' ))
#' x$to_s()
#'
#' # 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)
#' }
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)) {
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
#' z <- BodyPattern$new(pattern = list(foo = "bar"))
#' 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) {
self$pattern <- pattern
},
#' @description Match a list of headers against that stored
#' @param body (list) the body
#' @param content_type (character) content type
#' @return a boolean
matches = function(body, content_type = "") {
if (inherits(self$pattern, "list")) {
if (length(self$pattern) == 0) return(TRUE)
private$matching_hashes(private$body_as_hash(body, content_type), self$pattern)
} else {
private$empty_string(self$pattern) && private$empty_string(body) ||
self$pattern == body
}
},
#' @description Print pattern for easy human consumption
#' @return a string
to_s = function() self$pattern
),
private = list(
empty_headers = function(headers) {
is.null(headers) || length(headers) == 0
},
empty_string = function(string) {
is.null(string) || nchar(string) == 0
},
matching_hashes = function(z, pattern) {
if (is.null(z)) return(FALSE)
if (!inherits(z, "list")) return(FALSE)
if (!all(sort(names(z)) %in% sort(names(pattern)))) return(FALSE)
for (i in seq_along(z)) {
expected <- pattern[[names(z)[i]]]
actual <- z[[i]]
if (inherits(actual, "list") && inherits(expected, "list")) {
if (private$matching_hashes(actual, expected)) return(FALSE)
} else {
if (!identical(as.character(actual), as.character(expected))) return(FALSE)
}
}
return(TRUE)
},
body_as_hash = function(body, content_type) {
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")
#' z$matches("http://foobar.com/")
#'
#' # default ports
#' (z <- UriPattern$new(pattern = "http://foobar.com"))
#' z$matches("http://foobar.com:80")
#' z$matches("http://foobar.com:80/")
#' z$matches("http://foobar.com:443")
#' z$matches("http://foobar.com:443/")
#'
#' # user info
#' (z <- UriPattern$new(pattern = "http://foobar.com"))
#' z$matches("http://user:pass@foobar.com")
#'
#' # regex
#' (z <- UriPattern$new(regex_pattern = ".+ample\\.."))
#' z$matches("http://sample.org")
#' z$matches("http://example.com")
#' z$matches("http://tramples.net")
#'
#' # add query parameters
#' (z <- UriPattern$new(pattern = "http://foobar.com"))
#' z$add_query_params(list(pizza = "cheese", cheese = "cheddar"))
#' z$pattern
#'
#' (z <- UriPattern$new(pattern = "http://foobar.com"))
#' z$pattern
#' z$add_query_params(list(pizza = "deep dish", cheese = "cheddar"))
#' z$pattern
#'
#' # any pattern
#' (z <- UriPattern$new(regex_pattern = ".+"))
#' z$regex
#' z$pattern
#' z$matches("http://stuff.com")
#' z$matches("https://stuff.com")
#' z$matches("https://stuff.com/stff")
#' z$matches("https://stuff.com/apple?bears=3")
UriPattern <- R6::R6Class(
'UriPattern',
public = list(
#' @field pattern (character) pattern holder
pattern = NULL,
#' @field regex a logical
regex = FALSE,
#' @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
self$pattern <- normalize_uri(add_scheme(pattern))
},
#' @description Match a list of headers against that stored
#' @param uri (character) a uri
#' @return a boolean
matches = function(uri) {
# normalize uri
uri <- normalize_uri(uri)
# FIXME: may need to match optionally to URI alone or URI + query
# params, etc.
if (!self$regex) return(uri == self$pattern)
if (self$regex) return(grepl(self$pattern, uri))
},
#' @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 (
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) {
x <- prune_trailing_slash(x)
x <- prune_port(x)
tmp <- urltools::url_parse(x)
if (is.na(tmp$path)) return(x)
tmp$path <- esc(tmp$path)
urltools::url_compose(tmp)
}
prune_trailing_slash <- function(x) sub("/$", "", x)
prune_port <- function(x) gsub("(:80)|(:443)", "", x)
# 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
## 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.R 0000644 0001762 0000144 00000002266 13571355343 017026 0 ustar ligges users #' @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.R 0000644 0001762 0000144 00000004417 13457524755 013550 0 ustar ligges users #' Set additional parts of a stubbed request
#'
#' Set query params, request body, and/or request headers
#'
#' @export
#' @param .data input. Anything that can be coerced to a `StubbedRequest` class
#' object
#' @param ... Comma separated list of named variables. accepts the following:
#' `query`, `body`, `headers`.
#' @param .list named list, has to be one of 'query', 'body',
#' and/or 'headers'. 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, and headers:
#'
#' - query: (list) a named list
#' - body: various, including character string, list, raw, numeric, etc
#' - headers: (list) a named list
#'
#' @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)
#'
#' # 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")))
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") %in% names(z)) &&
length(z) != 0
) {
stop("'wi_th' only accepts query, body, headers")
}
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")
.data$with(
query = z$query,
body = z$body,
headers = z$headers
)
return(.data)
}
webmockr/R/RequestRegistry.R 0000644 0001762 0000144 00000006074 13571513166 015607 0 ustar ligges users #' @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$put("foo bar")
#' x$put("foo bar")
#' x$put("hello world")
#' x$put("hello world")
#' x$put("hello world")
#' x$hash
HashCounter <- R6::R6Class(
'HashCounter',
public = list(
#' @field hash (list) a list for internal use only
hash = list(),
#' @description Register a request by it's key
#' @param key a character string of the request, serialized from
#' [CrulAdapter] or another adapter
#' @return nothing returned; registers request and iterates
#' internal counter
put = function(key) {
if (missing(key)) stop("'key' required")
self$hash[key] <- (self$hash[[key]] %||% 0) + 1
},
#' @description Get a request by key
#' @param key a character string of the request, serialized from
#' [CrulAdapter] or another adapter
#' @return (character) an http request as a string
get = function(key) {
if (missing(key)) stop("'key' required")
self$hash[[key]] %||% 0
}
)
)
#' @title RequestRegistry
#' @description keeps track of HTTP requests
#' @export
#' @family request-registry
#' @seealso [stub_registry()] and [StubRegistry]
#' @examples
#' x <- RequestRegistry$new()
#' x$register_request(request = "GET http://scottchamberlain.info")
#' x$register_request(request = "GET http://scottchamberlain.info")
#' x$register_request(request = "POST https://httpbin.org/post")
#' # print method to list requests
#' x
#'
#' # hashes, and number of times each requested
#' x$request_signatures$hash
#'
#' # reset the request registry
#' x$reset()
RequestRegistry <- R6::R6Class(
'RequestRegistry',
public = list(
#' @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]]
),
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
#' [CrulAdapter] or another adapter
#' @return nothing returned; registers the request
register_request = function(request) {
self$request_signatures$put(request)
}
)
)
# initialize empty request registry on package load
webmockr_request_registry <- new.env()
webmockr_request_registry <- RequestRegistry$new()
webmockr/R/flipswitch.R 0000644 0001762 0000144 00000005540 13457524755 014610 0 ustar ligges users webmockr_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.
#' @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()) {
adnms <- vapply(http_lib_adapter_registry$adapters, function(w) {
sub("_adapter", "", w$name)
}, "")
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()
} else {
invisible(vapply(http_lib_adapter_registry$adapters, function(z) {
pkgname <- sub("_adapter", "", z$name)
# check if package installed first
if (!requireNamespace(pkgname, quietly = TRUE)) {
message(pkgname, " not installed, skipping enable")
FALSE
} else {
# if instaled, enable
z$enable()
}
}, 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()) {
adnms <- vapply(http_lib_adapter_registry$adapters, function(w) {
sub("_adapter", "", w$name)
}, "")
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()
} else {
invisible(vapply(http_lib_adapter_registry$adapters, function(z) {
pkgname <- sub("_adapter", "", z$name)
# check if package installed first
if (!requireNamespace(pkgname, quietly = TRUE)) {
message(pkgname, " not installed, skipping disable")
FALSE
} else {
# if instaled, disable
z$disable()
}
}, logical(1)))
}
}
webmockr/R/webmockr.R 0000644 0001762 0000144 00000001414 13457524755 014241 0 ustar ligges users #' Stubbing and setting expectations on HTTP requests
#'
#' @importFrom R6 R6Class
#' @importFrom fauxpas HTTPRequestTimeout
#' @name webmockr-package
#' @aliases webmockr
#' @docType package
#' @keywords package
#' @author Scott Chamberlain \email{myrmecocystus+r@@gmail.com}
#'
#' @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.R 0000644 0001762 0000144 00000002351 13571575147 016047 0 ustar ligges users #' List 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.R 0000644 0001762 0000144 00000001553 13457524755 014064 0 ustar ligges users #' 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/remove_request_stub.R 0000644 0001762 0000144 00000000717 13414707040 016516 0 ustar ligges users #' 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.md 0000644 0001762 0000144 00000017733 13571776246 013216 0 ustar ligges users 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/MD5 0000644 0001762 0000144 00000014101 13572030423 012367 0 ustar ligges users b1f0ab68f33bf15fad4369cca09b4f1d *DESCRIPTION
de9532c5aeb8082a5fc9cbee02186d6f *LICENSE
839d173fdc7c4b1064fc8b708b6a5411 *NAMESPACE
5cc70ec38071bcd3577448ee33523392 *NEWS.md
04e68d6f38da667d6ff2f44a97fa895f *R/HttpLibAdapterRegistry.R
f2aa81b187c33fb7bad7ef5131f60691 *R/RequestPattern.R
67c28682bccf64207d8337d48caf7b10 *R/RequestRegistry.R
8f99e1d07be492d241fbc96791c13184 *R/RequestSignature.R
972a416b5c1ebf633469d2b3f767e09c *R/Response.R
14563b778dd52b5203a4722b1be9cf25 *R/StubRegistry.R
044a76118549591d470d3b93737d8d13 *R/StubbedRequest.R
327239d8f0919ae5f47063e34c9fc1ef *R/adapter-crul.R
1d80b47cba663bcda7dbe9cabd41e0a0 *R/adapter-httr.R
c106024d861656a99ed8fae3c1620c94 *R/defunct.R
49a3f2ce1fca2e5b588a46a63fb42eff *R/flipswitch.R
d64d3ea6fde479b3e3a7c4114d7abb63 *R/globals.R
c4c0b5f41f05d0b04d2cfaa7490e7ac2 *R/headers.R
ddefa0a5b28c1aa46e4823d67a5eb14b *R/mock_file.R
5e32e34b58b0f601cf9cbe0196b62d31 *R/mocking-disk-writing.R
a7485a03a884f1ce6913c9f023df0c48 *R/onload.R
f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/pipe.R
daeed7760bd653cd52477e791314d4cb *R/query_mapper.R
56db156253368fd808bb2fa279befede *R/remove_request_stub.R
1591fbffccf0e3dccd11091bf116ab35 *R/request_is_in_cache.R
253c9d4c9b5f58942328f86c641644f3 *R/request_registry.R
430ac23f312c685d9a8b371a24e5bd52 *R/stub_registry.R
9e8587fe94a38a743b18d63529b9671a *R/stub_registry_clear.R
edb0e8bce6666eb8510efa19e2783e5f *R/stub_request.R
6f1a3d7c748ecdd1d808a8c01115af34 *R/to_raise.R
295107800c80dab9f1ea1a19adf7b647 *R/to_return.R
78d1443f02b9efaf6a0589176816aa0f *R/to_timeout.R
439a6d5e50676a39ca8e62f961b27dbf *R/webmockr-opts.R
d441de87ec39e5953cce4be1a93c98c0 *R/webmockr.R
67f4d98cf5f3ec6a2b9e0ff4c92dd90a *R/wi_th.R
f69e5965e3af0a07991268b5858704ac *R/zzz.R
94aa3878e5c79cfa1d5aefecf7ce8e37 *README.md
bfab6207f448fab82e6cd42ebc3abbf2 *inst/ignore/adapter-httr.R
c2dad18498a5fbbfa1ad2b9618072bcb *inst/ignore/sockets.R
2580c75892800351cc9942a567bd0ee9 *man/BodyPattern.Rd
67c3289595f0acb4050e221dd3573bec *man/CrulAdapter.Rd
deef8987a513b1069079e51cf8aa8538 *man/HashCounter.Rd
1fec96bfe2e66290c2732bf0a356bd8a *man/HeadersPattern.Rd
825e746a12ba5d0f0b8fd370c48ced35 *man/HttpLibAdapaterRegistry.Rd
c09810f34ceac3ffe9be3337120f482d *man/HttrAdapter.Rd
a25aefb90e4f075126829fa31886a993 *man/MethodPattern.Rd
d9b9bee6393f8e982cf7039e511131ce *man/RequestPattern.Rd
140b01f511e126023f7029dffa198395 *man/RequestRegistry.Rd
c1532ef84677f61e32f6d07246c6ed49 *man/RequestSignature.Rd
2f484e6e897f5279ab4a08c84da3d50f *man/Response.Rd
544ebdcb203979bce3a11f3790c16e93 *man/StubRegistry.Rd
3660d0d828d405462a6deae4df08d1f9 *man/StubbedRequest.Rd
0e5abc54087354341d5dde927fd96cca *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
7e71d956141c171d1ef1f0b22867ce64 *man/enable.Rd
a58995f00ad7a722a624434f722ad7f2 *man/httr_mock.Rd
ebfaadcba0c55dafbe78d030064d23e0 *man/mock_file.Rd
178e2c751424415620fe495ea68b9452 *man/mocking-disk-writing.Rd
e17f41e959fd90a1736ad0fc8ee7ff81 *man/pipe.Rd
4d619ce1b8c5922cac0c2f6767e9fdc3 *man/remove_request_stub.Rd
37fe4935125e6b672aaec47fec019068 *man/request_registry.Rd
3b96ff03cbe89852e97b48fb1621ce90 *man/stub_registry.Rd
c8279c454d72f63d224157c12dd54fa1 *man/stub_registry_clear.Rd
d533a682037e0afcdb192b95fa8f9cd2 *man/stub_request.Rd
71957369cb7de41f5641dd0551c72e6c *man/to_raise.Rd
a52ffe3bc722db8cf6c1101ade747a58 *man/to_return.Rd
90cbd5a6751fe9042883ffa40fa396d5 *man/to_return_-defunct.Rd
b49744ded1577db1eda32787347902fb *man/to_timeout.Rd
6dec78f38272f4437c3b143e9c53c8fc *man/webmockr-defunct.Rd
2587f40edb21ff64c5397841a989379e *man/webmockr-package.Rd
3d2914d400d64a8dce82bcad27d55efe *man/webmockr_configure.Rd
e5d6b8f058f5f8f0395db6c44148b276 *man/webmockr_crul_fetch.Rd
75b69f3bba04215c723a3d8cc11a9b48 *man/webmockr_disable-defunct.Rd
16199ca3a65851252d381cdcf4e924b1 *man/webmockr_enable-defunct.Rd
d5d951a369d8a57e610a2237e32aad3d *man/wi_th.Rd
32740100031047c3073973060764fa4b *man/wi_th_-defunct.Rd
6695b4e11699caab8ba7c936ff9d0778 *tests/test-all.R
43e9a3a2f19d982c0919de0490556d0c *tests/testthat/crul_obj.rda
30fd0a2b3950040186b1e2772490d9ff *tests/testthat/helper-webmockr.R
6e445177bc7dd6fe536a50a83d8d0c51 *tests/testthat/httr_obj.rda
651e0341d9fba0470f2cf0b81505596d *tests/testthat/httr_obj_auth.rda
b1c55cdae27efd72c555e99ccda3676f *tests/testthat/test-CrulAdapter.R
3b3c8f9cc9dc4b35609a0153d59aeca4 *tests/testthat/test-HashCounter.R
827ba10ad45279e8805fe2f7c24ca6cd *tests/testthat/test-HttpLibAdapaterRegistry.R
ae5896d67dd388dc6963e27e405e7d51 *tests/testthat/test-HttrAdapter.R
ca112a38ab5f74d46b649bbf76c8ac4a *tests/testthat/test-RequestPattern.R
322d4850b93f50b34970c60341d7f804 *tests/testthat/test-RequestRegistry.R
de5fbf0963aec69caaf4918f8d45edb2 *tests/testthat/test-RequestSignature.R
bedb3357b1926446a3d053e8e1dc489f *tests/testthat/test-Response.R
b0baf6487cf094666681178688a88fd4 *tests/testthat/test-StubRegistry.R
25b47264c5c3f753af51b827be820b45 *tests/testthat/test-StubbedRequest.R
f4224c6fd7e1846f3d71dc754d4ba243 *tests/testthat/test-b-no-cassette-in-use.R
ecfb5a3ffafb64de052d3f7ca574d286 *tests/testthat/test-flipswitch.R
2e8d108c47237fc63217dd706bbe1c41 *tests/testthat/test-onload.R
d0f0aef9e2c6dd6b01225c9982fb014e *tests/testthat/test-remove_request_stub.R
906fbace5a02dea076e53fb059128439 *tests/testthat/test-request_registry.R
cadae6a34534bee1aab60f41d6143c4d *tests/testthat/test-stub_request.R
ca78f094ce17e2641a4fd1f038918724 *tests/testthat/test-stub_requests_crul.R
98b341b68b89cf719142c2eb8ee5fe94 *tests/testthat/test-to_raise.R
1824bf48dcbe65d306b9e0d327506c4a *tests/testthat/test-to_return.R
4222e9babb20a18f36f88030afa81392 *tests/testthat/test-to_return_body.R
81185e2310324019125051d2d357e8af *tests/testthat/test-to_timeout.R
5bc16f8dd6becf331b65ac4dc6fb68c2 *tests/testthat/test-wi_th.R
b11a2ab967bdc15763b2f401f6d6a6cd *tests/testthat/test-within_test_that_blocks.R
658fa94e4a0b88704981d3484c047855 *tests/testthat/test-writing-to-disk.R
bb0513a33a127a0c6ced49ff9aefb40c *tests/testthat/test-zutils.R
webmockr/inst/ 0000755 0001762 0000144 00000000000 13572025705 013046 5 ustar ligges users webmockr/inst/ignore/ 0000755 0001762 0000144 00000000000 13572025705 014331 5 ustar ligges users webmockr/inst/ignore/adapter-httr.R 0000644 0001762 0000144 00000005207 13076516612 017060 0 ustar ligges users #' 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.R 0000644 0001762 0000144 00000002522 12774057045 016135 0 ustar ligges users wbenv <- 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)))
}
}