[med-svn] [r-cran-webmockr] 01/02: New upstream version 0.1.0
Andreas Tille
tille at debian.org
Sat Nov 25 21:57:48 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-webmockr.
commit cff1c95e428d9008f689d42e3cae993fc34c48b6
Author: Andreas Tille <tille at debian.org>
Date: Sat Nov 25 22:57:10 2017 +0100
New upstream version 0.1.0
---
DESCRIPTION | 24 ++
LICENSE | 2 +
MD5 | 67 ++++
NAMESPACE | 38 ++
NEWS.md | 6 +
R/HttpLibAdapterRegistry.R | 43 +++
R/RequestPattern.R | 530 ++++++++++++++++++++++++++
R/RequestRegistry.R | 109 ++++++
R/RequestSignature.R | 161 ++++++++
R/Response.R | 294 ++++++++++++++
R/StubRegistry.R | 138 +++++++
R/StubbedRequest.R | 132 +++++++
R/adapter-crul.R | 175 +++++++++
R/flipswitch.R | 21 +
R/globals.R | 3 +
R/headers.R | 52 +++
R/onload.R | 33 ++
R/pipe.R | 9 +
R/remove_request_stub.R | 15 +
R/request_is_in_cache.R | 4 +
R/stub_registry.R | 7 +
R/stub_registry_clear.R | 10 +
R/stub_request.R | 52 +++
R/to_return.R | 34 ++
R/webmockr-opts.R | 114 ++++++
R/webmockr.R | 24 ++
R/wi_th.R | 36 ++
R/zzz.R | 64 ++++
README.md | 226 +++++++++++
inst/ignore/adapter-httr.R | 95 +++++
inst/ignore/sockets.R | 48 +++
man/BodyPattern.Rd | 27 ++
man/CrulAdapter.Rd | 39 ++
man/HashCounter.Rd | 34 ++
man/HeadersPattern.Rd | 46 +++
man/HttpLibAdapaterRegistry.Rd | 27 ++
man/MethodPattern.Rd | 30 ++
man/RequestPattern.Rd | 69 ++++
man/RequestRegistry.Rd | 37 ++
man/RequestSignature.Rd | 71 ++++
man/Response.Rd | 78 ++++
man/StubRegistry.Rd | 67 ++++
man/StubbedRequest.Rd | 64 ++++
man/UriPattern.Rd | 60 +++
man/enable.Rd | 17 +
man/pipe.Rd | 12 +
man/remove_request_stub.Rd | 28 ++
man/stub_registry.Rd | 20 +
man/stub_registry_clear.Rd | 19 +
man/stub_request.Rd | 64 ++++
man/to_return.Rd | 31 ++
man/webmockr-package.Rd | 31 ++
man/webmockr_configure.Rd | 67 ++++
man/wi_th.Rd | 35 ++
tests/test-all.R | 2 +
tests/testthat/crul_obj.rda | Bin 0 -> 246 bytes
tests/testthat/test-CrulAdapter.R | 59 +++
tests/testthat/test-HashCounter.R | 42 ++
tests/testthat/test-HttpLibAdapaterRegistry.R | 38 ++
tests/testthat/test-RequestPattern.R | 76 ++++
tests/testthat/test-RequestRegistry.R | 48 +++
tests/testthat/test-RequestSignature.R | 42 ++
tests/testthat/test-Response.R | 97 +++++
tests/testthat/test-StubRegistry.R | 105 +++++
tests/testthat/test-StubbedRequest.R | 89 +++++
tests/testthat/test-flipswitch.R | 29 ++
tests/testthat/test-stub_request.R | 50 +++
tests/testthat/test-wi_th.R | 38 ++
68 files changed, 4254 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..ae05064
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,24 @@
+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.
+Version: 0.1.0
+Authors at R: person("Scott", "Chamberlain", role = c("aut", "cre"), email =
+ "myrmecocystus+r at gmail.com")
+License: MIT + file LICENSE
+URL: https://github.com/ropensci/webmockr
+BugReports: https://github.com/ropensci/webmockr/issues
+LazyData: true
+Imports: curl, jsonlite, magrittr (>= 1.5), lazyeval (>= 0.2.0), R6 (>=
+ 2.1.3), urltools (>= 1.6.0)
+Suggests: roxygen2 (>= 6.0.1), testthat, crul (>= 0.3.4)
+RoxygenNote: 6.0.1
+NeedsCompilation: no
+Packaged: 2017-05-20 05:58:16 UTC; sacmac
+Author: Scott Chamberlain [aut, cre]
+Maintainer: Scott Chamberlain <myrmecocystus+r at gmail.com>
+Repository: CRAN
+Date/Publication: 2017-05-20 07:09:44 UTC
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..37ee2c7
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,2 @@
+YEAR: 2017
+COPYRIGHT HOLDER: Scott Chamberlain
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..faf6174
--- /dev/null
+++ b/MD5
@@ -0,0 +1,67 @@
+8a9fdf4fb7d208f13d63d4a71a0c38b9 *DESCRIPTION
+c5af52351472a750055a760a8924ce71 *LICENSE
+4d82566602f57ce11096b45ea7047b2c *NAMESPACE
+31541443fa75794380be7190164750ef *NEWS.md
+1d57690083903f22a871f90f00f9bf26 *R/HttpLibAdapterRegistry.R
+e4d7dca4621121f3180f5857f2305892 *R/RequestPattern.R
+f75c830437037280b72da6cf1b95f7be *R/RequestRegistry.R
+66a6621108dfe2ce28395c9bea3bd43a *R/RequestSignature.R
+a453297dffb5440ae814e4e91d8ce0af *R/Response.R
+b17e26dfe4baa9fdec82061215bd3400 *R/StubRegistry.R
+5bd4e0ad42cad41d647bab55dba8b6f2 *R/StubbedRequest.R
+948a2c3ac917929f5c5e4b60a4661bce *R/adapter-crul.R
+1c0cea5e0e135547036b1e9acbf40d46 *R/flipswitch.R
+d64d3ea6fde479b3e3a7c4114d7abb63 *R/globals.R
+df2d78c4834ed882b32d776442e710f5 *R/headers.R
+556ac20c5e37419f278c25765eed55cf *R/onload.R
+f583f5b5856f7cb5f2c5fbb04f39f8a8 *R/pipe.R
+56db156253368fd808bb2fa279befede *R/remove_request_stub.R
+1591fbffccf0e3dccd11091bf116ab35 *R/request_is_in_cache.R
+e460927529aa8f3aaca29cef83cc24ae *R/stub_registry.R
+c3180404daf6a2b77f6246a63297186f *R/stub_registry_clear.R
+e7a4dd7bc0e8b4262401df2342ad3ae2 *R/stub_request.R
+ef99a00e9a80e6c6bf268411ae44fa1e *R/to_return.R
+cdb9c16bb481bb80e785a968a973eb1f *R/webmockr-opts.R
+a692851f46491e37495832dccc780f75 *R/webmockr.R
+dc9d767586f7371a0505ffcd264a1813 *R/wi_th.R
+745b2ffdc96b547e670b9f4663e8c110 *R/zzz.R
+b841b6cc58e204b76d3e297e312a2bd3 *README.md
+bfab6207f448fab82e6cd42ebc3abbf2 *inst/ignore/adapter-httr.R
+c2dad18498a5fbbfa1ad2b9618072bcb *inst/ignore/sockets.R
+0ca5e4a771c53cd06f879d58d9a54344 *man/BodyPattern.Rd
+ec3e39c68a0f980c103331690d8a0089 *man/CrulAdapter.Rd
+c196bbf87e855d877094af15e23158e2 *man/HashCounter.Rd
+33b63c8fcb5423a346ef4d1b05f793ef *man/HeadersPattern.Rd
+ec627b3023a5aa6ca42c387da32ca891 *man/HttpLibAdapaterRegistry.Rd
+23390726ada577071131c6c6d51ef326 *man/MethodPattern.Rd
+21019e30ebb880c264ca2dcb22af3fe3 *man/RequestPattern.Rd
+1bfb8622d4bddff89f1be01750f21ce5 *man/RequestRegistry.Rd
+2ca0204d1aa26bd1f12e0112fb61faa3 *man/RequestSignature.Rd
+21da09d6388b0b36036538d9456b9db8 *man/Response.Rd
+c38decc88ddd406fc9ad8c85bb104403 *man/StubRegistry.Rd
+dde266ea76b68f6d57008ce899396a6f *man/StubbedRequest.Rd
+8e5ca8cd0233bfeae442c68beaf09ad8 *man/UriPattern.Rd
+3a11756aab1f70b465ec7e66ddbac3f9 *man/enable.Rd
+e17f41e959fd90a1736ad0fc8ee7ff81 *man/pipe.Rd
+70facf022a7b546d73af0d26dc25f4fe *man/remove_request_stub.Rd
+3c7e64a1b8550341ee65cfab6c0b171c *man/stub_registry.Rd
+3789fa757a2435e10813b1590b6d173d *man/stub_registry_clear.Rd
+c0e96ff8246a5068c8eece205fe0a177 *man/stub_request.Rd
+38a07bd49e9e0417e786553b2b7eb80d *man/to_return.Rd
+e9497f1fe828584fb7dd69af69642eb9 *man/webmockr-package.Rd
+dac7f4d84513f91977a843c3ce8c8ecf *man/webmockr_configure.Rd
+fefa06266cd5551701c9f707f8d3951a *man/wi_th.Rd
+6695b4e11699caab8ba7c936ff9d0778 *tests/test-all.R
+43e9a3a2f19d982c0919de0490556d0c *tests/testthat/crul_obj.rda
+6710e630fe560f076a9e963bf257642d *tests/testthat/test-CrulAdapter.R
+3b3c8f9cc9dc4b35609a0153d59aeca4 *tests/testthat/test-HashCounter.R
+670c4badc6762df39b94577d3c8d4750 *tests/testthat/test-HttpLibAdapaterRegistry.R
+48de2fd421e5cb753835a6862a08d406 *tests/testthat/test-RequestPattern.R
+322d4850b93f50b34970c60341d7f804 *tests/testthat/test-RequestRegistry.R
+7bda6e128575f52027f7d72c9e258981 *tests/testthat/test-RequestSignature.R
+c0387cc7350e4f67596d4e89ac4b91be *tests/testthat/test-Response.R
+33d39acaf9c54f6d75d45731fa06dd94 *tests/testthat/test-StubRegistry.R
+a31ea3b57342682c03ce55142837dc84 *tests/testthat/test-StubbedRequest.R
+685261001875b99f85a6491f1921ee2b *tests/testthat/test-flipswitch.R
+1c3d075244ad19058481a86bdec90c3c *tests/testthat/test-stub_request.R
+3bce8c753f28141f43504dbb44eb263a *tests/testthat/test-wi_th.R
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..b21b199
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,38 @@
+# Generated by roxygen2: do not edit by hand
+
+export("%>%")
+export(BodyPattern)
+export(CrulAdapter)
+export(HashCounter)
+export(HeadersPattern)
+export(HttpLibAdapaterRegistry)
+export(MethodPattern)
+export(RequestPattern)
+export(RequestRegistry)
+export(RequestSignature)
+export(Response)
+export(StubRegistry)
+export(StubbedRequest)
+export(UriPattern)
+export(disable)
+export(enable)
+export(remove_request_stub)
+export(stub_registry)
+export(stub_registry_clear)
+export(stub_request)
+export(to_return)
+export(to_return_)
+export(webmockr_allow_net_connect)
+export(webmockr_configuration)
+export(webmockr_configure)
+export(webmockr_configure_reset)
+export(webmockr_disable)
+export(webmockr_disable_net_connect)
+export(webmockr_enable)
+export(webmockr_net_connect_allowed)
+export(wi_th)
+export(wi_th_)
+import(R6)
+import(lazyeval)
+import(magrittr)
+importFrom(magrittr,"%>%")
diff --git a/NEWS.md b/NEWS.md
new file mode 100644
index 0000000..60b758d
--- /dev/null
+++ b/NEWS.md
@@ -0,0 +1,6 @@
+webmockr 0.1.0
+==============
+
+### NEW FEATURES
+
+* Released to CRAN.
diff --git a/R/HttpLibAdapterRegistry.R b/R/HttpLibAdapterRegistry.R
new file mode 100644
index 0000000..5a5366c
--- /dev/null
+++ b/R/HttpLibAdapterRegistry.R
@@ -0,0 +1,43 @@
+#' http lib adapter registry
+#'
+#' @export
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`register(x)`}{
+#' Register an http library adapter
+#' x: an http lib adapter, e.g., [CrulAdapter]
+#' return: nothing, registers the library adapter
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @examples
+#' x <- HttpLibAdapaterRegistry$new()
+#' x$register(CrulAdapter$new())
+#' x
+#' x$adapters
+#' x$adapters[[1]]$name
+
+HttpLibAdapaterRegistry <- R6::R6Class(
+ 'HttpLibAdapaterRegistry',
+ public = list(
+ adapters = NULL,
+
+ print = function(x, ...) {
+ cat("<HttpLibAdapaterRegistry> ", 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")
+ }
+ },
+
+ register = function(x) {
+ # FIXME: when other adapters supported, change this inherits test
+ if (!inherits(x, "CrulAdapter")) {
+ stop("'x' must be an adapter, such as CrulAdapter", call. = FALSE)
+ }
+ self$adapters <- cc(list(self$adapters, x))
+ }
+ )
+)
diff --git a/R/RequestPattern.R b/R/RequestPattern.R
new file mode 100644
index 0000000..ff44426
--- /dev/null
+++ b/R/RequestPattern.R
@@ -0,0 +1,530 @@
+#' RequestPattern class
+#'
+#' @export
+#' @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
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`matches(request_signature)`}{
+#' Test if request_signature matches a pattern
+#' - request_signature: a request signature
+#' }
+#' \item{`to_s()`}{
+#' Print pattern for easy human consumption
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @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()
+#' }
+RequestPattern <- R6::R6Class(
+ 'RequestPattern',
+ public = list(
+ method_pattern = NULL,
+ uri_pattern = NULL,
+ body_pattern = NULL,
+ headers_pattern = NULL,
+
+ 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)
+ #if (length(options)) private$assign_options(options)
+ },
+
+ matches = function(request_signature) {
+ assert(request_signature, "RequestSignature")
+ c_type <- if (!is.null(request_signature$headers)) request_signature$headers$`Content-Type` else NULL
+ c_type <- if (!is.null(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))
+ },
+
+ 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))
+ }
+ )
+)
+
+#' MethodPattern
+#'
+#' @export
+#' @keywords internal
+#' @param pattern (character) a HTTP method, lowercase
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`matches(method)`}{
+#' An HTTP method
+#' - method (character)
+#' }
+#' }
+#'
+#' @details Matches regardless of case. e.g., POST will match to post
+#' @format NULL
+#' @usage NULL
+#' @examples
+#' (x <- MethodPattern$new(pattern = "post"))
+#' x$pattern
+#' x$matches(method = "post")
+#' x$matches(method = "POST")
+MethodPattern <- R6::R6Class(
+ 'MethodPattern',
+ public = list(
+ pattern = NULL,
+
+ initialize = function(pattern) {
+ self$pattern <- tolower(pattern)
+ },
+
+ matches = function(method) {
+ self$pattern == tolower(method) || self$pattern == "any"
+ },
+
+ to_s = function() self$pattern
+ )
+)
+
+#' HeadersPattern
+#'
+#' @export
+#' @keywords internal
+#' @param pattern (list) a pattern, as a named list, must be named,
+#' e.g,. `list(a = 5, b = 6)`
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`matches(headers)`}{
+#' Match a list of headers against that stored
+#' - headers (list) named list of headers, e.g,. `list(a = 5, b = 6)`
+#' }
+#' }
+#' @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")`
+#' @format NULL
+#' @usage NULL
+#' @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"))
+HeadersPattern <- R6::R6Class(
+ 'HeadersPattern',
+ public = list(
+ pattern = NULL,
+
+ initialize = function(pattern) {
+ stopifnot(is.list(pattern))
+ # # normalize names
+ # names(pattern) <- tolower(names(pattern))
+ # # normalize symbols
+ # ## underscores to single dash
+ # names(pattern) <- gsub("_", "-", names(pattern))
+ pattern <- private$normalize_headers(pattern)
+ self$pattern <- pattern
+ },
+
+ matches = function(headers) {
+ headers <- private$normalize_headers(headers)
+ if (self$empty_headers(self$pattern)) {
+ self$empty_headers(headers)
+ } else {
+ if (self$empty_headers(headers)) return(FALSE)
+ 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)
+ }
+ },
+
+ empty_headers = function(headers) {
+ is.null(headers) || length(headers) == 0
+ },
+
+ to_s = function() 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)
+ }
+ )
+)
+
+#' BodyPattern
+#'
+#' @export
+#' @keywords internal
+#' @param pattern (list) a body object
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`matches(body, content_type = "")`}{
+#' Match a body object against that given in `pattern`
+#' - body (list) the body
+#' - content_type (character) content type
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @examples
+#' z <- BodyPattern$new(pattern = list(a = "foobar"))
+#' z$pattern
+BodyPattern <- R6::R6Class(
+ 'BodyPattern',
+ public = list(
+ pattern = NULL,
+ body = NULL,
+ content_type = NULL,
+ headers = NULL,
+ string = NULL,
+
+ initialize = function(pattern) {
+ self$pattern <- pattern
+ },
+
+ matches = function(body, content_type = "") {
+ if (inherits(self$pattern, "list")) {
+ if (length(self$pattern) == 0) return(TRUE)
+ private$matching_hashes(self$body_as_hash(body, content_type), self$pattern)
+ } else {
+ private$empty_string(self$pattern) && private$empty_string(body) ||
+ self$pattern == body
+ }
+ },
+
+ 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(query_parameters, pattern) {
+ if (inherits(query_parameters, "list")) return(FALSE)
+ if (sort(names(query_parameters)) == sort(names(self$pattern))) return(FALSE)
+ for (i in seq_along(query_parameters)) {
+ expected <- self$pattern[names(query_parameters)[i]]
+ if (inherits(actual, "list") && inherits(expected, "list")) {
+ if (private$matching_hashes(actual, expected)) return(FALSE)
+ } else {
+ if (identical(actual, expected)) return(FALSE)
+ }
+ }
+ },
+
+ body_as_hash = function(body, content_type) {
+ bctype <- BODY_FORMATS[[content_type]]
+ if (bctype == 'json') {
+ jsonlite::fromJSON(body, FALSE)
+ } else if (bctype == 'xml') {
+ xml2::read_xml(body)
+ } else {
+ stop('fix me')
+ }
+ }
+ )
+)
+
+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'
+)
+
+#' UriPattern
+#'
+#' @export
+#' @keywords internal
+#' @param pattern (character) a uri, either plain character string or
+#' regex, see [base::regex]. if scheme is missing, it is added (we assume
+#' http)
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`add_query_params`}{
+#' Add query parameters to the URI
+#' - query_params
+#' }
+#' \item{`matches(uri)`}{
+#' Match a uri against that given in `pattern`
+#' - uri (character) a uri, including scheme (i.e., http or https)
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @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$add_query_params(list(pizza = "deep dish", cheese = "cheddar"))
+#' z$pattern
+
+UriPattern <- R6::R6Class(
+ 'UriPattern',
+ public = list(
+ pattern = NULL,
+ query_params = NULL,
+ regex = FALSE,
+
+ 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))
+ },
+
+ 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))
+ },
+
+ 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)
+ }
+ },
+
+ to_s = function() self$pattern
+ )
+)
+
+add_scheme <- function(x) {
+ if (is.na(urltools::url_parse(x)$scheme)) {
+ paste0('http://', 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)
+
+prune_user_pwd <- function(x)
+
+# matcher helpers --------------------------
+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
+}
+
+is_url <- function(x) {
+ grepl("https?://", x, ignore.case = TRUE) ||
+ grepl("localhost:[0-9]{4}", x, ignore.case = TRUE)
+}
+
+get_uri <- function(x) {
+ x <- as.character(x)
+ #tmp <- grep("(https?|ftp|file)?:?(//)?[-A-Za-z0-9]+\\.[A-Za-z0-9]+", x, value = TRUE)
+ tmp <- x[vapply(x, is_url, logical(1))]
+ if (length(tmp) == 0) NULL else tmp
+}
+
+get_host <- function(x) {
+ eval(parse(text = vcr_c$uri_parser))(x)$hostname
+}
+
+get_path <- function(x) {
+ eval(parse(text = vcr_c$uri_parser))(x)$path
+}
+
+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
+ }
+}
+
diff --git a/R/RequestRegistry.R b/R/RequestRegistry.R
new file mode 100644
index 0000000..0873cf5
--- /dev/null
+++ b/R/RequestRegistry.R
@@ -0,0 +1,109 @@
+#' hash with counter, to store requests, and count each time it is used
+#'
+#' @export
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`put(key)`}{
+#' Register a request by it's key
+#' - key: a character string of the request, serialized from
+#' [CrulAdapter] or other adapter
+#' }
+#' \item{`get(key)`}{
+#' Get a request by key
+#' - key: a character string of the request, serialized from
+#' [CrulAdapter] or other adapter
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @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(
+ hash = list(),
+
+ put = function(key) {
+ if (missing(key)) stop("'key' required")
+ self$hash[key] <- (self$hash[[key]] %||% 0) + 1
+ },
+
+ get = function(key) {
+ if (missing(key)) stop("'key' required")
+ self$hash[[key]] %||% 0
+ }
+ )
+)
+
+#' Request registry
+#'
+#' @export
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`register_request(request)`}{
+#' Register a request
+#' - request: a character string of the request, serialized from
+#' [CrulAdapter] or other adapter
+#' }
+#' \item{`reset()`}{
+#' Reset the registry to no registered requests
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @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(
+ request = NULL,
+ request_signatures = HashCounter$new(),
+
+ print = function(x, ...) {
+ cat("<webmockr request registry> ", 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)
+ },
+
+ reset = function() {
+ self$request_signatures <- HashCounter$new()
+ },
+
+ 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()
diff --git a/R/RequestSignature.R b/R/RequestSignature.R
new file mode 100644
index 0000000..a0d385b
--- /dev/null
+++ b/R/RequestSignature.R
@@ -0,0 +1,161 @@
+#' General purpose request signature builder
+#'
+#' @export
+#' @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.
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`to_s()`}{
+#' Request signature to a string
+#' return: a character string representation of the request signature
+#' }
+#' }
+#'
+#' @section options:
+#' \itemize{
+#' \item body - body as a named list
+#' \item headers - headers as a named list
+#' \item proxies - proxies as a named list
+#' \item auth - authentication details, as a named list
+#' }
+#'
+#' @format NULL
+#' @usage NULL
+#' @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
+#' z <- RequestSignature$new(
+#' method = "get",
+#' uri = "https:/httpbin.org/get",
+#' options = list(headers = list(`User-Agent` = "foobar", stuff = "things"))
+#' )
+#' z
+#' z$headers
+#' z$to_s()
+#'
+#' # headers and body
+#' z <- RequestSignature$new(
+#' method = "get",
+#' uri = "https:/httpbin.org/get",
+#' options = list(
+#' headers = list(`User-Agent` = "foobar", stuff = "things"),
+#' body = list(a = "tables")
+#' )
+#' )
+#' z
+#' z$headers
+#' z$body
+#' z$to_s()
+
+RequestSignature <- R6::R6Class(
+ 'RequestSignature',
+ public = list(
+ method = NULL,
+ uri = NULL,
+ body = NULL,
+ headers = NULL,
+ proxies = NULL,
+ auth = NULL,
+
+ initialize = function(method, uri, options = list()) {
+ verb <- match.arg(tolower(method), http_verbs)
+ self$method <- verb
+ self$uri <- uri
+ if (length(options)) private$assign_options(options)
+ },
+
+ print = function(x, ...) {
+ cat("<RequestSignature> ", 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(z$body)
+ }
+ if (!is.null(self$headers)) {
+ cat(" headers: ", sep = "\n")
+ cat_foo(z$headers)
+ }
+ if (!is.null(self$proxies)) {
+ cat(" proxies: ", sep = "\n")
+ cat_foo(z$proxies)
+ }
+ if (!is.null(self$auth)) {
+ cat(" auth: ", sep = "\n")
+ cat_foo(z$auth)
+ }
+ },
+
+ to_s = function() {
+ gsub("^\\s+|\\s+$", "", paste(
+ 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
+ }
+ }
+ }
+ )
+)
+
+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))
+}
diff --git a/R/Response.R b/R/Response.R
new file mode 100644
index 0000000..137ff34
--- /dev/null
+++ b/R/Response.R
@@ -0,0 +1,294 @@
+#' Response class
+#'
+#' @export
+#' @param options (list) a list of options
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`set_request_headers(headers)`}{
+#' set request headers
+#' - headers: a list of key-value pair headers
+#' }
+#' \item{`get_request_headers()`}{
+#' get request headers
+#' }
+#' \item{`set_response_headers(headers)`}{
+#' set response headers
+#' - headers: a list of key-value pair headers
+#' }
+#' \item{`get_response_headers()`}{
+#' get response headers
+#' }
+#' \item{`set_body(body)`}{
+#' - body: must be a string
+#' }
+#' \item{`get_body()`}{
+#' get body
+#' }
+#' \item{`set_status()`}{
+#' - body: must be an integer status code
+#' }
+#' \item{`get_status()`}{
+#' get status code
+#' }
+#' \item{`set_exception()`}{
+#' set exception
+#' }
+#' \item{`get_exception()`}{
+#' get exception
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @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()
+#'
+#' x$set_exception("exception")
+#' x
+#' x$get_exception()
+#' }
+Response <- R6::R6Class(
+ 'Response',
+ public = list(
+ url = NULL,
+ body = NULL,
+ content = NULL,
+ request_headers = NULL,
+ response_headers = NULL,
+ options = NULL,
+ status_code = 200,
+ exception = NULL,
+ should_timeout = NULL,
+
+ initialize = function(options = list()) {
+ if (inherits(options, "file") || inherits(options, "character")) {
+ self$options <- read_raw_response(options)
+ } else {
+ self$options <- options
+ }
+ },
+
+ print = function(x, ...) {
+ cat("<webmockr response> ", 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: ", self$body), sep = "\n")
+ },
+
+ set_url = function(url) {
+ self$url <- url
+ },
+ get_url = function() self$url,
+
+ set_request_headers = function(headers) {
+ self$request_headers <- private$normalize_headers(headers)
+ },
+ get_request_headers = function() self$request_headers,
+
+ set_response_headers = function(headers) {
+ self$response_headers <- private$normalize_headers(headers)
+ },
+ get_respone_headers = function() self$response_headers,
+
+ set_body = function(body) {
+ self$body <- body
+ },
+ get_body = function() self$body %||% '',
+
+ set_status = function(status) {
+ self$status_code <- status
+ },
+ get_status = function() self$status_code %||% 200,
+
+ set_exception = function(exception) {
+ self$exception <- exception
+ },
+ get_exception = function() self$exception
+ ),
+
+ private = list(
+ normalize_headers = function(x) normalize_headers(x)
+ )
+)
+
+# class ResponseFactory
+# def self.response_for(options)
+# if options.respond_to?(:call)
+# WebMock::DynamicResponse.new(options)
+# else
+# WebMock::Response.new(options)
+# end
+# end
+# end
+
+# class Response
+# def initialize(options = {})
+# if options.is_a?(IO) || options.is_a?(String)
+# self.options = read_raw_response(options)
+# else
+# self.options = options
+# end
+# end
+
+# def headers
+# @headers
+# end
+
+# def headers=(headers)
+# @headers = headers
+# if @headers && !@headers.is_a?(Proc)
+# @headers = Util::Headers.normalize_headers(@headers)
+# end
+# end
+
+# def body
+# @body || ''
+# end
+
+# def body=(body)
+# @body = body
+# assert_valid_body!
+# stringify_body!
+# end
+
+# def status
+# @status || [200, ""]
+# end
+
+# def status=(status)
+# @status = status.is_a?(Integer) ? [status, ""] : status
+# end
+
+# def exception
+# @exception
+# end
+
+# def exception=(exception)
+# @exception = case exception
+# when String then StandardError.new(exception)
+# when Class then exception.new('Exception from WebMock')
+# when Exception then exception
+# end
+# end
+
+# def raise_error_if_any
+# raise @exception if @exception
+# end
+
+# def should_timeout
+# @should_timeout == true
+# end
+
+# def options=(options)
+# options = WebMock::Util::HashKeysStringifier.stringify_keys!(options)
+# HashValidator.new(options).validate_keys('headers', 'status', 'body', 'exception', 'should_timeout')
+# self.headers = options['headers']
+# self.status = options['status']
+# self.body = options['body']
+# self.exception = options['exception']
+# @should_timeout = options['should_timeout']
+# end
+
+# def evaluate(request_signature)
+# self.body = @body.call(request_signature) if @body.is_a?(Proc)
+# self.headers = @headers.call(request_signature) if @headers.is_a?(Proc)
+# self.status = @status.call(request_signature) if @status.is_a?(Proc)
+# @should_timeout = @should_timeout.call(request_signature) if @should_timeout.is_a?(Proc)
+# @exception = @exception.call(request_signature) if @exception.is_a?(Proc)
+# self
+# end
+
+# def ==(other)
+# self.body == other.body &&
+# self.headers === other.headers &&
+# self.status == other.status &&
+# self.exception == other.exception &&
+# self.should_timeout == other.should_timeout
+# end
+
+# private
+
+# def stringify_body!
+# if @body.is_a?(IO) || @body.is_a?(Pathname)
+# io = @body
+# @body = io.read
+# io.close if io.respond_to?(:close)
+# end
+# end
+
+# def assert_valid_body!
+# valid_types = [Proc, IO, Pathname, String, Array]
+# return if @body.nil?
+# return if valid_types.any? { |c| @body.is_a?(c) }
+# raise InvalidBody, "must be one of: #{valid_types}. '#{@body.class}' given"
+# end
+
+# def read_raw_response(raw_response)
+# if raw_response.is_a?(IO)
+# string = raw_response.read
+# raw_response.close
+# raw_response = string
+# end
+# socket = ::Net::BufferedIO.new(raw_response)
+# response = ::Net::HTTPResponse.read_new(socket)
+# transfer_encoding = response.delete('transfer-encoding') #chunks were already read by curl
+# response.reading_body(socket, true) {}
+
+# options = {}
+# options[:headers] = {}
+# response.each_header {|name, value| options[:headers][name] = value}
+# options[:headers]['transfer-encoding'] = transfer_encoding if transfer_encoding
+# options[:body] = response.read_body
+# options[:status] = [response.code.to_i, response.message]
+# options
+# end
+
+# InvalidBody = Class.new(StandardError)
+
+# end
+
+# class DynamicResponse < Response
+# attr_accessor :responder
+
+# def initialize(responder)
+# @responder = responder
+# end
+
+# def evaluate(request_signature)
+# options = @responder.call(request_signature)
+# Response.new(options)
+# end
+# end
diff --git a/R/StubRegistry.R b/R/StubRegistry.R
new file mode 100644
index 0000000..e3f78c3
--- /dev/null
+++ b/R/StubRegistry.R
@@ -0,0 +1,138 @@
+#' Stub registry
+#'
+#' @export
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`register_stub(stub)`}{
+#' Register a stub
+#' - stub: an object of class [StubbedRequest]
+#' }
+#' \item{`find_stubbed_request(req)`}{
+#' Find a stubbed request
+#' - req: an object of class [RequestSignature]
+#' }
+#' \item{`response_for_request(request_signature)`}{
+#' Find a stubbed request
+#' - request_signature: an object of class [RequestSignature]
+#' }
+#' \item{`request_stub_for(request_signature)`}{
+#' Find a stubbed request
+#' - request_signature: an object of class [RequestSignature]
+#' }
+#' \item{`remove_request_stub(stub)`}{
+#' Remove a stubbed request by matching request signature
+#' - stub: an object of class [StubbedRequest]
+#' }
+#' \item{`remove_all_request_stubs()`}{
+#' Remove all request stubs
+#' }
+#' \item{`is_registered(x)`}{
+#' Find a stubbed request
+#' - x: an object of class [RequestSignature]
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @family stub-registry
+#' @examples \dontrun{
+#' # Make a stub
+#' stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
+#' stub1$with(request_headers = list('User-Agent' = 'R'))
+#' stub1$to_return(status = 200, body = "foobar", response_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(
+ stub = NULL,
+ request_stubs = list(),
+ global_stubs = list(),
+
+ print = function(x, ...) {
+ cat("<webmockr stub registry> ", 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)
+ },
+
+ register_stub = function(stub) {
+ self$request_stubs <- Filter(length, c(self$request_stubs, stub))
+ },
+
+ 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
+ },
+
+ 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))
+ },
+
+ 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
+ )
+ }
+ },
+
+ remove_all_request_stubs = function() {
+ self$request_stubs <- list()
+ },
+
+ 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()
+
+# madke body info for print method
+make_body <- function(x) {
+ if (is.null(x)) return("")
+ paste0(" with body ", jsonlite::toJSON(x, auto_unbox = TRUE))
+}
+
+# madke headers info for print method
+make_headers <- function(x) {
+ if (is.null(x)) return("")
+ paste0(" with headers ", jsonlite::toJSON(x, auto_unbox = TRUE))
+}
+
+# madke body info for print method
+make_status <- function(x) {
+ if (is.null(x)) return("")
+ paste0(" with status ", as.character(x))
+}
diff --git a/R/StubbedRequest.R b/R/StubbedRequest.R
new file mode 100644
index 0000000..af44117
--- /dev/null
+++ b/R/StubbedRequest.R
@@ -0,0 +1,132 @@
+#' StubbedRequest class
+#'
+#' @export
+#' @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
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`with(query, body, headers)`}{
+#' Set expectations for what's given in HTTP request
+#' \itemize{
+#' \item query (list) request query params, as a named list. optional
+#' \item body (list) request body, as a named list. optional
+#' \item headers (list) request headers as a named list. optional.
+#' }
+#' }
+#' \item{`to_return(status, body, headers)`}{
+#' Set expectations for what's returned in HTTP resonse
+#' \itemize{
+#' \item status (numeric) an HTTP status code
+#' \item body (list) response body, as a list. optional
+#' \item headers (list) named list, response headers. optional.
+#' }
+#' }
+#' \item{`to_s()`}{
+#' Response as a string
+#' }
+#' }
+#' @format NULL
+#' @usage NULL
+#' @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'))
+#' x$to_return(status = 200, body = "foobar", headers = list(a = 5))
+#' x
+#' x$to_s()
+#'
+#' # uri_regex
+#' (x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org"))
+#' x$method
+#' x$uri
+#' x$to_s()
+#' }
+StubbedRequest <- R6::R6Class(
+ 'StubbedRequest',
+ public = list(
+ method = NULL,
+ uri = NULL,
+ uri_regex = NULL,
+ uri_parts = NULL,
+ host = NULL,
+ query = NULL,
+ body = NULL,
+ request_headers = NULL,
+ response_headers = NULL,
+ response = NULL,
+ responses_sequences = NULL,
+
+ 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_parts <- parseurl(self$uri)
+ },
+
+ print = function(x, ...) {
+ cat("<webmockr stub> ", sep = "\n")
+ cat(paste0(" method: ", self$method), sep = "\n")
+ cat(paste0(" uri: ", self$uri), 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")
+ },
+
+ with = function(query = NULL, body = NULL, headers = NULL) {
+ self$query <- query
+ self$body <- body
+ self$request_headers <- headers
+ },
+
+ to_return = function(status, body, headers) {
+ self$response_headers <- headers
+ self$responses_sequences <- list(
+ status = status,
+ body = body,
+ headers = headers
+ )
+ },
+
+ 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",
+ self$method,
+ url_builder(self$uri, self$query),
+ make_body(self$body),
+ make_headers(self$request_headers),
+ # response data
+ if (any(nchar(toret) > 0)) {
+ sprintf("| to_return: %s %s %s", toret[1], toret[2], toret[3])
+ } else {
+ ""
+ }
+ ))
+ }
+ )
+)
diff --git a/R/adapter-crul.R b/R/adapter-crul.R
new file mode 100644
index 0000000..9e873fe
--- /dev/null
+++ b/R/adapter-crul.R
@@ -0,0 +1,175 @@
+#' crul library adapter
+#'
+#' @export
+#' @family http_lib_adapters
+#' @details
+#' **Methods**
+#' \describe{
+#' \item{`enable()`}{
+#' Enable the adapter
+#' }
+#' \item{`disable()`}{
+#' Disable the adapter
+#' }
+#' \item{`build_crul_request(x)`}{
+#' Build a crul [RequestSignature]
+#' x: crul request parts (list)
+#' }
+#' \item{`build_crul_response(req, resp)`}{
+#' Build a crul response
+#' req: a crul request (list)
+#' resp: a crul response ()
+#' }
+#' \item{`handle_request()`}{
+#' All logic for handling a request
+#' req: a crul request (list)
+#' }
+#' \item{`remove_crul_stubs()`}{
+#' Remove all crul stubs
+#' }
+#' }
+#'
+#' This adapter modifies \pkg{crul} to allow mocking HTTP requests
+#'
+#' @format NULL
+#' @usage NULL
+CrulAdapter <- R6::R6Class(
+ 'CrulAdapter',
+ public = list(
+ name = "crul_adapter",
+
+ enable = function() {
+ message("CrulAdapter enabled!")
+ webmockr_lightswitch$crul <- TRUE
+ },
+
+ disable = function() {
+ message("CrulAdapter disabled!")
+ webmockr_lightswitch$crul <- FALSE
+ self$remove_crul_stubs()
+ },
+
+ build_crul_request = function(x) {
+ RequestSignature$new(
+ method = x$method,
+ uri = x$url$url,
+ options = list(
+ body = x$body %||% NULL,
+ headers = x$headers %||% NULL,
+ proxies = x$proxies %||% NULL,
+ auth = x$auth %||% NULL
+ )
+ )
+ },
+
+ build_crul_response = function(req, resp) {
+ crul::HttpResponse$new(
+ method = req$method,
+ url = req$url$url,
+ status_code = resp$status_code,
+ request_headers = c(useragent = req$options$useragent, req$headers),
+ #response_headers = list(),
+ response_headers = {
+ if (grepl("^ftp://", resp$url)) {
+ list()
+ } else {
+ hh <- rawToChar(resp$response_headers %||% raw(0))
+ if (is.null(hh) || nchar(hh) == 0) {
+ list()
+ } else {
+ crul_headers_parse(curl::parse_headers(hh))
+ }
+ }
+ },
+ modified = resp$modified,
+ times = resp$times,
+ content = resp$content,
+ handle = req$url$handle,
+ request = req
+ )
+ },
+
+ handle_request = function(req) {
+ # put request in request registry
+ request_signature <- self$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)
+ # generate crul response
+ crul_resp <- self$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")
+ crul_resp$content <- toadd[[i]]
+ if (names(toadd)[i] == "headers")
+ crul_resp$response_headers <- toadd[[i]]
+ }
+ }
+ } else if (webmockr_net_connect_allowed()) {
+ # if real requests ARE allowed && nothing found above
+ tmp <- crul::HttpClient$new(url = req$url$url)
+ tmp2 <- webmockr_crul_fetch(req)
+ crul_resp <- self$build_crul_response(req, tmp2)
+ } else {
+ # no stubs found and net connect not allowed
+ x <- "Real HTTP connections are disabled.\nUnregistered request:"
+ 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,
+ #make_stub_request_code(request_signature)
+ 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 <- ""
+ }
+ stop(paste0(msgx, msgy, msgz), call. = FALSE)
+ }
+
+ return(crul_resp)
+ },
+
+ remove_crul_stubs = function() {
+ webmockr_stub_registry$remove_all_request_stubs()
+ }
+ ),
+
+ private = list(
+ make_stub_request_code = function(x) {
+ sprintf(
+ "stub_request('%s', url = '%s')",
+ x$method,
+ x$uri
+ )
+ }
+ )
+)
diff --git a/R/flipswitch.R b/R/flipswitch.R
new file mode 100644
index 0000000..a74069b
--- /dev/null
+++ b/R/flipswitch.R
@@ -0,0 +1,21 @@
+webmockr_lightswitch <- new.env()
+#webmockr_lightswitch$httr <- FALSE
+webmockr_lightswitch$crul <- FALSE
+
+#' Enable or disable webmockr
+#'
+#' @export
+#' @param options list of options - ignored for now.
+enable <- function(options = list()) {
+ vapply(http_lib_adapter_registry$adapters, function(z) {
+ z$enable()
+ }, logical(1))
+}
+
+#' @export
+#' @rdname enable
+disable <- function(options = list()) {
+ unlist(lapply(http_lib_adapter_registry$adapters, function(z) {
+ z$disable()
+ }))
+}
diff --git a/R/globals.R b/R/globals.R
new file mode 100644
index 0000000..d9c91cf
--- /dev/null
+++ b/R/globals.R
@@ -0,0 +1,3 @@
+if (base::getRversion() >= "2.15.1") {
+ utils::globalVariables(c("vcr_c"))
+}
diff --git a/R/headers.R b/R/headers.R
new file mode 100644
index 0000000..9ead33d
--- /dev/null
+++ b/R/headers.R
@@ -0,0 +1,52 @@
+# headers <- list(`Content-type` = 'application/json', Stuff = "things")
+# normalize_headers(x = headers)
+
+normalize_headers <- function(x = NULL) {
+ if (is.null(x) || length(x) == 0) return(x)
+ res <- Map(function(name, value) {
+ name <- paste0(
+ vapply(strsplit(as.character(name), '_|-')[[1]], function(w) simple_cap(w), ""),
+ collapse = "-"
+ )
+ value <- switch(
+ class(value),
+ #when Regexp then value
+ list = if (length(value) == 1) value[[1]] else sort(vapply(value, function(z) as.character(z), "")),
+ as.character(value)
+ )
+ list(name, value)
+ }, names(x), unlist(unname(x)))
+ vapply(res, function(z) stats::setNames(z[2], z[1]), list(1))
+}
+
+simple_cap <- function(x) {
+ s <- strsplit(x, " ")[[1]]
+ paste(toupper(substring(s, 1, 1)), substring(s, 2),
+ sep = "", collapse = " ")
+}
+
+# class Headers
+
+# def self.sorted_headers_string(headers)
+# headers = WebMock::Util::Headers.normalize_headers(headers)
+# str = '{'
+# str << headers.map do |k,v|
+# v = case v
+# when Regexp then v.inspect
+# when Array then "["+v.map{|w| "'#{w.to_s}'"}.join(", ")+"]"
+# else "'#{v.to_s}'"
+# end
+# "'#{k}'=>#{v}"
+# end.sort.join(", ")
+# str << '}'
+# end
+
+# def self.decode_userinfo_from_header(header)
+# header.sub(/^Basic /, "").unpack("m").first
+# end
+
+# def self.basic_auth_header(*credentials)
+# "Basic #{Base64.strict_encode64(credentials.join(':')).chomp}"
+# end
+
+# end
diff --git a/R/onload.R b/R/onload.R
new file mode 100644
index 0000000..0f38ebd
--- /dev/null
+++ b/R/onload.R
@@ -0,0 +1,33 @@
+#webmockr_stub_registry <- NULL
+http_lib_adapter_registry <- NULL
+.onLoad <- function(libname, pkgname) {
+ webmockr_configure()
+ x <- HttpLibAdapaterRegistry$new()
+ x$register(CrulAdapter$new())
+ http_lib_adapter_registry <<- x
+ # initialize empty stub registry on package load
+ # webmockr_stub_registry <<- new.env()
+ # webmockr_stub_registry <- webmockr::StubRegistry$new()
+}
+
+# .onAttach <- function(libname, pkgname) {
+# #base::unlockBinding("request_perform", as.environment("package:httr"))
+# utils::assignInNamespace("request_perform", request_perform, "httr")
+# #base::lockBinding("request_perform", as.environment("package:httr"))
+# }
+
+# .onAttach <- function(libname, pkgname) {
+# when_attached("httr", {
+# utils::assignInNamespace("request_perform", request_perform, "httr")
+# })
+# }
+#
+# when_attached <- function(pkg, action) {
+# if (is_attached(pkg)) {
+# action
+# } else {
+# setHook(packageEvent(pkg, "attach"), function(...) action)
+# }
+# }
+#
+# is_attached <- function(pkg) paste0("package:", pkg) %in% search()
diff --git a/R/pipe.R b/R/pipe.R
new file mode 100644
index 0000000..036dd30
--- /dev/null
+++ b/R/pipe.R
@@ -0,0 +1,9 @@
+#' Pipe operator
+#'
+#' @name %>%
+#' @rdname pipe
+#' @keywords internal
+#' @export
+#' @importFrom magrittr %>%
+#' @usage lhs \%>\% rhs
+NULL
diff --git a/R/remove_request_stub.R b/R/remove_request_stub.R
new file mode 100644
index 0000000..42c53ac
--- /dev/null
+++ b/R/remove_request_stub.R
@@ -0,0 +1,15 @@
+#' 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)
+}
diff --git a/R/request_is_in_cache.R b/R/request_is_in_cache.R
new file mode 100644
index 0000000..192d196
--- /dev/null
+++ b/R/request_is_in_cache.R
@@ -0,0 +1,4 @@
+# Check if request is in cache
+request_is_in_cache <- function(request_signature) {
+ webmockr_stub_registry$is_registered(request_signature)
+}
diff --git a/R/stub_registry.R b/R/stub_registry.R
new file mode 100644
index 0000000..4cab6d3
--- /dev/null
+++ b/R/stub_registry.R
@@ -0,0 +1,7 @@
+#' List stubs in the stub registry
+#'
+#' @export
+#' @return an object of class `StubRegistry`, print method gives the
+#' stubs in the registry
+#' @family stub-registry
+stub_registry <- function() webmockr_stub_registry
diff --git a/R/stub_registry_clear.R b/R/stub_registry_clear.R
new file mode 100644
index 0000000..0e88b0f
--- /dev/null
+++ b/R/stub_registry_clear.R
@@ -0,0 +1,10 @@
+#' Clear the stub registry
+#'
+#' Clear all stubs
+#'
+#' @export
+#' @return nothing
+#' @family stub-registry
+stub_registry_clear <- function() {
+ webmockr_stub_registry$remove_all_request_stubs()
+}
diff --git a/R/stub_request.R b/R/stub_request.R
new file mode 100644
index 0000000..de45e8c
--- /dev/null
+++ b/R/stub_request.R
@@ -0,0 +1,52 @@
+#' 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
+#' @seealso [wi_th()], [to_return()]
+#' @examples \dontrun{
+#' # basic stubbing
+#' stub_request("get", "https://httpbin.org/get")
+#' stub_request("post", "https://httpbin.org/post")
+#'
+#' # list stubs
+#' stub_registry()
+#'
+#' # add header
+#' stub_request("get", "https://httpbin.org/get") %>%
+#' wi_th(headers = list('User-Agent' = 'R'))
+#'
+#' # 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\\..")
+#'
+#' # clear all stubs
+#' 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)
+}
diff --git a/R/to_return.R b/R/to_return.R
new file mode 100644
index 0000000..330ba72
--- /dev/null
+++ b/R/to_return.R
@@ -0,0 +1,34 @@
+#' 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 variable names, passed on
+#' to [lazyeval::lazy_dots()]. accepts the following: status, body,
+#' headers
+#' @param .dots Used to work around non-standard evaluation
+#' @return an object of class `StubbedRequest`, with print method describing
+#' the stub
+#' @note see examples in [stub_request()]
+to_return <- function(.data, ...) {
+ to_return_(.data, .dots = lazyeval::lazy_dots(...))
+}
+
+#' @export
+#' @rdname to_return
+to_return_ <- function(.data, ..., .dots) {
+ tmp <- lazyeval::all_dots(.dots, ...)
+ if (length(tmp) == 0) {
+ z <- NULL
+ } else {
+ z <- lapply(tmp, function(x) eval(x$expr))
+ }
+ .data$to_return(
+ status = z$status,
+ body = z$body,
+ headers = z$headers
+ )
+ return(.data)
+}
diff --git a/R/webmockr-opts.R b/R/webmockr-opts.R
new file mode 100644
index 0000000..74d119f
--- /dev/null
+++ b/R/webmockr-opts.R
@@ -0,0 +1,114 @@
+#' webmockr configuration
+#'
+#' @export
+#' @param turn_on (logical) Default: `FALSE`
+#' @param allow_net_connect (logical) Default: `TRUE`
+#' @param allow_localhost (logical) Default: `TRUE`
+#' @param allow (logical) Default: `TRUE`
+#' @param net_http_connect_on_start (logical) Default: `TRUE`
+#' @param show_stubbing_instructions (logical) Default: `TRUE`
+#' @param query_values_notation (logical) Default: `TRUE`
+#' @param show_body_diff (logical) Default: `TRUE`
+#'
+#' @examples \dontrun{
+#' webmockr_configure()
+#' webmockr_configure(
+#' allow_localhost = TRUE
+#' )
+#' webmockr_configuration()
+#' webmockr_configure_reset()
+#'
+#' webmockr_allow_net_connect()
+#' webmockr_net_connect_allowed()
+#' webmockr_disable_net_connect()
+#' webmockr_net_connect_allowed()
+#' }
+webmockr_configure <- function(
+ turn_on = FALSE,
+ allow_net_connect = FALSE,
+ allow_localhost = FALSE,
+ allow = FALSE,
+ net_http_connect_on_start = FALSE,
+ show_stubbing_instructions = FALSE,
+ query_values_notation = FALSE,
+ show_body_diff = FALSE) {
+
+ opts <- list(
+ turn_on = turn_on,
+ 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_enable <- function() {
+ message("webmockr enabled")
+ assign('turn_on', TRUE, envir = webmockr_conf_env)
+}
+
+#' @export
+#' @rdname webmockr_configure
+webmockr_disable <- function() {
+ message("webmockr disabled")
+ assign('turn_on', FALSE, envir = webmockr_conf_env)
+}
+
+#' @export
+#' @rdname webmockr_configure
+webmockr_allow_net_connect <- function() {
+ message("net connect allowed")
+ assign('allow_net_connect', TRUE, envir = webmockr_conf_env)
+}
+
+#' @export
+#' @rdname webmockr_configure
+webmockr_disable_net_connect <- function() {
+ message("net connect disabled")
+ assign('allow_net_connect', FALSE, envir = webmockr_conf_env)
+}
+
+#' @export
+#' @rdname webmockr_configure
+webmockr_net_connect_allowed <- function() {
+ #webmockr_conf_env$allow_net_connect
+ webmockr_conf_env$allow_net_connect
+ #get('allow_net_connect', envir = webmockr_conf_env)
+}
+
+
+
+print.webmockr_config <- function(x, ...) {
+ cat("<webmockr configuration>", sep = "\n")
+ cat(paste0(" enabled?: ", x$turn_on), sep = "\n")
+ cat(paste0(" allow_net_collect?: ", x$allow_net_collect), 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()
diff --git a/R/webmockr.R b/R/webmockr.R
new file mode 100644
index 0000000..7c3ce23
--- /dev/null
+++ b/R/webmockr.R
@@ -0,0 +1,24 @@
+#' Stubbing and setting expectations on HTTP requests
+#'
+#' @import magrittr lazyeval R6
+#' @name webmockr-package
+#' @aliases webmockr
+#' @docType package
+#' @keywords package
+#' @author Scott Chamberlain \email{myrmecocystus+r@@gmail.com}
+#'
+#' @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 Can support many HTTP libraries, though only \pkg{crul} for now
+#' \item Integration with testing libraries (coming soon) via `vcr`
+#' }
+#'
+#' @examples
+#' library(webmockr)
+#' stub_request("get", "https://httpbin.org/get")
+#' stub_request("post", "https://httpbin.org/post")
+#' stub_registry()
+NULL
diff --git a/R/wi_th.R b/R/wi_th.R
new file mode 100644
index 0000000..46f14fe
--- /dev/null
+++ b/R/wi_th.R
@@ -0,0 +1,36 @@
+#' 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 variable names, passed on
+#' to [lazyeval::lazy_dots()]. accepts the following: query, body,
+#' headers
+#' @param .dots Used to work around non-standard evaluation
+#' @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 examples in [stub_request()]
+wi_th <- function(.data, ...) {
+ wi_th_(.data, .dots = lazyeval::lazy_dots(...))
+}
+
+#' @export
+#' @rdname wi_th
+wi_th_ <- function(.data, ..., .dots) {
+ tmp <- lazyeval::all_dots(.dots, ...)
+ if (length(tmp) == 0) {
+ z <- NULL
+ } else {
+ z <- lapply(tmp, function(x) eval(x$expr))
+ }
+ .data$with(
+ query = z$query,
+ body = z$body,
+ headers = z$headers
+ )
+ return(.data)
+}
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..1983bf6
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,64 @@
+http_verbs <- c("any", "get","post","put","patch","head","delete")
+
+cc <- function(x) Filter(Negate(is.null), x)
+
+hdl_lst <- function(x) {
+ if (is.null(x) || length(x) == 0) return("")
+ if (inherits(x, "list")) {
+ return(paste(names(x), unname(x), sep = "=", collapse = ", "))
+ } else {
+ 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)) y else x
+
+assert <- function(x, y) {
+ if (!is.null(x)) {
+ if (!class(x)[1] %in% 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))
+
+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)
+ }
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..7df89f8
--- /dev/null
+++ b/README.md
@@ -0,0 +1,226 @@
+webmockr
+========
+
+
+
+[](https://travis-ci.org/ropensci/webmockr)
+[](https://codecov.io/gh/ropensci/webmockr)
+
+R library for stubbing and setting expectations on HTTP requests.
+
+Port of the Ruby gem [webmock](https://github.com/bblimke/webmock)
+
+
+## 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
+* Support for `testthat` coming soon via [vcr](https://github.com/ropenscilabs/vcr)
+
+## Supported HTTP libraries
+
+* [crul](https://github.com/ropensci/crul)
+
+> more to come
+
+## Install
+
+from cran
+
+
+```r
+install.packages("webmockr")
+```
+
+Dev version
+
+
+```r
+devtools::install_github("ropensci/webmockr")
+```
+
+
+```r
+library(webmockr)
+```
+
+## Turn on webmockr
+
+
+```r
+webmockr::enable()
+#> CrulAdapter enabled!
+#> [1] TRUE
+crul::mock()
+```
+
+## Outside a test framework
+
+
+```r
+library(crul)
+```
+
+### Stubbed request based on uri only and with the default response
+
+
+```r
+stub_request("any", "https://httpbin.org/get")
+#> <webmockr stub>
+#> method: any
+#> uri: https://httpbin.org/get
+#> with:
+#> query:
+#> body:
+#> request_headers:
+#> to_return:
+#> status:
+#> body:
+#> response_headers:
+```
+
+
+```r
+x <- HttpClient$new(url = "https://httpbin.org")
+x$get('get')
+#> $url
+#> $url$url
+#> [1] "https://httpbin.org/get"
+#>
+#> $url$handle
+#> <curl handle> (empty)
+#>
+#>
+#> $method
+#> [1] "get"
+#>
+#> $options
+#> $options$httpget
+#> [1] TRUE
+#>
+#>
+#> $headers
+#> $headers$`User-Agent`
+#> [1] "libcurl/7.51.0 r-curl/2.6 crul/0.3.5.9313"
+#>
+#> $headers$`Accept-Encoding`
+#> [1] "gzip, deflate"
+```
+
+set return objects
+
+
+```r
+stub_request("get", "https://httpbin.org/get") %>%
+ wi_th(
+ query = list(hello = "world")) %>%
+ to_return(status = 418)
+#> <webmockr stub>
+#> method: get
+#> uri: https://httpbin.org/get
+#> with:
+#> query: hello=world
+#> body:
+#> request_headers:
+#> to_return:
+#> status: 418
+#> body:
+#> response_headers:
+```
+
+
+```r
+x$get('get', query = list(hello = "world"))
+#> $url
+#> $url$url
+#> [1] "https://httpbin.org/get?hello=world"
+#>
+#> $url$handle
+#> <curl handle> (empty)
+#>
+#>
+#> $method
+#> [1] "get"
+#>
+#> $options
+#> $options$httpget
+#> [1] TRUE
+#>
+#>
+#> $headers
+#> $headers$`User-Agent`
+#> [1] "libcurl/7.51.0 r-curl/2.6 crul/0.3.5.9313"
+#>
+#> $headers$`Accept-Encoding`
+#> [1] "gzip, deflate"
+```
+
+### Stubbing requests based on method, uri and query params
+
+
+```r
+stub_request("get", "https://httpbin.org/get") %>%
+ wi_th(query = list(hello = "world"),
+ headers = list('User-Agent' = 'libcurl/7.51.0 r-curl/2.6 crul/0.3.6',
+ 'Accept-Encoding' = "gzip, deflate"))
+#> <webmockr stub>
+#> method: get
+#> uri: https://httpbin.org/get
+#> with:
+#> query: hello=world
+#> body:
+#> request_headers: User-Agent=libcurl/7.51.0 r-curl/2.6 crul/0.3.6, Accept-Encoding=gzip, deflate
+#> to_return:
+#> status:
+#> body:
+#> response_headers:
+```
+
+
+```r
+stub_registry()
+#> <webmockr stub registry>
+#> Registered Stubs
+#> any: https://httpbin.org/get
+#> get: https://httpbin.org/get?hello=world | to_return: with status 418
+#> get: https://httpbin.org/get?hello=world with headers {"User-Agent":"libcurl/7.51.0 r-curl/2.6 crul/0.3.6","Accept-Encoding":"gzip, deflate"}
+```
+
+
+```r
+x <- HttpClient$new(url = "https://httpbin.org")
+x$get('get', query = list(hello = "world"))
+#> $url
+#> $url$url
+#> [1] "https://httpbin.org/get?hello=world"
+#>
+#> $url$handle
+#> <curl handle> (empty)
+#>
+#>
+#> $method
+#> [1] "get"
+#>
+#> $options
+#> $options$httpget
+#> [1] TRUE
+#>
+#>
+#> $headers
+#> $headers$`User-Agent`
+#> [1] "libcurl/7.51.0 r-curl/2.6 crul/0.3.5.9313"
+#>
+#> $headers$`Accept-Encoding`
+#> [1] "gzip, deflate"
+```
+
+## 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](CONDUCT.md).
+By participating in this project you agree to abide by its terms.
+
+[](https://ropensci.org)
diff --git a/inst/ignore/adapter-httr.R b/inst/ignore/adapter-httr.R
new file mode 100644
index 0000000..ff2d21a
--- /dev/null
+++ b/inst/ignore/adapter-httr.R
@@ -0,0 +1,95 @@
+#' 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
+ )
+ }
+}
diff --git a/inst/ignore/sockets.R b/inst/ignore/sockets.R
new file mode 100644
index 0000000..96a5965
--- /dev/null
+++ b/inst/ignore/sockets.R
@@ -0,0 +1,48 @@
+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)))
+ }
+}
diff --git a/man/BodyPattern.Rd b/man/BodyPattern.Rd
new file mode 100644
index 0000000..4576ea7
--- /dev/null
+++ b/man/BodyPattern.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestPattern.R
+\docType{data}
+\name{BodyPattern}
+\alias{BodyPattern}
+\title{BodyPattern}
+\arguments{
+\item{pattern}{(list) a body object}
+}
+\description{
+BodyPattern
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{matches(body, content_type = "")}}{
+Match a body object against that given in \code{pattern}
+- body (list) the body
+- content_type (character) content type
+}
+}
+}
+\examples{
+z <- BodyPattern$new(pattern = list(a = "foobar"))
+z$pattern
+}
+\keyword{internal}
diff --git a/man/CrulAdapter.Rd b/man/CrulAdapter.Rd
new file mode 100644
index 0000000..4188749
--- /dev/null
+++ b/man/CrulAdapter.Rd
@@ -0,0 +1,39 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/adapter-crul.R
+\docType{data}
+\name{CrulAdapter}
+\alias{CrulAdapter}
+\title{crul library adapter}
+\description{
+crul library adapter
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{enable()}}{
+Enable the adapter
+}
+\item{\code{disable()}}{
+Disable the adapter
+}
+\item{\code{build_crul_request(x)}}{
+Build a crul \link{RequestSignature}
+x: crul request parts (list)
+}
+\item{\code{build_crul_response(req, resp)}}{
+Build a crul response
+req: a crul request (list)
+resp: a crul response ()
+}
+\item{\code{handle_request()}}{
+All logic for handling a request
+req: a crul request (list)
+}
+\item{\code{remove_crul_stubs()}}{
+Remove all crul stubs
+}
+}
+
+This adapter modifies \pkg{crul} to allow mocking HTTP requests
+}
+\keyword{datasets}
diff --git a/man/HashCounter.Rd b/man/HashCounter.Rd
new file mode 100644
index 0000000..6d84248
--- /dev/null
+++ b/man/HashCounter.Rd
@@ -0,0 +1,34 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestRegistry.R
+\docType{data}
+\name{HashCounter}
+\alias{HashCounter}
+\title{hash with counter, to store requests, and count each time it is used}
+\description{
+hash with counter, to store requests, and count each time it is used
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{put(key)}}{
+Register a request by it's key
+- key: a character string of the request, serialized from
+\link{CrulAdapter} or other adapter
+}
+\item{\code{get(key)}}{
+Get a request by key
+- key: a character string of the request, serialized from
+\link{CrulAdapter} or other adapter
+}
+}
+}
+\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
+}
+\keyword{datasets}
diff --git a/man/HeadersPattern.Rd b/man/HeadersPattern.Rd
new file mode 100644
index 0000000..da99d61
--- /dev/null
+++ b/man/HeadersPattern.Rd
@@ -0,0 +1,46 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestPattern.R
+\docType{data}
+\name{HeadersPattern}
+\alias{HeadersPattern}
+\title{HeadersPattern}
+\arguments{
+\item{pattern}{(list) a pattern, as a named list, must be named,
+e.g,. \code{list(a = 5, b = 6)}}
+}
+\description{
+HeadersPattern
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{matches(headers)}}{
+Match a list of headers against that stored
+- headers (list) named list of headers, e.g,. \code{list(a = 5, b = 6)}
+}
+}
+
+\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"))
+}
+\keyword{internal}
diff --git a/man/HttpLibAdapaterRegistry.Rd b/man/HttpLibAdapaterRegistry.Rd
new file mode 100644
index 0000000..424b2fc
--- /dev/null
+++ b/man/HttpLibAdapaterRegistry.Rd
@@ -0,0 +1,27 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/HttpLibAdapterRegistry.R
+\docType{data}
+\name{HttpLibAdapaterRegistry}
+\alias{HttpLibAdapaterRegistry}
+\title{http lib adapter registry}
+\description{
+http lib adapter registry
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{register(x)}}{
+Register an http library adapter
+x: an http lib adapter, e.g., \link{CrulAdapter}
+return: nothing, registers the library adapter
+}
+}
+}
+\examples{
+x <- HttpLibAdapaterRegistry$new()
+x$register(CrulAdapter$new())
+x
+x$adapters
+x$adapters[[1]]$name
+}
+\keyword{datasets}
diff --git a/man/MethodPattern.Rd b/man/MethodPattern.Rd
new file mode 100644
index 0000000..38edec7
--- /dev/null
+++ b/man/MethodPattern.Rd
@@ -0,0 +1,30 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestPattern.R
+\docType{data}
+\name{MethodPattern}
+\alias{MethodPattern}
+\title{MethodPattern}
+\arguments{
+\item{pattern}{(character) a HTTP method, lowercase}
+}
+\description{
+MethodPattern
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{matches(method)}}{
+An HTTP method
+- method (character)
+}
+}
+
+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")
+}
+\keyword{internal}
diff --git a/man/RequestPattern.Rd b/man/RequestPattern.Rd
new file mode 100644
index 0000000..3b9f85b
--- /dev/null
+++ b/man/RequestPattern.Rd
@@ -0,0 +1,69 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestPattern.R
+\docType{data}
+\name{RequestPattern}
+\alias{RequestPattern}
+\title{RequestPattern class}
+\arguments{
+\item{method}{the HTTP method (any, head, options, get, post, put,
+patch, trace, or delete). "any" matches any HTTP method. required.}
+
+\item{uri}{(character) request URI. required or uri_regex}
+
+\item{uri_regex}{(character) request URI as regex. required or uri}
+
+\item{query}{(list) query parameters, optional}
+
+\item{body}{(list) body request, optional}
+
+\item{headers}{(list) headers, optional}
+}
+\description{
+RequestPattern class
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{matches(request_signature)}}{
+Test if request_signature matches a pattern
+- request_signature: a request signature
+}
+\item{\code{to_s()}}{
+Print pattern for easy human consumption
+}
+}
+}
+\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()
+}
+}
+\seealso{
+pattern classes for HTTP method \link{MethodPattern}, headers
+\link{HeadersPattern}, body \link{BodyPattern}, and URI/URL \link{UriPattern}
+}
+\keyword{datasets}
diff --git a/man/RequestRegistry.Rd b/man/RequestRegistry.Rd
new file mode 100644
index 0000000..bf763e9
--- /dev/null
+++ b/man/RequestRegistry.Rd
@@ -0,0 +1,37 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestRegistry.R
+\docType{data}
+\name{RequestRegistry}
+\alias{RequestRegistry}
+\title{Request registry}
+\description{
+Request registry
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{register_request(request)}}{
+Register a request
+- request: a character string of the request, serialized from
+\link{CrulAdapter} or other adapter
+}
+\item{\code{reset()}}{
+Reset the registry to no registered 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()
+}
+\keyword{datasets}
diff --git a/man/RequestSignature.Rd b/man/RequestSignature.Rd
new file mode 100644
index 0000000..d6d4cf9
--- /dev/null
+++ b/man/RequestSignature.Rd
@@ -0,0 +1,71 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestSignature.R
+\docType{data}
+\name{RequestSignature}
+\alias{RequestSignature}
+\title{General purpose request signature builder}
+\arguments{
+\item{method}{the HTTP method (any, head, options, get, post, put,
+patch, trace, or delete). "any" matches any HTTP method. required.}
+
+\item{uri}{(character) request URI. required.}
+
+\item{options}{(list) options. optional. See Details.}
+}
+\description{
+General purpose request signature builder
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{to_s()}}{
+Request signature to a string
+return: a character string representation of the request signature
+}
+}
+}
+\section{options}{
+
+\itemize{
+\item body - body as a named list
+\item headers - headers as a named list
+\item proxies - proxies as a named list
+\item auth - authentication details, as a named list
+}
+}
+
+\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
+z <- RequestSignature$new(
+ method = "get",
+ uri = "https:/httpbin.org/get",
+ options = list(headers = list(`User-Agent` = "foobar", stuff = "things"))
+)
+z
+z$headers
+z$to_s()
+
+# headers and body
+z <- RequestSignature$new(
+ method = "get",
+ uri = "https:/httpbin.org/get",
+ options = list(
+ headers = list(`User-Agent` = "foobar", stuff = "things"),
+ body = list(a = "tables")
+ )
+)
+z
+z$headers
+z$body
+z$to_s()
+}
+\keyword{datasets}
diff --git a/man/Response.Rd b/man/Response.Rd
new file mode 100644
index 0000000..1139863
--- /dev/null
+++ b/man/Response.Rd
@@ -0,0 +1,78 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/Response.R
+\docType{data}
+\name{Response}
+\alias{Response}
+\title{Response class}
+\arguments{
+\item{options}{(list) a list of options}
+}
+\description{
+Response class
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{set_request_headers(headers)}}{
+set request headers
+- headers: a list of key-value pair headers
+}
+\item{\code{get_request_headers()}}{
+get request headers
+}
+\item{\code{set_response_headers(headers)}}{
+set response headers
+- headers: a list of key-value pair headers
+}
+\item{\code{get_response_headers()}}{
+get response headers
+}
+\item{\code{set_body(body)}}{
+- body: must be a string
+}
+\item{\code{get_body()}}{
+get body
+}
+\item{\code{set_status()}}{
+- body: must be an integer status code
+}
+\item{\code{get_status()}}{
+get status code
+}
+\item{\code{set_exception()}}{
+set exception
+}
+\item{\code{get_exception()}}{
+get exception
+}
+}
+}
+\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()
+
+x$set_exception("exception")
+x
+x$get_exception()
+}
+}
+\keyword{datasets}
diff --git a/man/StubRegistry.Rd b/man/StubRegistry.Rd
new file mode 100644
index 0000000..349a42f
--- /dev/null
+++ b/man/StubRegistry.Rd
@@ -0,0 +1,67 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/StubRegistry.R
+\docType{data}
+\name{StubRegistry}
+\alias{StubRegistry}
+\title{Stub registry}
+\description{
+Stub registry
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{register_stub(stub)}}{
+Register a stub
+- stub: an object of class \link{StubbedRequest}
+}
+\item{\code{find_stubbed_request(req)}}{
+Find a stubbed request
+- req: an object of class \link{RequestSignature}
+}
+\item{\code{response_for_request(request_signature)}}{
+Find a stubbed request
+- request_signature: an object of class \link{RequestSignature}
+}
+\item{\code{request_stub_for(request_signature)}}{
+Find a stubbed request
+- request_signature: an object of class \link{RequestSignature}
+}
+\item{\code{remove_request_stub(stub)}}{
+Remove a stubbed request by matching request signature
+- stub: an object of class \link{StubbedRequest}
+}
+\item{\code{remove_all_request_stubs()}}{
+Remove all request stubs
+}
+\item{\code{is_registered(x)}}{
+Find a stubbed request
+- x: an object of class \link{RequestSignature}
+}
+}
+}
+\examples{
+\dontrun{
+# Make a stub
+stub1 <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
+stub1$with(request_headers = list('User-Agent' = 'R'))
+stub1$to_return(status = 200, body = "foobar", response_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}}
+}
+\keyword{datasets}
diff --git a/man/StubbedRequest.Rd b/man/StubbedRequest.Rd
new file mode 100644
index 0000000..18ddd6c
--- /dev/null
+++ b/man/StubbedRequest.Rd
@@ -0,0 +1,64 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/StubbedRequest.R
+\docType{data}
+\name{StubbedRequest}
+\alias{StubbedRequest}
+\title{StubbedRequest class}
+\arguments{
+\item{method}{the HTTP method (any, head, get, post, put,
+patch, or delete). "any" matches any HTTP method. required.}
+
+\item{uri}{(character) request URI. either this or \code{uri_regex}
+required}
+
+\item{uri_regex}{(character) request URI as regex. either this or \code{uri}
+required}
+}
+\description{
+StubbedRequest class
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{with(query, body, headers)}}{
+Set expectations for what's given in HTTP request
+\itemize{
+\item query (list) request query params, as a named list. optional
+\item body (list) request body, as a named list. optional
+\item headers (list) request headers as a named list. optional.
+}
+}
+\item{\code{to_return(status, body, headers)}}{
+Set expectations for what's returned in HTTP resonse
+\itemize{
+\item status (numeric) an HTTP status code
+\item body (list) response body, as a list. optional
+\item headers (list) named list, response headers. optional.
+}
+}
+\item{\code{to_s()}}{
+Response as a string
+}
+}
+}
+\examples{
+\dontrun{
+x <- StubbedRequest$new(method = "get", uri = "api.crossref.org")
+x$method
+x$uri
+x$with(headers = list('User-Agent' = 'R'))
+x$to_return(status = 200, body = "foobar", headers = list(a = 5))
+x
+x$to_s()
+
+# uri_regex
+(x <- StubbedRequest$new(method = "get", uri_regex = ".+ossref.org"))
+x$method
+x$uri
+x$to_s()
+}
+}
+\seealso{
+\code{\link[=stub_request]{stub_request()}}
+}
+\keyword{datasets}
diff --git a/man/UriPattern.Rd b/man/UriPattern.Rd
new file mode 100644
index 0000000..5a006f1
--- /dev/null
+++ b/man/UriPattern.Rd
@@ -0,0 +1,60 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/RequestPattern.R
+\docType{data}
+\name{UriPattern}
+\alias{UriPattern}
+\title{UriPattern}
+\arguments{
+\item{pattern}{(character) a uri, either plain character string or
+regex, see \link[base:regex]{base::regex}. if scheme is missing, it is added (we assume
+http)}
+}
+\description{
+UriPattern
+}
+\details{
+\strong{Methods}
+\describe{
+\item{\code{add_query_params}}{
+Add query parameters to the URI
+- query_params
+}
+\item{\code{matches(uri)}}{
+Match a uri against that given in \code{pattern}
+- uri (character) a uri, including scheme (i.e., http or https)
+}
+}
+}
+\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$add_query_params(list(pizza = "deep dish", cheese = "cheddar"))
+z$pattern
+}
+\keyword{internal}
diff --git a/man/enable.Rd b/man/enable.Rd
new file mode 100644
index 0000000..da2bee7
--- /dev/null
+++ b/man/enable.Rd
@@ -0,0 +1,17 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/flipswitch.R
+\name{enable}
+\alias{enable}
+\alias{disable}
+\title{Enable or disable webmockr}
+\usage{
+enable(options = list())
+
+disable(options = list())
+}
+\arguments{
+\item{options}{list of options - ignored for now.}
+}
+\description{
+Enable or disable webmockr
+}
diff --git a/man/pipe.Rd b/man/pipe.Rd
new file mode 100644
index 0000000..1c20897
--- /dev/null
+++ b/man/pipe.Rd
@@ -0,0 +1,12 @@
+% 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}
diff --git a/man/remove_request_stub.Rd b/man/remove_request_stub.Rd
new file mode 100644
index 0000000..26317c1
--- /dev/null
+++ b/man/remove_request_stub.Rd
@@ -0,0 +1,28 @@
+% 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}}
+}
diff --git a/man/stub_registry.Rd b/man/stub_registry.Rd
new file mode 100644
index 0000000..3035535
--- /dev/null
+++ b/man/stub_registry.Rd
@@ -0,0 +1,20 @@
+% 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
+}
+\seealso{
+Other stub-registry: \code{\link{StubRegistry}},
+ \code{\link{remove_request_stub}},
+ \code{\link{stub_registry_clear}}
+}
diff --git a/man/stub_registry_clear.Rd b/man/stub_registry_clear.Rd
new file mode 100644
index 0000000..bdfcb4a
--- /dev/null
+++ b/man/stub_registry_clear.Rd
@@ -0,0 +1,19 @@
+% 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
+}
+\description{
+Clear all stubs
+}
+\seealso{
+Other stub-registry: \code{\link{StubRegistry}},
+ \code{\link{remove_request_stub}},
+ \code{\link{stub_registry}}
+}
diff --git a/man/stub_request.Rd b/man/stub_request.Rd
new file mode 100644
index 0000000..9364564
--- /dev/null
+++ b/man/stub_request.Rd
@@ -0,0 +1,64 @@
+% 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
+}
+\examples{
+\dontrun{
+# basic stubbing
+stub_request("get", "https://httpbin.org/get")
+stub_request("post", "https://httpbin.org/post")
+
+# list stubs
+stub_registry()
+
+# add header
+stub_request("get", "https://httpbin.org/get") \%>\%
+ wi_th(headers = list('User-Agent' = 'R'))
+
+# 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\\\\..")
+
+# clear all stubs
+stub_registry_clear()
+}
+}
+\seealso{
+\code{\link[=wi_th]{wi_th()}}, \code{\link[=to_return]{to_return()}}
+}
diff --git a/man/to_return.Rd b/man/to_return.Rd
new file mode 100644
index 0000000..a5a5ccb
--- /dev/null
+++ b/man/to_return.Rd
@@ -0,0 +1,31 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/to_return.R
+\name{to_return}
+\alias{to_return}
+\alias{to_return_}
+\title{Expectation for what's returned from a stubbed request}
+\usage{
+to_return(.data, ...)
+
+to_return_(.data, ..., .dots)
+}
+\arguments{
+\item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class
+object}
+
+\item{...}{Comma separated list of variable names, passed on
+to \code{\link[lazyeval:lazy_dots]{lazyeval::lazy_dots()}}. accepts the following: status, body,
+headers}
+
+\item{.dots}{Used to work around non-standard evaluation}
+}
+\value{
+an object of class \code{StubbedRequest}, with print method describing
+the stub
+}
+\description{
+Set response status code, response body, and/or response headers
+}
+\note{
+see examples in \code{\link[=stub_request]{stub_request()}}
+}
diff --git a/man/webmockr-package.Rd b/man/webmockr-package.Rd
new file mode 100644
index 0000000..95f7c0d
--- /dev/null
+++ b/man/webmockr-package.Rd
@@ -0,0 +1,31 @@
+% 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 Can support many HTTP libraries, though only \pkg{crul} for now
+\item Integration with testing libraries (coming soon) via \code{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 at gmail.com}
+}
+\keyword{package}
diff --git a/man/webmockr_configure.Rd b/man/webmockr_configure.Rd
new file mode 100644
index 0000000..f9985e7
--- /dev/null
+++ b/man/webmockr_configure.Rd
@@ -0,0 +1,67 @@
+% 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_enable}
+\alias{webmockr_disable}
+\alias{webmockr_allow_net_connect}
+\alias{webmockr_disable_net_connect}
+\alias{webmockr_net_connect_allowed}
+\title{webmockr configuration}
+\usage{
+webmockr_configure(turn_on = FALSE, allow_net_connect = FALSE,
+ allow_localhost = FALSE, allow = FALSE,
+ net_http_connect_on_start = FALSE, show_stubbing_instructions = FALSE,
+ query_values_notation = FALSE, show_body_diff = FALSE)
+
+webmockr_configure_reset()
+
+webmockr_configuration()
+
+webmockr_enable()
+
+webmockr_disable()
+
+webmockr_allow_net_connect()
+
+webmockr_disable_net_connect()
+
+webmockr_net_connect_allowed()
+}
+\arguments{
+\item{turn_on}{(logical) Default: \code{FALSE}}
+
+\item{allow_net_connect}{(logical) Default: \code{TRUE}}
+
+\item{allow_localhost}{(logical) Default: \code{TRUE}}
+
+\item{allow}{(logical) Default: \code{TRUE}}
+
+\item{net_http_connect_on_start}{(logical) Default: \code{TRUE}}
+
+\item{show_stubbing_instructions}{(logical) Default: \code{TRUE}}
+
+\item{query_values_notation}{(logical) Default: \code{TRUE}}
+
+\item{show_body_diff}{(logical) Default: \code{TRUE}}
+}
+\description{
+webmockr configuration
+}
+\examples{
+\dontrun{
+webmockr_configure()
+webmockr_configure(
+ allow_localhost = TRUE
+)
+webmockr_configuration()
+webmockr_configure_reset()
+
+webmockr_allow_net_connect()
+webmockr_net_connect_allowed()
+webmockr_disable_net_connect()
+webmockr_net_connect_allowed()
+}
+}
diff --git a/man/wi_th.Rd b/man/wi_th.Rd
new file mode 100644
index 0000000..99a7984
--- /dev/null
+++ b/man/wi_th.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/wi_th.R
+\name{wi_th}
+\alias{wi_th}
+\alias{wi_th_}
+\title{Set additional parts of a stubbed request}
+\usage{
+wi_th(.data, ...)
+
+wi_th_(.data, ..., .dots)
+}
+\arguments{
+\item{.data}{input. Anything that can be coerced to a \code{StubbedRequest} class
+object}
+
+\item{...}{Comma separated list of variable names, passed on
+to \code{\link[lazyeval:lazy_dots]{lazyeval::lazy_dots()}}. accepts the following: query, body,
+headers}
+
+\item{.dots}{Used to work around non-standard evaluation}
+}
+\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}
+}
+\note{
+see examples in \code{\link[=stub_request]{stub_request()}}
+}
diff --git a/tests/test-all.R b/tests/test-all.R
new file mode 100644
index 0000000..59f641b
--- /dev/null
+++ b/tests/test-all.R
@@ -0,0 +1,2 @@
+library("testthat")
+test_check("webmockr")
diff --git a/tests/testthat/crul_obj.rda b/tests/testthat/crul_obj.rda
new file mode 100644
index 0000000..cd0b190
Binary files /dev/null and b/tests/testthat/crul_obj.rda differ
diff --git a/tests/testthat/test-CrulAdapter.R b/tests/testthat/test-CrulAdapter.R
new file mode 100644
index 0000000..b0c9f1c
--- /dev/null
+++ b/tests/testthat/test-CrulAdapter.R
@@ -0,0 +1,59 @@
+context("CrulAdapter")
+
+aa <- CrulAdapter$new()
+
+test_that("CrulAdapter bits are correct", {
+ skip_on_cran()
+
+ expect_is(CrulAdapter, "R6ClassGenerator")
+
+ expect_is(aa, "CrulAdapter")
+ expect_is(aa$build_crul_request, "function")
+ expect_is(aa$build_crul_response, "function")
+ 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("CrulAdapter fails well", {
+ skip_on_cran()
+
+ expect_error(aa$build_crul_request(), "argument \"x\" is missing")
+ expect_error(aa$build_crul_response(), "argument \"req\" is missing")
+})
+
+
+context("CrulAdapter - with real data")
+test_that("CrulAdapter works", {
+ skip_on_cran()
+
+ load("crul_obj.rda")
+
+ res <- CrulAdapter$new()
+ expect_error(
+ res$handle_request(crul_obj),
+ "Real HTTP connections are disabled.\nUnregistered request: GET http://localhost:9000/get\n\nYou can stub this request with the following snippet"
+ )
+
+ 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")
+})
diff --git a/tests/testthat/test-HashCounter.R b/tests/testthat/test-HashCounter.R
new file mode 100644
index 0000000..b5ac543
--- /dev/null
+++ b/tests/testthat/test-HashCounter.R
@@ -0,0 +1,42 @@
+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")
+})
diff --git a/tests/testthat/test-HttpLibAdapaterRegistry.R b/tests/testthat/test-HttpLibAdapaterRegistry.R
new file mode 100644
index 0000000..1fa4ed8
--- /dev/null
+++ b/tests/testthat/test-HttpLibAdapaterRegistry.R
@@ -0,0 +1,38 @@
+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 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")
+})
diff --git a/tests/testthat/test-RequestPattern.R b/tests/testthat/test-RequestPattern.R
new file mode 100644
index 0000000..098c581
--- /dev/null
+++ b/tests/testthat/test-RequestPattern.R
@@ -0,0 +1,76 @@
+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")
+
+ expect_true(aa$matches(rs1))
+ expect_false(aa$matches(rs2))
+
+ expect_is(aa$to_s(), "character")
+ expect_match(aa$to_s(), "GET")
+ expect_match(aa$to_s(), "httpbin.org/get")
+})
+
+test_that("RequestPattern fails well", {
+ 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_error(
+ expect_is(aa$matches(), "function"),
+ "argument \"headers\" is missing"
+ )
+})
diff --git a/tests/testthat/test-RequestRegistry.R b/tests/testthat/test-RequestRegistry.R
new file mode 100644
index 0000000..5de50df
--- /dev/null
+++ b/tests/testthat/test-RequestRegistry.R
@@ -0,0 +1,48 @@
+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")
+})
diff --git a/tests/testthat/test-RequestSignature.R b/tests/testthat/test-RequestSignature.R
new file mode 100644
index 0000000..810b090
--- /dev/null
+++ b/tests/testthat/test-RequestSignature.R
@@ -0,0 +1,42 @@
+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")
+})
diff --git a/tests/testthat/test-Response.R b/tests/testthat/test-Response.R
new file mode 100644
index 0000000..a3de30b
--- /dev/null
+++ b/tests/testthat/test-Response.R
@@ -0,0 +1,97 @@
+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_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")
+
+ 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_null(aa$content)
+ 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(), "<webmockr response>")
+ 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")
+})
diff --git a/tests/testthat/test-StubRegistry.R b/tests/testthat/test-StubRegistry.R
new file mode 100644
index 0000000..20883dd
--- /dev/null
+++ b/tests/testthat/test-StubRegistry.R
@@ -0,0 +1,105 @@
+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 = "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, "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")
+})
diff --git a/tests/testthat/test-StubbedRequest.R b/tests/testthat/test-StubbedRequest.R
new file mode 100644
index 0000000..2407bda
--- /dev/null
+++ b/tests/testthat/test-StubbedRequest.R
@@ -0,0 +1,89 @@
+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: 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")
+})
diff --git a/tests/testthat/test-flipswitch.R b/tests/testthat/test-flipswitch.R
new file mode 100644
index 0000000..68afa6e
--- /dev/null
+++ b/tests/testthat/test-flipswitch.R
@@ -0,0 +1,29 @@
+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), 1)
+
+ expect_true(webmockr_lightswitch$crul)
+})
+
+test_that("flipswitch - turn off with 'disable'", {
+ aa <- disable()
+
+ expect_null(aa)
+
+ expect_false(webmockr_lightswitch$crul)
+})
+
+test_that("enable and disable fail well", {
+ expect_error(enable(a = 5), "unused argument")
+ expect_error(disable(a = 5), "unused argument")
+})
diff --git a/tests/testthat/test-stub_request.R b/tests/testthat/test-stub_request.R
new file mode 100644
index 0000000..7315129
--- /dev/null
+++ b/tests/testthat/test-stub_request.R
@@ -0,0 +1,50 @@
+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(), "<webmockr stub>")
+
+ expect_is(aa$to_return, "function")
+ expect_error(aa$to_return(), "argument \"headers\" 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")
+})
diff --git a/tests/testthat/test-wi_th.R b/tests/testthat/test-wi_th.R
new file mode 100644
index 0000000..8b3b9cd
--- /dev/null
+++ b/tests/testthat/test-wi_th.R
@@ -0,0 +1,38 @@
+context("wi_th")
+
+test_that("wi_th: with just headers", {
+ aa <- stub_request("get", "https://httpbin.org/get") %>%
+ wi_th(headers = list('User-Agent' = 'R'))
+
+ expect_is(aa, "StubbedRequest")
+ expect_null(aa$body)
+ expect_null(aa$host)
+ expect_null(aa$query)
+ expect_is(aa$request_headers, "list")
+ expect_null(aa$response)
+ expect_null(aa$response_headers)
+ expect_null(aa$responses_sequences)
+
+ expect_is(aa$method, "character")
+ expect_equal(aa$method, "get")
+ expect_is(aa$uri, "character")
+ expect_equal(aa$uri, "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")
+})
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-webmockr.git
More information about the debian-med-commit
mailing list