diff --git a/.Rbuildignore b/.Rbuildignore index a924eae..24e08f9 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -10,3 +10,4 @@ notes.md cran-comments.md ^codemeta\.json$ revdep/ +appveyor.yml diff --git a/.gitignore b/.gitignore index 750165b..bb56932 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,3 @@ -.Rproj.user .Rhistory .RData notes.md @@ -6,3 +5,5 @@ notes.md revdep/checks.noindex revdep/data.sqlite revdep/library.noindex +webmockr.Rproj +.Rproj.user diff --git a/.travis.yml b/.travis.yml index 0a7a131..8d04a68 100644 --- a/.travis.yml +++ b/.travis.yml @@ -12,9 +12,14 @@ matrix: env: R_CODECOV=true - os: linux r: devel + env: _R_CHECK_LENGTH_1_LOGIC2_=TRUE + - os: osx + osx_image: xcode7.3 + r: oldrel -r_github_packages: - - jimhester/covr +r_binary_packages: + - covr + - httr after_success: - if [[ "${R_CODECOV}" ]]; then R -e 'covr::codecov()'; fi diff --git a/DESCRIPTION b/DESCRIPTION index f691321..10c33ac 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -6,7 +6,7 @@ Description: Stubbing and setting expectations on 'HTTP' requests. 'HTTP' method, query parameters, request body, headers and more. Can be used for unit tests or outside of a testing context. -Version: 0.2.6.9100 +Version: 0.3.0.9100 Authors@R: c( person("Scott", "Chamberlain", role = c("aut", "cre"), email = "myrmecocystus+r@gmail.com", comment = c(ORCID="0000-0003-1444-9135")), @@ -17,6 +17,7 @@ URL: https://github.com/ropensci/webmockr (devel) https://ropensci.github.io/http-testing-book/ (user manual) BugReports: https://github.com/ropensci/webmockr/issues LazyData: true +Encoding: UTF-8 Roxygen: list(markdown = TRUE) Imports: curl, @@ -26,14 +27,15 @@ Imports: R6 (>= 2.1.3), urltools (>= 1.6.0), fauxpas, - crul (>= 0.5.2) + crul (>= 0.7.0) Suggests: - roxygen2 (>= 6.0.1), + roxygen2 (>= 6.1.1), testthat, xml2, - vcr -Remotes: sckott/curl@d97134a235b4abbfb82538c55c7b8f4acd40204d -RoxygenNote: 6.0.1 + vcr, + httr +RoxygenNote: 6.1.1 +Remotes: sckott/curl@mocking X-schema.org-applicationCategory: Web X-schema.org-keywords: http, https, API, web-services, curl, mock, mocking, fakeweb, http-mocking, testing, testing-tools, tdd X-schema.org-isPartOf: https://ropensci.org diff --git a/LICENSE b/LICENSE index 1d176f7..04aaae3 100644 --- a/LICENSE +++ b/LICENSE @@ -1,2 +1,2 @@ -YEAR: 2018 +YEAR: 2019 COPYRIGHT HOLDER: Scott Chamberlain diff --git a/NAMESPACE b/NAMESPACE index ac03a3b..67609e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -8,6 +8,7 @@ export(CurlAdapter) export(HashCounter) export(HeadersPattern) export(HttpLibAdapaterRegistry) +export(HttrAdapter) export(MethodPattern) export(RequestPattern) export(RequestRegistry) @@ -20,9 +21,13 @@ export(build_crul_request) export(build_crul_response) export(build_curl_request) export(build_curl_response) +export(build_httr_request) +export(build_httr_response) +export(curl_mock) export(disable) export(enable) export(enabled) +export(httr_mock) export(remove_request_stub) export(request_registry) export(stub_registry) diff --git a/NEWS.md b/NEWS.md index e552407..a01bc3d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,38 @@ +webmockr 0.3.0 +============== + +### MINOR IMPROVEMENTS + +* returned mocked response headers were retaining case that the user gave - whereas they should be all lowercased to match the output in `crul` and `httr`. now fixed. (#49) thanks @hlapp +* returned mocked response headers were not all of character class, but depended on what class was given by the user on creating the stub. this is now fixed, returning all character class values for response headers (#48) thanks @hlapp +* skip tests that require `vcr` if `vcr` is not available (#53) +* internal change to crul adapter to produce the same http response as a new version of crul returns - adds a `response_headers_all` slot (#51) (#54) + + +webmockr 0.2.9 +============== + +### MINOR IMPROVEMENTS + +* make `request_registry()` and `stub_registry()` print methods more similar to avoid confusion for users (#35) +* update docs for `enable`/`disable` to indicate that `crul` and `httr` supported (#46) (related to #45) +* wrap httr adapter examples in `requireNamespace` so only run when httr available +* clean up `.onLoad` call, removing commented out code, and add note about creating adapter objects does not load crul and httr packages + +### BUG FIXES + +* fix to `enable()` and `disable()` methods. even though `httr` is in Suggests, we were loading all adapters (crul, httr) with `stop` when the package was not found. We now give a message and skip when a package not installed. In addition, we `enable()` and `disable()` gain an `adapter` parameter to indicate which package you want to enable or disable. If `adapter` not given we attempt all adapters. Note that this bug shouldn't have affected `vcr` users as `httr` is in Imports in that package, so you'd have to have `httr` installed (#45) thanks to @maelle for uncovering the problem + + +webmockr 0.2.8 +============== + +### NEW FEATURES + +* Added support for integration with package `httr`; see `HttrAdapter` for the details; `webmockr` now integrates with two HTTP R packages: `crul` and `httr` (#43) (#44) +* Along with `httr` integration is a new method `httr_mock()` to turn on mocking for `httr`; and two methods `build_httr_response` and `build_httr_request` meant for internal use + + webmockr 0.2.6 ============== diff --git a/R/HttpLibAdapterRegistry.R b/R/HttpLibAdapterRegistry.R index 5a5366c..61f8b90 100644 --- a/R/HttpLibAdapterRegistry.R +++ b/R/HttpLibAdapterRegistry.R @@ -34,10 +34,10 @@ HttpLibAdapaterRegistry <- R6::R6Class( register = function(x) { # FIXME: when other adapters supported, change this inherits test - if (!inherits(x, "CrulAdapter")) { + if (!inherits(x, c("CrulAdapter", "HttrAdapter", "CurlAdapter"))) { stop("'x' must be an adapter, such as CrulAdapter", call. = FALSE) } - self$adapters <- cc(list(self$adapters, x)) + self$adapters <- c(self$adapters, x) } ) ) diff --git a/R/RequestPattern.R b/R/RequestPattern.R index 0526505..b74d521 100644 --- a/R/RequestPattern.R +++ b/R/RequestPattern.R @@ -75,7 +75,8 @@ RequestPattern <- R6::R6Class( 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) + # FIXME: all private methods used in the below line, see if needed or remove + # if (length(options)) private$assign_options(options) }, matches = function(request_signature) { diff --git a/R/RequestRegistry.R b/R/RequestRegistry.R index 7f7b59c..c7f1901 100644 --- a/R/RequestRegistry.R +++ b/R/RequestRegistry.R @@ -82,7 +82,7 @@ RequestRegistry <- R6::R6Class( print = function(x, ...) { cat(" ", sep = "\n") - cat(" Registered Requests", sep = "\n") + cat(" Registered Requests", sep = "\n") for (i in seq_along(self$request_signatures$hash)) { cat( sprintf( diff --git a/R/RequestSignature.R b/R/RequestSignature.R index 61f76e1..d9b7b60 100644 --- a/R/RequestSignature.R +++ b/R/RequestSignature.R @@ -101,7 +101,7 @@ RequestSignature <- R6::R6Class( to_s = function() { gsub("^\\s+|\\s+$", "", paste( - toupper(self$method), + paste0(toupper(self$method), ": "), self$uri, if (!is.null(self$body) && length(self$body)) { paste0(" with body ", to_string(self$body)) diff --git a/R/StubbedRequest.R b/R/StubbedRequest.R index 740be0b..d985f9f 100644 --- a/R/StubbedRequest.R +++ b/R/StubbedRequest.R @@ -155,7 +155,7 @@ StubbedRequest <- R6::R6Class( ) gsub("^\\s+|\\s+$", "", sprintf( " %s: %s %s %s %s %s", - self$method, + toupper(self$method), url_builder(self$uri, self$query), make_body(self$body), make_headers(self$request_headers), diff --git a/R/adapter-crul.R b/R/adapter-crul.R index ad4321d..69eda13 100644 --- a/R/adapter-crul.R +++ b/R/adapter-crul.R @@ -116,7 +116,10 @@ CrulAdapter <- R6::R6Class( crul_resp$content <- ss$responses_sequences$body_raw } if (names(toadd)[i] == "headers") { - crul_resp$response_headers <- toadd[[i]] + crul_resp$response_headers <- + names_to_lower(as_character(toadd[[i]])) + crul_resp$response_headers_all <- + list(crul_resp$response_headers) } } } @@ -243,37 +246,40 @@ CrulAdapter <- R6::R6Class( #' @param resp a response #' @return a crul response build_crul_response <- function(req, resp) { + # prep headers + if (grepl("^ftp://", resp$url)) { + headers <- list() + } else { + hds <- resp$headers + if (is.null(hds)) { + hds <- resp$response_headers + headers <- if (is.null(hds)) { + list() + } else { + stopifnot(is.list(hds)) + stopifnot(is.character(hds[[1]])) + hds + } + } else { + hh <- rawToChar(hds %||% raw(0)) + if (is.null(hh) || nchar(hh) == 0) { + headers <- list() + } else { + headers <- lapply(curl::parse_headers(hh, multiple = TRUE), + crul_headers_parse) + } + } + } + crul::HttpResponse$new( method = req$method, url = req$url$url, status_code = resp$status_code, request_headers = c('User-Agent' = req$options$useragent, req$headers), response_headers = { - if (grepl("^ftp://", resp$url)) { - list() - } else { - hds <- resp$headers - - if (is.null(hds)) { - hds <- resp$response_headers - - if (is.null(hds)) { - list() - } else { - stopifnot(is.list(hds)) - stopifnot(is.character(hds[[1]])) - hds - } - } else { - hh <- rawToChar(hds %||% raw(0)) - if (is.null(hh) || nchar(hh) == 0) { - list() - } else { - crul_headers_parse(curl::parse_headers(hh)) - } - } - } + if (all(hz_namez(headers))) headers else last(headers) }, + response_headers_all = headers, modified = resp$modified %||% NA, times = resp$times, content = resp$content, diff --git a/R/adapter-curl.R b/R/adapter-curl.R index 6ba3852..2561023 100644 --- a/R/adapter-curl.R +++ b/R/adapter-curl.R @@ -72,8 +72,11 @@ #' curl_fetch_memory("https://httpbin.org/get?cow=brown", h3) #' ## disable again #' webmockr_disable_net_connect() -#' stub_request("get", "https://httpbin.org/get?cow=brown") -#' curl_fetch_memory("https://httpbin.org/get?cow=brown", h3) +#' stub_request("get", "https://httpbin.org/get?cow=brown") %>% +#' to_return(headers = list(brown = "cow")) +#' x <- curl_fetch_memory("https://httpbin.org/get?cow=brown", h3) +#' x +#' rawToChar(x$headers) #' } CurlAdapter <- R6::R6Class( 'CurlAdapter', @@ -249,6 +252,7 @@ build_curl_response <- function(req, resp) { list( url = req$url, status_code = resp$status_code, + type = ctype_fetch(resp$response_headers) %||% NA, headers = headers %||% raw(0), modified = resp$modified %||% NA, times = resp$times %||% numeric(0), @@ -256,6 +260,11 @@ build_curl_response <- function(req, resp) { ) } +ctype_fetch <- function(x) { + match_ctype <- which("content-type" == tolower(names(x))) + if (length(match_ctype) > 0) x[[match_ctype]] +} + #' Build a curl request #' @export #' @param x an unexecuted curl request object @@ -286,3 +295,22 @@ make_curl_headers <- function(x) { ), "\r\n\r\n") } # "HTTP/1.1 405 METHOD NOT ALLOWED\r\nConnection: keep-alive\r\nServer: gunicorn/19.8.1\r\nDate: Fri, 18 May 2018 18:37:00 GMT\r\nContent-Type: text/html\r\nAllow: OPTIONS, PUT\r\nContent-Length: 178\r\nAccess-Control-Allow-Origin: *\r\nAccess-Control-Allow-Credentials: true\r\nVia: 1.1 vegur\r\n\r\n" + +#' Turn on curl mocking +#' @export +#' @param on (logical) set to `TRUE` to turn on, and `FALSE` +#' to turn off. default: `TRUE` +#' @return sets a env var to TRUE +curl_mock <- function(on = TRUE) { + check_for_pkg("curl") + curl::mock() + enable() + # webmockr_handle <- function(req) { + # webmockr::CurlAdapter$new()$handle_request(req) + # } + # if (on) { + # httr::set_callback("request", webmockr_handle) + # } else { + # httr::set_callback("request", NULL) + # } +} diff --git a/R/adapter-httr.R b/R/adapter-httr.R new file mode 100644 index 0000000..c2d4f9e --- /dev/null +++ b/R/adapter-httr.R @@ -0,0 +1,370 @@ +#' httr library adapter +#' +#' @export +#' @family http_lib_adapters +#' @details +#' **Methods** +#' \describe{ +#' \item{`enable()`}{ +#' Enable the adapter +#' } +#' \item{`disable()`}{ +#' Disable the adapter +#' } +#' \item{`build_httr_request(x)`}{ +#' Build a httr [RequestSignature] +#' x: httr request parts (list) +#' } +#' \item{`build_httr_response(req, resp)`}{ +#' Build a httr response +#' req: a httr request (list) +#' resp: a httr response () +#' } +#' \item{`handle_request()`}{ +#' All logic for handling a request +#' req: a httr request (list) +#' } +#' \item{`remove_httr_stubs()`}{ +#' Remove all httr stubs +#' } +#' } +#' +#' This adapter modifies \pkg{httr} to allow mocking HTTP requests +#' +#' @format NULL +#' @usage NULL +#' @examples \dontrun{ +#' if (requireNamespace("httr", quietly = TRUE)) { +#' library(httr) +#' +#' # normal httr request, works fine +#' real <- GET("https://httpbin.org/get") +#' real +#' +#' # with webmockr +#' library(webmockr) +#' ## turn on httr mocking +#' httr_mock() +#' ## now this request isn't allowed +#' # GET("https://httpbin.org/get") +#' ## stub the request +#' stub_request('get', uri = 'https://httpbin.org/get') %>% +#' wi_th( +#' headers = list('Accept' = 'application/json, text/xml, application/xml, */*') +#' ) %>% +#' to_return(status = 418, body = "I'm a teapot!", headers = list(a = 5)) +#' ## now the request succeeds and returns a mocked response +#' (res <- GET("https://httpbin.org/get")) +#' res$status_code +#' rawToChar(res$content) +#' +#' # allow real requests while webmockr is loaded +#' webmockr_allow_net_connect() +#' webmockr_net_connect_allowed() +#' GET("https://httpbin.org/get?animal=chicken") +#' webmockr_disable_net_connect() +#' webmockr_net_connect_allowed() +#' # GET("https://httpbin.org/get?animal=chicken") +#' } +#' } +HttrAdapter <- R6::R6Class( + 'HttrAdapter', + public = list( + name = "httr_adapter", + + enable = function() { + message("HttrAdapter enabled!") + webmockr_lightswitch$httr <- TRUE + httr_mock(TRUE) + invisible(TRUE) + }, + + disable = function() { + message("HttrAdapter disabled!") + webmockr_lightswitch$httr <- FALSE + httr_mock(FALSE) + self$remove_httr_stubs() + invisible(FALSE) + }, + + handle_request = function(req) { + # put request in request registry + request_signature <- build_httr_request(req) + webmockr_request_registry$register_request( + request = request_signature$to_s() + ) + + if (request_is_in_cache(request_signature)) { + # if real requests NOT allowed + # even if net connects allowed, we check if stubbed found first + + # if user wants to return a partial object + # get stub with response and return that + ss <- + webmockr_stub_registry$find_stubbed_request(request_signature)[[1]] + + resp <- Response$new() + resp$set_url(ss$uri) + resp$set_body(ss$body) + resp$set_request_headers(ss$request_headers) + resp$set_response_headers(ss$response_headers) + resp$set_status(as.integer(ss$status_code %||% 200)) + + # if user set to_timeout or to_raise, do that + if (ss$timeout || ss$raise) { + if (ss$timeout) { + x <- fauxpas::HTTPRequestTimeout$new() + resp$set_status(x$status_code) + x$do_verbose(resp) + } + if (ss$raise) { + x <- ss$exceptions[[1]]$new() + resp$set_status(x$status_code) + x$do_verbose(resp) + } + } + + # generate httr response + # VCR: recordable/ignored + if ("package:vcr" %in% search()) { + cas <- vcr::current_cassette() + if (length(cas$previously_recorded_interactions()) == 0) { + # using vcr, but no recorded interactions to the cassette yet + # use RequestHandler - gets current cassette & record interaction + httr_resp <- vcr::RequestHandlerHttr$new(req)$handle() + } + } else { + httr_resp <- build_httr_response(req, resp) + + # add to_return() elements if given + if (length(cc(ss$responses_sequences)) != 0) { + # remove NULLs + toadd <- cc(ss$responses_sequences) + # modify responses + for (i in seq_along(toadd)) { + if (names(toadd)[i] == "status") { + httr_resp$status_code <- as.integer(toadd[[i]]) + } + if (names(toadd)[i] == "body") { + # httr_resp$content <- toadd[[i]] + httr_resp$content <- ss$responses_sequences$body_raw + } + if (names(toadd)[i] == "headers") { + httr_resp$headers <- + names_to_lower(as_character(toadd[[i]])) + } + } + } + } + + # if vcr loaded: record http interaction into vcr namespace + # VCR: recordable/stubbed_by_vcr ?? + if ("package:vcr" %in% search()) { + # get current cassette + cas <- vcr::current_cassette() + httr_resp <- vcr::RequestHandlerHttr$new(req)$handle() + } # vcr is not loaded, skip + + } else if (webmockr_net_connect_allowed(uri = req$url)) { + # if real requests || localhost || certain exceptions ARE + # allowed && nothing found above + httr_mock(FALSE) + httr_resp <- eval(parse(text = paste0("httr::", req$method)))(req$url) + httr_mock(TRUE) + + # if vcr loaded: record http interaction into vcr namespace + # VCR: recordable + if ("package:vcr" %in% search()) { + # stub request so next time we match it + urip <- crul::url_parse(req$url) + m <- vcr::vcr_configuration()$match_requests_on + + if (all(m %in% c("method", "uri")) && length(m) == 2) { + stub_request(req$method, req$url) + } else if (all(m %in% c("method", "uri", "query")) && length(m) == 3) { + tmp <- stub_request(req$method, req$url) + wi_th(tmp, .list = list(query = urip$parameter)) + } else if (all(m %in% c("method", "uri", "headers")) && length(m) == 3) { + tmp <- stub_request(req$method, req$url) + wi_th(tmp, .list = list(query = req$headers)) + } else if (all(m %in% c("method", "uri", "headers", "query")) && length(m) == 4) { + tmp <- stub_request(req$method, req$url) + wi_th(tmp, .list = list(query = urip$parameter, headers = req$headers)) + } + + vcr::RequestHandlerHttr$new(req)$handle() + } + + } else { + # throw vcr error: should happen when user not using + # use_cassette or insert_cassette + if ("package:vcr" %in% search()) { + vcr::RequestHandlerHttr$new(req)$handle() + } + + # no stubs found and net connect not allowed - STOP + x <- "Real HTTP connections are disabled.\nUnregistered request:\n " + y <- "\n\nYou can stub this request with the following snippet:\n\n " + z <- "\n\nregistered request stubs:\n\n" + msgx <- paste(x, request_signature$to_s()) + msgy <- paste(y, private$make_stub_request_code(request_signature)) + if (length(webmockr_stub_registry$request_stubs)) { + msgz <- paste( + z, + paste0(vapply(webmockr_stub_registry$request_stubs, function(z) + z$to_s(), ""), collapse = "\n ") + ) + } else { + msgz <- "" + } + ending <- "\n============================================================" + stop(paste0(msgx, msgy, msgz, ending), call. = FALSE) + } + + return(httr_resp) + }, + + remove_httr_stubs = function() { + webmockr_stub_registry$remove_all_request_stubs() + } + ), + + private = list( + make_stub_request_code = function(x) { + tmp <- sprintf( + "stub_request('%s', uri = '%s')", + x$method, + x$uri + ) + if (!is.null(x$headers) || !is.null(x$body)) { + # set defaults to "" + hd_str <- bd_str <- "" + + # headers has to be a named list, so easier to deal with + if (!is.null(x$headers)) { + hd <- x$headers + hd_str <- paste0( + paste(sprintf("'%s'", names(hd)), + sprintf("'%s'", unlist(unname(hd))), sep = " = "), + collapse = ", ") + } + + # body can be lots of things, so need to handle various cases + if (!is.null(x$body)) { + bd <- x$body + bd_str <- hdl_lst2(bd) + } + + if (nzchar(hd_str) && nzchar(bd_str)) { + with_str <- sprintf(" wi_th(\n headers = list(%s),\n body = list(%s)\n )", + hd_str, bd_str) + } else if (nzchar(hd_str) && !nzchar(bd_str)) { + with_str <- sprintf(" wi_th(\n headers = list(%s)\n )", hd_str) + } else if (!nzchar(hd_str) && nzchar(bd_str)) { + with_str <- sprintf(" wi_th(\n body = list(%s)\n )", bd_str) + } + + tmp <- paste0(tmp, " %>%\n ", with_str) + } + return(tmp) + } + ) +) + +#' Build a httr response +#' @export +#' @param req a request +#' @param resp a response +#' @return a httr response +build_httr_response <- function(req, resp) { + try_url <- tryCatch(req$url$url, error = function(e) e) + + lst <- list( + url = try_url %|s|% req$url, + status_code = as.integer(resp$status_code), + headers = { + if (grepl("^ftp://", resp$url)) { + list() + } else { + hds <- resp$headers + + if (is.null(hds)) { + hds <- resp$response_headers + + if (is.null(hds)) { + list() + } else { + stopifnot(is.list(hds)) + stopifnot(is.character(hds[[1]])) + hds + } + } else { + hds + } + } + }, + all_headers = list(), + cookies = httr_cookies_df(), + content = resp$content, + date = { + if (!is.null(resp$response_headers$date)) { + resp$response_headers$date + } + }, + times = numeric(0), + request = req, + handle = NA + ) + if ("content-type" %in% names(lst$headers)) { + lst$headers$`Content-Type` <- lst$headers$`content-type` + lst$headers$`content-type` <- NULL + } + lst$all_headers <- list(list( + status = lst$status_code, + version = "", + headers = lst$headers + )) + structure(lst, class = "response") +} + +httr_cookies_df <- function() { + df <- data.frame(matrix(ncol = 7, nrow = 0)) + x <- c("domain", "flag", "path", "secure", "expiration", "name", "value") + colnames(df) <- x + df +} + +#' Build a httr request +#' @export +#' @param x an unexecuted httr request object +#' @return a httr request +build_httr_request = function(x) { + RequestSignature$new( + method = x$method, + uri = x$url, + options = list( + body = x$fields %||% NULL, + headers = as.list(x$headers) %||% NULL, + proxies = x$proxies %||% NULL, + auth = x$auth %||% NULL + ) + ) +} + +#' Turn on httr mocking +#' @export +#' @param on (logical) set to `TRUE` to turn on, and `FALSE` +#' to turn off. default: `TRUE` +#' @return silently sets a callback that routes httr request +#' through webmockr +httr_mock <- function(on = TRUE) { + check_for_pkg("httr") + webmockr_handle <- function(req) { + webmockr::HttrAdapter$new()$handle_request(req) + } + if (on) { + httr::set_callback("request", webmockr_handle) + } else { + httr::set_callback("request", NULL) + } +} diff --git a/R/flipswitch.R b/R/flipswitch.R index 927bb27..3c9c3d4 100644 --- a/R/flipswitch.R +++ b/R/flipswitch.R @@ -1,40 +1,86 @@ webmockr_lightswitch <- new.env() -#webmockr_lightswitch$httr <- FALSE webmockr_lightswitch$crul <- FALSE +webmockr_lightswitch$httr <- FALSE +webmockr_lightswitch$curl <- FALSE +webmockr_adapters <- c('crul', 'httr', 'curl') #' Enable or disable webmockr #' #' @export +#' @param adapter (character) the adapter name, 'crul', 'httr', +#' or 'curl'. if none given, we attempt to enable both adapters +#' @param options list of options - ignored for now. #' @details `enable()` enables \pkg{webmockr} for all adapters. #' `disable()` disables \pkg{webmockr} for all adapters. `enabled()` #' answers whether \pkg{webmockr} is enabled for a given adapter #' @return `enable()` and `disable()` invisibly returns booleans for -#' each adapter (currently only \pkg{crul}), as a result of running -#' enable or disable, respectively, on each [HttpLibAdapaterRegistry] -#' object. `enabled` returns a single boolean -#' @param options list of options - ignored for now. -#' @param adapter (character) the adapter to enable, only 'crul' for now -enable <- function(options = list()) { - invisible(vapply(http_lib_adapter_registry$adapters, function(z) { - z$enable() - }, logical(1))) +#' each adapter, as a result of running enable or disable, respectively, +#' on each [HttpLibAdapaterRegistry] object. `enabled` returns a +#' single boolean +enable <- function(adapter = NULL, options = list()) { + adnms <- vapply(http_lib_adapter_registry$adapters, function(w) { + sub("_adapter", "", w$name) + }, "") + if (!is.null(adapter)) { + if (!adapter %in% webmockr_adapters) { + stop("adapter must be one of 'crul', 'httr', or 'curl'") + } + if (!requireNamespace(adapter, quietly = TRUE)) { + message(adapter, " not installed, skipping enable") + return(invisible(FALSE)) + } + http_lib_adapter_registry$adapters[[grep(adapter, adnms)]]$enable() + } else { + invisible(vapply(http_lib_adapter_registry$adapters, function(z) { + pkgname <- sub("_adapter", "", z$name) + # check if package installed first + if (!requireNamespace(pkgname, quietly = TRUE)) { + message(pkgname, " not installed, skipping enable") + FALSE + } else { + # if instaled, enable + z$enable() + } + }, logical(1))) + } } #' @export #' @rdname enable enabled <- function(adapter = "crul") { - adapters <- c('crul') - if (!adapter %in% adapters) { + if (!adapter %in% webmockr_adapters) { stop("'adapter' must be in the set ", - paste0(adapters, collapse = ", ")) + paste0(webmockr_adapters, collapse = ", ")) } - webmockr_lightswitch$crul + webmockr_lightswitch[[adapter]] } #' @export #' @rdname enable -disable <- function(options = list()) { - invisible(unlist(lapply(http_lib_adapter_registry$adapters, function(z) { - z$disable() - }))) +disable <- function(adapter = NULL, options = list()) { + adnms <- vapply(http_lib_adapter_registry$adapters, function(w) { + sub("_adapter", "", w$name) + }, "") + if (!is.null(adapter)) { + if (!adapter %in% webmockr_adapters) { + stop("adapter must be one of 'crul', 'httr', or 'curl'") + } + if (!requireNamespace(adapter, quietly = TRUE)) { + message(adapter, " not installed, skipping disable") + return(invisible(FALSE)) + } + http_lib_adapter_registry$adapters[[grep(adapter, adnms)]]$disable() + } else { + invisible(vapply(http_lib_adapter_registry$adapters, function(z) { + pkgname <- sub("_adapter", "", z$name) + # check if package installed first + if (!requireNamespace(pkgname, quietly = TRUE)) { + message(pkgname, " not installed, skipping disable") + FALSE + } else { + # if instaled, disable + z$disable() + } + }, logical(1))) + } } diff --git a/R/onload.R b/R/onload.R index 2ec455c..1a816bf 100644 --- a/R/onload.R +++ b/R/onload.R @@ -1,39 +1,13 @@ -http_lib_adapter_registry <- NULL - +http_lib_adapter_registry <- NULL # nocov start .onLoad <- function(libname, pkgname) { # set defaults for webmockr webmockr_configure() - # assign crul adapter for now by default - ## because it's the only http lib supported for now - ## later change to making user set the adapter themselves + # assign crul, httr, and curl adapters + # which doesn't require those packages loaded yet x <- HttpLibAdapaterRegistry$new() x$register(CrulAdapter$new()) + x$register(HttrAdapter$new()) + x$register(CurlAdapter$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() +} # nocov end diff --git a/R/stub_request.R b/R/stub_request.R index bfd8deb..fcc8032 100644 --- a/R/stub_request.R +++ b/R/stub_request.R @@ -34,13 +34,13 @@ #' wi_th(headers = list('User-Agent' = 'R')) #' #' # request body -#' stub_request("get", "https://httpbin.org/get") %>% +#' stub_request("post", "https://httpbin.org/post") %>% #' wi_th(body = list(foo = 'bar')) #' stub_registry() #' library(crul) #' x <- crul::HttpClient$new(url = "https://httpbin.org") #' crul::mock() -#' x$get('get') +#' x$post('post', body = list(foo = 'bar')) #' #' # add expectation with to_return #' stub_request("get", "https://httpbin.org/get") %>% diff --git a/R/to_return.R b/R/to_return.R index 184adc8..74d2935 100644 --- a/R/to_return.R +++ b/R/to_return.R @@ -17,6 +17,11 @@ #' - status: (numeric/integer) three digit status code #' - body: various, including character string, list, raw, numeric, etc #' - headers: (list) a named list +#' +#' response headers are returned with all lowercase names and the values +#' are all of type character. if numeric/integer values are given +#' (e.g., `to_return(headers = list(a = 10))`), we'll coerce any +#' numeric/integer values to character. to_return <- function(.data, ...) { to_return_(.data, .dots = lazyeval::lazy_dots(...)) } diff --git a/R/webmockr-opts.R b/R/webmockr-opts.R index 8352c7a..6b9a3a8 100644 --- a/R/webmockr-opts.R +++ b/R/webmockr-opts.R @@ -124,7 +124,8 @@ net_connect_explicit_allowed <- function(allowed, uri = NULL) { #' @export print.webmockr_config <- function(x, ...) { cat("", sep = "\n") - cat(paste0(" enabled?: ", webmockr_lightswitch$crul), sep = "\n") + cat(paste0(" crul enabled?: ", webmockr_lightswitch$crul), sep = "\n") + cat(paste0(" httr enabled?: ", webmockr_lightswitch$httr), sep = "\n") cat(paste0(" allow_net_connect?: ", x$allow_net_connect), sep = "\n") cat(paste0(" allow_localhost?: ", x$allow_localhost), sep = "\n") cat(paste0(" allow: ", x$allow %||% ""), sep = "\n") diff --git a/R/webmockr.R b/R/webmockr.R index 88095d4..7a4dd0e 100644 --- a/R/webmockr.R +++ b/R/webmockr.R @@ -10,13 +10,13 @@ #' @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` -#' } +#' +#' - Stubbing HTTP requests at low http client lib level +#' - Setting and verifying expectations on HTTP requests +#' - Matching requests based on method, URI, headers and body +#' - Supports multiple HTTP libraries, including \pkg{crul} and +#' \pkg{httr} +#' - Integration with HTTP test caching libraty \pkg{vcr} #' #' @examples #' library(webmockr) diff --git a/R/zzz.R b/R/zzz.R index 9af76ae..285d0fe 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -50,7 +50,20 @@ url_builder <- function(uri, args = NULL) { paste0(uri, "?", paste(names(args), args, sep = "=", collapse = ",")) } -`%||%` <- function(x, y) if (is.null(x) || length(x) == 0 || nchar(x) == 0 || all(is.na(x))) y else x +`%||%` <- function(x, y) { + if ( + is.null(x) || length(x) == 0 || all(nchar(x) == 0) || all(is.na(x)) + ) y else x +} + +# tryCatch version of above +`%|s|%` <- function(x, y) { + z <- tryCatch(x) + if (inherits(z, "error")) return(y) + if ( + is.null(z) || length(z) == 0 || all(nchar(z) == 0) || all(is.na(z)) + ) y else x +} `!!` <- function(x) if (is.null(x) || is.na(x)) FALSE else TRUE @@ -98,8 +111,7 @@ hz_namez <- function(x) { nms <- names(x) if (is.null(nms)) { along_rep(x, FALSE) - } - else { + } else { !(is.na(nms) | nms == "") } } @@ -112,3 +124,19 @@ check_for_pkg <- function(x) { invisible(TRUE) } } + +# lower case names in a list, return that list +names_to_lower <- function(x) { + names(x) <- tolower(names(x)) + return(x) +} + +as_character <- function(x) { + stopifnot(is.list(x)) + lapply(x, as.character) +} + +last <- function(x) { + if (length(x) == 0) return(list()) + x[[length(x)]] +} diff --git a/README.Rmd b/README.Rmd index c9144af..12a8e14 100644 --- a/README.Rmd +++ b/README.Rmd @@ -9,8 +9,10 @@ knitr::opts_chunk$set( ) ``` +[![cran checks](https://cranchecks.info/badges/worst/webmockr)](https://cranchecks.info/pkgs/webmockr) [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![Build Status](https://travis-ci.org/ropensci/webmockr.svg?branch=master)](https://travis-ci.org/ropensci/webmockr) +[![Build status](https://ci.appveyor.com/api/projects/status/47scc0vur41sbfyx?svg=true)](https://ci.appveyor.com/project/sckott/webmockr) [![codecov](https://codecov.io/gh/ropensci/webmockr/branch/master/graph/badge.svg)](https://codecov.io/gh/ropensci/webmockr) [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/webmockr)](https://github.com/metacran/cranlogs.app) [![cran version](https://www.r-pkg.org/badges/version/webmockr)](https://cran.r-project.org/package=webmockr) @@ -106,8 +108,9 @@ in the `webmockr_configure()` function. ## Supported HTTP libraries * [crul](https://github.com/ropensci/crul) +* [httr](https://github.com/r-lib/httr) -> more to come: curl, httr +> in development: curl ## Install @@ -225,6 +228,102 @@ x <- HttpClient$new(url = "https://httpbin.org") x$get('get', query = list(a = "b")) ``` +## httr integration + +```{r} +library(webmockr) +library(httr) + +# turn on httr mocking +httr_mock() +``` + +```{r eval=FALSE} +# no stub found +GET("https://httpbin.org/get") +#> Error: Real HTTP connections are disabled. +#> Unregistered request: +#> GET https://httpbin.org/get with headers {Accept: application/json, text/xml, application/xml, */*} +#> +#> You can stub this request with the following snippet: +#> +#> stub_request('get', uri = 'https://httpbin.org/get') %>% +#> wi_th( +#> headers = list('Accept' = 'application/json, text/xml, application/xml, */*') +#> ) +#> ============================================================ +``` + +make a stub + +```{r} +stub_request('get', uri = 'https://httpbin.org/get') %>% + wi_th( + headers = list('Accept' = 'application/json, text/xml, application/xml, */*') + ) %>% + to_return(status = 418, body = "I'm a teapot!!!", headers = list(im_a = "teapot")) +``` + +now returns mocked response + + +```{r eval=FALSE} +(res <- GET("https://httpbin.org/get")) +res$status_code +#> [1] 418 +res$response_headers +#> $im_a +#> [1] "teapot" +``` + +## curl integration + +```{r} +library(webmockr) +library(curl) + +# turn on curl mocking +#curl_mock() +enable('curl') +#disable('curl') +#curl::mock(FALSE) +``` + +```{r eval=TRUE} +# no stub found +curl_fetch_memory("https://httpbin.org/get") +#> Error: Real HTTP connections are disabled. +#> Unregistered request: +#> GET https://httpbin.org/get with headers {accept: */*, accept-encoding: gzip, deflate, user-agent: R (3.5.2 x86_64-apple-darwin15.6.0 x86_64 darwin15.6.0)} +#> +#> You can stub this request with the following snippet: +#> +#> stub_request('get', uri = 'https://httpbin.org/get') %>% +#> wi_th( +#> headers = list('accept' = '*/*', 'accept-encoding' = 'gzip, deflate', 'user-agent' = 'R (3.5.2 x86_64-apple-darwin15.6.0 x86_64 darwin15.6.0)') +#> ) +#> ============================================================ +``` + +make a stub + +```{r} +stub_request('get', uri = 'https://httpbin.org/get') %>% + to_return(status = 418, body = "I'm a teapot!!!", + headers = list(im_a = "teapot", 'content-type' = "tea/pot") + ) +``` + +now returns mocked response + + +```{r} +res <- curl_fetch_memory("https://httpbin.org/get") +res +res$type +cat(rawToChar(res$headers)) +``` + ## Meta * Please [report any issues or bugs](https://github.com/ropensci/webmockr/issues). diff --git a/README.md b/README.md index 879a2f1..5f85dec 100644 --- a/README.md +++ b/README.md @@ -3,8 +3,10 @@ webmockr +[![cran checks](https://cranchecks.info/badges/worst/webmockr)](https://cranchecks.info/pkgs/webmockr) [![Project Status: Active - The project has reached a stable, usable state and is being actively developed.](http://www.repostatus.org/badges/latest/active.svg)](http://www.repostatus.org/#active) [![Build Status](https://travis-ci.org/ropensci/webmockr.svg?branch=master)](https://travis-ci.org/ropensci/webmockr) +[![Build status](https://ci.appveyor.com/api/projects/status/47scc0vur41sbfyx?svg=true)](https://ci.appveyor.com/project/sckott/webmockr) [![codecov](https://codecov.io/gh/ropensci/webmockr/branch/master/graph/badge.svg)](https://codecov.io/gh/ropensci/webmockr) [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/webmockr)](https://github.com/metacran/cranlogs.app) [![cran version](https://www.r-pkg.org/badges/version/webmockr)](https://cran.r-project.org/package=webmockr) @@ -100,8 +102,9 @@ in the `webmockr_configure()` function. ## Supported HTTP libraries * [crul](https://github.com/ropensci/crul) +* [httr](https://github.com/r-lib/httr) -> more to come: curl, httr +> in development: curl ## Install @@ -130,6 +133,7 @@ library(webmockr) ```r webmockr::enable() #> CrulAdapter enabled! +#> HttrAdapter enabled! ``` ## Inside a test framework @@ -160,7 +164,7 @@ stub_request("get", "https://httpbin.org/get") %>% stub_registry() #> #> Registered Stubs -#> get: https://httpbin.org/get | to_return: with body "success!" with status 200 +#> GET: https://httpbin.org/get | to_return: with body "success!" with status 200 # make the request z <- crul::HttpClient$new(url = "https://httpbin.org")$get("get") @@ -208,7 +212,7 @@ x$get('get') #> #> url: https://httpbin.org/get #> request_headers: -#> User-Agent: libcurl/7.54.0 r-curl/3.2 crul/0.5.2 +#> User-Agent: libcurl/7.54.0 r-curl/3.3.9000 crul/0.7.0.9100 #> Accept-Encoding: gzip, deflate #> Accept: application/json, text/xml, application/xml, */* #> response_headers: @@ -244,7 +248,7 @@ x$get('get', query = list(hello = "world")) #> #> url: https://httpbin.org/get?hello=world #> request_headers: -#> User-Agent: libcurl/7.54.0 r-curl/3.2 crul/0.5.2 +#> User-Agent: libcurl/7.54.0 r-curl/3.3.9000 crul/0.7.0.9100 #> Accept-Encoding: gzip, deflate #> Accept: application/json, text/xml, application/xml, */* #> response_headers: @@ -281,9 +285,9 @@ stub_request("get", "https://httpbin.org/get") %>% stub_registry() #> #> Registered Stubs -#> get: 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"} +#> GET: 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"} ``` @@ -293,7 +297,7 @@ x$get('get', query = list(hello = "world")) #> #> url: https://httpbin.org/get?hello=world #> request_headers: -#> User-Agent: libcurl/7.54.0 r-curl/3.2 crul/0.5.2 +#> User-Agent: libcurl/7.54.0 r-curl/3.3.9000 crul/0.7.0.9100 #> Accept-Encoding: gzip, deflate #> Accept: application/json, text/xml, application/xml, */* #> response_headers: @@ -351,6 +355,186 @@ x$get('get', query = list(a = "b")) #> - The request could not be understood by the server due to malformed syntax. The client SHOULD NOT repeat the request without modifications. ``` +## httr integration + + +```r +library(webmockr) +library(httr) +#> +#> Attaching package: 'httr' +#> The following object is masked from 'package:crul': +#> +#> handle + +# turn on httr mocking +httr_mock() +``` + + +```r +# no stub found +GET("https://httpbin.org/get") +#> Error: Real HTTP connections are disabled. +#> Unregistered request: +#> GET https://httpbin.org/get with headers {Accept: application/json, text/xml, application/xml, */*} +#> +#> You can stub this request with the following snippet: +#> +#> stub_request('get', uri = 'https://httpbin.org/get') %>% +#> wi_th( +#> headers = list('Accept' = 'application/json, text/xml, application/xml, */*') +#> ) +#> ============================================================ +``` + +make a stub + + +```r +stub_request('get', uri = 'https://httpbin.org/get') %>% + wi_th( + headers = list('Accept' = 'application/json, text/xml, application/xml, */*') + ) %>% + to_return(status = 418, body = "I'm a teapot!!!", headers = list(im_a = "teapot")) +#> +#> method: get +#> uri: https://httpbin.org/get +#> with: +#> query: +#> body: +#> request_headers: Accept=application/json, text/xml, application/xml, */* +#> to_return: +#> status: 418 +#> body: I'm a teapot!!! +#> response_headers: im_a=teapot +#> should_timeout: FALSE +#> should_raise: FALSE +``` + +now returns mocked response + + + +```r +(res <- GET("https://httpbin.org/get")) +res$status_code +#> [1] 418 +res$response_headers +#> $im_a +#> [1] "teapot" +``` + +## curl integration + + +```r +library(webmockr) +library(curl) +#> +#> Attaching package: 'curl' +#> The following object is masked from 'package:httr': +#> +#> handle_reset +#> The following object is masked from 'package:crul': +#> +#> mock + +# turn on curl mocking +curl::mock() +``` + + +```r +# no stub found +curl_fetch_memory("https://httpbin.org/get") +#> eval(expr, envir, enclos) +#> mocking? TRUE +#> calling curl_echo from inside mock_req +#> curl_echo(h) +#> GET +#> $url +#> [1] "https://httpbin.org/get" +#> +#> $status_code +#> [1] 200 +#> +#> $headers +#> raw(0) +#> +#> $modified +#> [1] NA +#> +#> $times +#> numeric(0) +#> +#> $content +#> raw(0) +#> Error: Real HTTP connections are disabled. +#> Unregistered request: +#> GET https://httpbin.org/get with headers {accept: */*, accept-encoding: gzip, deflate, user-agent: R (3.5.2 x86_64-apple-darwin15.6.0 x86_64 darwin15.6.0)} +#> +#> You can stub this request with the following snippet: +#> +#> stub_request('get', uri = 'https://httpbin.org/get') %>% +#> wi_th( +#> headers = list('accept' = '*/*', 'accept-encoding' = 'gzip, deflate', 'user-agent' = 'R (3.5.2 x86_64-apple-darwin15.6.0 x86_64 darwin15.6.0)') +#> ) +#> ============================================================ +``` + +make a stub + + +```r +stub_request('get', uri = 'https://httpbin.org/get') %>% + to_return(status = 418, body = "I'm a teapot!!!", headers = list(im_a = "teapot")) +#> +#> method: get +#> uri: https://httpbin.org/get +#> with: +#> query: +#> body: +#> request_headers: +#> to_return: +#> status: 418 +#> body: I'm a teapot!!! +#> response_headers: im_a=teapot +#> should_timeout: FALSE +#> should_raise: FALSE +``` + +now returns mocked response + + + +```r +res <- curl_fetch_memory("https://httpbin.org/get") +#> eval(expr, envir, enclos) +#> mocking? TRUE +#> calling curl_echo from inside mock_req +#> curl_echo(h) +#> GET +res +#> $url +#> [1] "https://httpbin.org/get" +#> +#> $status_code +#> [1] 200 +#> +#> $headers +#> raw(0) +#> +#> $modified +#> [1] NA +#> +#> $times +#> numeric(0) +#> +#> $content +#> raw(0) +``` + ## Meta * Please [report any issues or bugs](https://github.com/ropensci/webmockr/issues). diff --git a/appveyor.yml b/appveyor.yml new file mode 100644 index 0000000..05fb3ff --- /dev/null +++ b/appveyor.yml @@ -0,0 +1,54 @@ +init: + ps: | + $ErrorActionPreference = "Stop" + Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" + Import-Module '..\appveyor-tool.ps1' + +install: + ps: Bootstrap + +build_script: + - travis-tool.sh install_deps + +test_script: + - travis-tool.sh run_tests + +on_failure: + - travis-tool.sh dump_logs + +environment: + global: + R_CHECK_ARGS: "--no-build-vignettes --no-manual --as-cran" + matrix: + - R_VERSION: release + R_ARCH: x64 + USE_RTOOLS: true + - R_VERSION: devel + R_ARCH: x64 + _R_CHECK_LENGTH_1_LOGIC2_: TRUE + USE_RTOOLS: true + +notifications: + - provider: Slack + auth_token: + secure: S3AcHEoJHUtahR5N8ConStS8oV/+x34tS1bDGM3OD0QxDKBBxufeiMmXQsId1gZu + channel: '#builds' + +artifacts: + - path: '*.Rcheck\**\*.log' + name: Logs + + - path: '*.Rcheck\**\*.out' + name: Logs + + - path: '*.Rcheck\**\*.fail' + name: Logs + + - path: '*.Rcheck\**\*.Rout' + name: Logs + + - path: '\*_*.tar.gz' + name: tar + + - path: '\*_*.zip' + name: zip diff --git a/codemeta.json b/codemeta.json index ad2caa4..b60e243 100644 --- a/codemeta.json +++ b/codemeta.json @@ -10,14 +10,14 @@ "codeRepository": "https://github.com/ropensci/webmockr", "issueTracker": "https://github.com/ropensci/webmockr/issues", "license": "https://spdx.org/licenses/MIT", - "version": "0.2.6", + "version": "0.3.0", "programmingLanguage": { "@type": "ComputerLanguage", "name": "R", - "version": "3.5.0", + "version": "3.5.2", "url": "https://r-project.org" }, - "runtimePlatform": "R version 3.5.0 (2018-04-23)", + "runtimePlatform": "R version 3.5.2 Patched (2018-12-31 r75943)", "provider": { "@id": "https://cran.r-project.org", "@type": "Organization", @@ -47,7 +47,7 @@ "@type": "SoftwareApplication", "identifier": "roxygen2", "name": "roxygen2", - "version": ">= 6.0.1", + "version": ">= 6.1.1", "provider": { "@id": "https://cran.r-project.org", "@type": "Organization", @@ -91,6 +91,18 @@ "url": "https://cran.r-project.org" }, "sameAs": "https://CRAN.R-project.org/package=vcr" + }, + { + "@type": "SoftwareApplication", + "identifier": "httr", + "name": "httr", + "provider": { + "@id": "https://cran.r-project.org", + "@type": "Organization", + "name": "Comprehensive R Archive Network (CRAN)", + "url": "https://cran.r-project.org" + }, + "sameAs": "https://CRAN.R-project.org/package=httr" } ], "softwareRequirements": [ @@ -186,7 +198,7 @@ "@type": "SoftwareApplication", "identifier": "crul", "name": "crul", - "version": ">= 0.5.2", + "version": ">= 0.7.0", "provider": { "@id": "https://cran.r-project.org", "@type": "Organization", @@ -198,12 +210,12 @@ ], "applicationCategory": "Web", "isPartOf": "https://ropensci.org", - "keywords": ["http", "https", "API", "web-services", "curl", "mock", "mocking", "fakeweb", "http-mocking", "testing", "testing-tools", "tdd", "rstats", "http-mock"], + "keywords": ["http", "https", "API", "web-services", "curl", "mock", "mocking", "fakeweb", "http-mocking", "testing", "testing-tools", "tdd", "rstats", "http-mock", "r", "r-package"], "contIntegration": "https://travis-ci.org/ropensci/webmockr", "developmentStatus": "active", "releaseNotes": "https://github.com/ropensci/webmockr/blob/master/NEWS.md", "readme": "https://github.com/ropensci/webmockr/blob/master/README.md", - "fileSize": "39.415KB", + "fileSize": "45.014KB", "relatedLink": "https://ropensci.github.io/http-testing-book/", "funder": [ { diff --git a/cran-comments.md b/cran-comments.md index 17c18ef..808ddcd 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,7 +1,7 @@ ## Test environments -* local OS X install, R 3.5.0 -* ubuntu 12.04 (on travis-ci), R 3.5.0 +* local OS X install, R 3.5.2 Patched +* ubuntu 14.04 (on travis-ci), R 3.5.2 * win-builder (devel and release) ## R CMD check results @@ -11,17 +11,17 @@ License components with restrictions and base license permitting such: MIT + file LICENSE File 'LICENSE': - YEAR: 2018 + YEAR: 2019 COPYRIGHT HOLDER: Scott Chamberlain ## Reverse dependencies -I have checked the 3 reverse dependencies, and there were no problems. -See (). +I have checked the 8 reverse dependencies, and there were no problems. +See (). --- -This version gains support for integration with package vcr. +This version contains fixes for returned mocked response headers, matches mocked responses to new crul version responses, and skips tests that require vcr if vcr is not available on the system. Thanks! Scott Chamberlain diff --git a/man/CrulAdapter.Rd b/man/CrulAdapter.Rd index 5fda18c..bdec0b1 100644 --- a/man/CrulAdapter.Rd +++ b/man/CrulAdapter.Rd @@ -37,6 +37,8 @@ Remove all crul stubs This adapter modifies \pkg{crul} to allow mocking HTTP requests } \seealso{ -Other http_lib_adapters: \code{\link{CurlAdapter}} +Other http_lib_adapters: \code{\link{CurlAdapter}}, + \code{\link{HttrAdapter}} } +\concept{http_lib_adapters} \keyword{datasets} diff --git a/man/CurlAdapter.Rd b/man/CurlAdapter.Rd index 1d77d23..cc07838 100644 --- a/man/CurlAdapter.Rd +++ b/man/CurlAdapter.Rd @@ -75,11 +75,16 @@ h3 <- new_handle() curl_fetch_memory("https://httpbin.org/get?cow=brown", h3) ## disable again webmockr_disable_net_connect() -stub_request("get", "https://httpbin.org/get?cow=brown") -curl_fetch_memory("https://httpbin.org/get?cow=brown", h3) +stub_request("get", "https://httpbin.org/get?cow=brown") \%>\% + to_return(headers = list(brown = "cow")) +x <- curl_fetch_memory("https://httpbin.org/get?cow=brown", h3) +x +rawToChar(x$headers) } } \seealso{ -Other http_lib_adapters: \code{\link{CrulAdapter}} +Other http_lib_adapters: \code{\link{CrulAdapter}}, + \code{\link{HttrAdapter}} } +\concept{http_lib_adapters} \keyword{datasets} diff --git a/man/HashCounter.Rd b/man/HashCounter.Rd index 84c306d..2bb0946 100644 --- a/man/HashCounter.Rd +++ b/man/HashCounter.Rd @@ -35,4 +35,5 @@ x$hash Other request-registry: \code{\link{RequestRegistry}}, \code{\link{request_registry}} } +\concept{request-registry} \keyword{datasets} diff --git a/man/HttrAdapter.Rd b/man/HttrAdapter.Rd new file mode 100644 index 0000000..41ae4c5 --- /dev/null +++ b/man/HttrAdapter.Rd @@ -0,0 +1,80 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adapter-httr.R +\docType{data} +\name{HttrAdapter} +\alias{HttrAdapter} +\title{httr library adapter} +\description{ +httr library adapter +} +\details{ +\strong{Methods} +\describe{ +\item{\code{enable()}}{ +Enable the adapter +} +\item{\code{disable()}}{ +Disable the adapter +} +\item{\code{build_httr_request(x)}}{ +Build a httr \link{RequestSignature} +x: httr request parts (list) +} +\item{\code{build_httr_response(req, resp)}}{ +Build a httr response +req: a httr request (list) +resp: a httr response () +} +\item{\code{handle_request()}}{ +All logic for handling a request +req: a httr request (list) +} +\item{\code{remove_httr_stubs()}}{ +Remove all httr stubs +} +} + +This adapter modifies \pkg{httr} to allow mocking HTTP requests +} +\examples{ +\dontrun{ +if (requireNamespace("httr", quietly = TRUE)) { +library(httr) + +# normal httr request, works fine +real <- GET("https://httpbin.org/get") +real + +# with webmockr +library(webmockr) +## turn on httr mocking +httr_mock() +## now this request isn't allowed +# GET("https://httpbin.org/get") +## stub the request +stub_request('get', uri = 'https://httpbin.org/get') \%>\% + wi_th( + headers = list('Accept' = 'application/json, text/xml, application/xml, */*') + ) \%>\% + to_return(status = 418, body = "I'm a teapot!", headers = list(a = 5)) +## now the request succeeds and returns a mocked response +(res <- GET("https://httpbin.org/get")) +res$status_code +rawToChar(res$content) + +# allow real requests while webmockr is loaded +webmockr_allow_net_connect() +webmockr_net_connect_allowed() +GET("https://httpbin.org/get?animal=chicken") +webmockr_disable_net_connect() +webmockr_net_connect_allowed() +# GET("https://httpbin.org/get?animal=chicken") +} +} +} +\seealso{ +Other http_lib_adapters: \code{\link{CrulAdapter}}, + \code{\link{CurlAdapter}} +} +\concept{http_lib_adapters} +\keyword{datasets} diff --git a/man/RequestRegistry.Rd b/man/RequestRegistry.Rd index a232f8b..7ae82c0 100644 --- a/man/RequestRegistry.Rd +++ b/man/RequestRegistry.Rd @@ -38,4 +38,5 @@ x$reset() Other request-registry: \code{\link{HashCounter}}, \code{\link{request_registry}} } +\concept{request-registry} \keyword{datasets} diff --git a/man/StubRegistry.Rd b/man/StubRegistry.Rd index ed62355..cc048ac 100644 --- a/man/StubRegistry.Rd +++ b/man/StubRegistry.Rd @@ -64,4 +64,5 @@ Other stub-registry: \code{\link{remove_request_stub}}, \code{\link{stub_registry_clear}}, \code{\link{stub_registry}} } +\concept{stub-registry} \keyword{datasets} diff --git a/man/build_httr_request.Rd b/man/build_httr_request.Rd new file mode 100644 index 0000000..fc33dcd --- /dev/null +++ b/man/build_httr_request.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adapter-httr.R +\name{build_httr_request} +\alias{build_httr_request} +\title{Build a httr request} +\usage{ +build_httr_request(x) +} +\arguments{ +\item{x}{an unexecuted httr request object} +} +\value{ +a httr request +} +\description{ +Build a httr request +} diff --git a/man/build_httr_response.Rd b/man/build_httr_response.Rd new file mode 100644 index 0000000..25ee65e --- /dev/null +++ b/man/build_httr_response.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adapter-httr.R +\name{build_httr_response} +\alias{build_httr_response} +\title{Build a httr response} +\usage{ +build_httr_response(req, resp) +} +\arguments{ +\item{req}{a request} + +\item{resp}{a response} +} +\value{ +a httr response +} +\description{ +Build a httr response +} diff --git a/man/curl_mock.Rd b/man/curl_mock.Rd new file mode 100644 index 0000000..8979c9d --- /dev/null +++ b/man/curl_mock.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adapter-curl.R +\name{curl_mock} +\alias{curl_mock} +\title{Turn on curl mocking} +\usage{ +curl_mock(on = TRUE) +} +\arguments{ +\item{on}{(logical) set to \code{TRUE} to turn on, and \code{FALSE} +to turn off. default: \code{TRUE}} +} +\value{ +sets a env var to TRUE +} +\description{ +Turn on curl mocking +} diff --git a/man/enable.Rd b/man/enable.Rd index e40866e..a4d9be3 100644 --- a/man/enable.Rd +++ b/man/enable.Rd @@ -6,22 +6,23 @@ \alias{disable} \title{Enable or disable webmockr} \usage{ -enable(options = list()) +enable(adapter = NULL, options = list()) enabled(adapter = "crul") -disable(options = list()) +disable(adapter = NULL, options = list()) } \arguments{ -\item{options}{list of options - ignored for now.} +\item{adapter}{(character) the adapter name, 'crul', 'httr', +or 'curl'. if none given, we attempt to enable both adapters} -\item{adapter}{(character) the adapter to enable, only 'crul' for now} +\item{options}{list of options - ignored for now.} } \value{ \code{enable()} and \code{disable()} invisibly returns booleans for -each adapter (currently only \pkg{crul}), as a result of running -enable or disable, respectively, on each \link{HttpLibAdapaterRegistry} -object. \code{enabled} returns a single boolean +each adapter, as a result of running enable or disable, respectively, +on each \link{HttpLibAdapaterRegistry} object. \code{enabled} returns a +single boolean } \description{ Enable or disable webmockr diff --git a/man/httr_mock.Rd b/man/httr_mock.Rd new file mode 100644 index 0000000..3b33548 --- /dev/null +++ b/man/httr_mock.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/adapter-httr.R +\name{httr_mock} +\alias{httr_mock} +\title{Turn on httr mocking} +\usage{ +httr_mock(on = TRUE) +} +\arguments{ +\item{on}{(logical) set to \code{TRUE} to turn on, and \code{FALSE} +to turn off. default: \code{TRUE}} +} +\value{ +silently sets a callback that routes httr request +through webmockr +} +\description{ +Turn on httr mocking +} diff --git a/man/remove_request_stub.Rd b/man/remove_request_stub.Rd index 26317c1..2c37f2d 100644 --- a/man/remove_request_stub.Rd +++ b/man/remove_request_stub.Rd @@ -26,3 +26,4 @@ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{stub_registry_clear}}, \code{\link{stub_registry}} } +\concept{stub-registry} diff --git a/man/request_registry.Rd b/man/request_registry.Rd index 6af1aa0..933aca7 100644 --- a/man/request_registry.Rd +++ b/man/request_registry.Rd @@ -38,3 +38,4 @@ request_registry() Other request-registry: \code{\link{HashCounter}}, \code{\link{RequestRegistry}} } +\concept{request-registry} diff --git a/man/stub_registry.Rd b/man/stub_registry.Rd index c0e3bb5..3997339 100644 --- a/man/stub_registry.Rd +++ b/man/stub_registry.Rd @@ -36,3 +36,4 @@ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}}, \code{\link{stub_registry_clear}} } +\concept{stub-registry} diff --git a/man/stub_registry_clear.Rd b/man/stub_registry_clear.Rd index 06cfbf3..b6744bd 100644 --- a/man/stub_registry_clear.Rd +++ b/man/stub_registry_clear.Rd @@ -24,3 +24,4 @@ Other stub-registry: \code{\link{StubRegistry}}, \code{\link{remove_request_stub}}, \code{\link{stub_registry}} } +\concept{stub-registry} diff --git a/man/stub_request.Rd b/man/stub_request.Rd index 99f4db8..28298fe 100644 --- a/man/stub_request.Rd +++ b/man/stub_request.Rd @@ -50,13 +50,13 @@ stub_request("get", "https://httpbin.org/get") \%>\% wi_th(headers = list('User-Agent' = 'R')) # request body -stub_request("get", "https://httpbin.org/get") \%>\% +stub_request("post", "https://httpbin.org/post") \%>\% wi_th(body = list(foo = 'bar')) stub_registry() library(crul) x <- crul::HttpClient$new(url = "https://httpbin.org") crul::mock() -x$get('get') +x$post('post', body = list(foo = 'bar')) # add expectation with to_return stub_request("get", "https://httpbin.org/get") \%>\% diff --git a/man/to_return.Rd b/man/to_return.Rd index 7b07766..2a3c004 100644 --- a/man/to_return.Rd +++ b/man/to_return.Rd @@ -33,6 +33,11 @@ Values for status, body, and headers: \item body: various, including character string, list, raw, numeric, etc \item headers: (list) a named list } + +response headers are returned with all lowercase names and the values +are all of type character. if numeric/integer values are given +(e.g., \code{to_return(headers = list(a = 10))}), we'll coerce any +numeric/integer values to character. } \note{ see examples in \code{\link[=stub_request]{stub_request()}} diff --git a/man/webmockr-package.Rd b/man/webmockr-package.Rd index 95f7c0d..fd68675 100644 --- a/man/webmockr-package.Rd +++ b/man/webmockr-package.Rd @@ -14,8 +14,9 @@ Stubbing and setting expectations on HTTP requests \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} +\item Supports multiple HTTP libraries, including \pkg{crul} and +\pkg{httr} +\item Integration with HTTP test caching libraty \pkg{vcr} } } diff --git a/revdep/README.md b/revdep/README.md index 08e5851..ec9f3da 100644 --- a/revdep/README.md +++ b/revdep/README.md @@ -1,29 +1,35 @@ # Platform -|field |value | -|:--------|:----------------------------| -|version |R version 3.5.0 (2018-04-23) | -|os |macOS High Sierra 10.13.4 | -|system |x86_64, darwin15.6.0 | -|ui |X11 | -|language |(EN) | -|collate |en_US.UTF-8 | -|tz |US/Pacific | -|date |2018-05-17 | +|field |value | +|:--------|:-------------------------------------------| +|version |R version 3.5.2 Patched (2018-12-31 r75943) | +|os |macOS Mojave 10.14.2 | +|system |x86_64, darwin15.6.0 | +|ui |X11 | +|language |(EN) | +|collate |en_US.UTF-8 | +|ctype |en_US.UTF-8 | +|tz |US/Pacific | +|date |2019-01-08 | # Dependencies -|package |old |new |Δ | -|:--------|:-----|:-----|:--| -|webmockr |0.2.4 |0.2.6 |* | +|package |old |new |Δ | +|:--------|:-----|:---|:--| +|webmockr |0.2.9 |NA |* | # Revdeps -## All (3) +## All (8) |package |version |error |warning |note | |:--------------------------------|:-------|:-----|:-------|:----| -|[crul](problems.md#crul) |0.5.2 | | |1 | +|crul |0.7.0 | | | | |[HIBPwned](problems.md#hibpwned) |0.1.7 | | |1 | -|[vcr](problems.md#vcr) |0.1.0 | | |1 | +|rdatacite |0.4.0 | | | | +|ritis |0.7.6 | | | | +|rplos |0.8.4 | | | | +|rredlist |0.5.0 | | | | +|[RTD](problems.md#rtd) |0.1.1 | | |1 | +|[vcr](problems.md#vcr) |0.2.0 | | |1 | diff --git a/revdep/check.R b/revdep/check.R index 232f2d0..84f59e6 100644 --- a/revdep/check.R +++ b/revdep/check.R @@ -1,2 +1,2 @@ -library("revdepcheck") -res <- revdep_check() +revdepcheck::revdep_reset() +revdepcheck::revdep_check(num_workers = 2) diff --git a/revdep/problems.md b/revdep/problems.md index 2865ec6..cb92136 100644 --- a/revdep/problems.md +++ b/revdep/problems.md @@ -1,37 +1,38 @@ -# crul +# HIBPwned -Version: 0.5.2 +Version: 0.1.7 ## In both * checking dependencies in R code ... NOTE ``` - Namespace in Imports field not imported from: ‘httpcode’ + Namespaces in Imports field not imported from: + ‘memoise’ ‘ratelimitr’ All declared Imports should be used. ``` -# HIBPwned +# RTD -Version: 0.1.7 +Version: 0.1.1 ## In both * checking dependencies in R code ... NOTE ``` - Namespaces in Imports field not imported from: - ‘memoise’ ‘ratelimitr’ + Namespace in Imports field not imported from: ‘openssl’ All declared Imports should be used. ``` # vcr -Version: 0.1.0 +Version: 0.2.0 ## In both * checking dependencies in R code ... NOTE ``` - Namespace in Imports field not imported from: ‘crul’ + Namespaces in Imports field not imported from: + ‘crul’ ‘httr’ All declared Imports should be used. ``` diff --git a/tests/testthat/test-CrulAdapter.R b/tests/testthat/test-CrulAdapter.R index d193fe6..9acf717 100644 --- a/tests/testthat/test-CrulAdapter.R +++ b/tests/testthat/test-CrulAdapter.R @@ -32,13 +32,14 @@ test_that("build_crul_request/response fail well", { skip_on_cran() expect_error(build_crul_request(), "argument \"x\" is missing") - expect_error(build_crul_response(), "argument \"req\" is missing") + expect_error(build_crul_response(), "argument \"resp\" is missing") }) context("CrulAdapter - with real data") test_that("CrulAdapter works", { skip_on_cran() + skip_if_not_installed('vcr') load("crul_obj.rda") crul_obj$url$handle <- curl::new_handle() @@ -56,7 +57,7 @@ test_that("CrulAdapter works", { unloadNamespace("vcr") expect_error( res$handle_request(crul_obj), - "Real HTTP connections are disabled.\nUnregistered request:\n GET http://localhost:9000/get\n\nYou can stub this request with the following snippet:\n\n stub_request\\('get', uri = 'http://localhost:9000/get'\\)\n============================================================" + "Real HTTP connections are disabled.\nUnregistered request:\n GET: http://localhost:9000/get\n\nYou can stub this request with the following snippet:\n\n stub_request\\('get', uri = 'http://localhost:9000/get'\\)\n============================================================" ) invisible(stub_request("get", "http://localhost:9000/get")) @@ -67,4 +68,84 @@ test_that("CrulAdapter works", { expect_is(aa, "HttpResponse") expect_equal(aa$method, "get") expect_equal(aa$url, "http://localhost:9000/get") + + # no response headers + expect_equal(length(aa$response_headers), 0) + expect_equal(length(aa$response_headers_all), 0) + + + # with headers + # clear registry + stub_registry_clear() + + # stub with headers + x <- stub_request("get", "http://localhost:9000/get") + x <- to_return(x, headers = list('User-Agent' = 'foo-bar')) + + aa <- res$handle_request(crul_obj) + + expect_is(res, "CrulAdapter") + expect_is(aa, "HttpResponse") + expect_equal(aa$method, "get") + expect_equal(aa$url, "http://localhost:9000/get") + + # has response_headers and response_headers_all + expect_equal(length(aa$response_headers), 1) + expect_is(aa$response_headers, "list") + expect_named(aa$response_headers, "user-agent") + expect_equal(length(aa$response_headers_all), 1) + expect_is(aa$response_headers_all, "list") + expect_named(aa$response_headers_all, NULL) + expect_named(aa$response_headers_all[[1]], "user-agent") + + + # stub with redirect headers + my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" + x <- stub_request("get", my_url) + x <- to_return(x, status = 302, headers = + list( + status = 302, + location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" + ) + ) + + crul_obj$url$url <- my_url + res <- CrulAdapter$new() + aa <- res$handle_request(crul_obj) + + expect_equal(aa$method, "get") + expect_equal(aa$url, my_url) + expect_equal(aa$status_code, 302) + + # has response_headers and response_headers_all + expect_equal(length(aa$response_headers), 2) + expect_is(aa$response_headers, "list") + expect_equal(sort(names(aa$response_headers)), c('location', 'status')) + expect_equal(length(aa$response_headers_all), 1) + expect_equal(length(aa$response_headers_all[[1]]), 2) + expect_is(aa$response_headers_all, "list") + expect_is(aa$response_headers_all[[1]], "list") + expect_named(aa$response_headers_all, NULL) + expect_equal(sort(names(aa$response_headers_all[[1]])), + c('location', 'status')) + + ## FIXME: ideally can test multiple redirect headers, e.g. like this: + # x <- stub_request("get", "https://doi.org/10.1007/978-3-642-40455-9_52-1") + # x <- to_return(x, headers = list( + # list( + # status = 'HTTP/1.1 302 ', + # location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" + # ), + # list( + # status = 'HTTP/1.1 301 Moved Permanently', + # location = "https://link.springer.com/10.1007/978-3-642-40455-9_52-1" + # ), + # list( + # status = 'HTTP/1.1 302 Found', + # location = "https://link.springer.com/referenceworkentry/10.1007%2F978-3-642-40455-9_52-1" + # ), + # list( + # status = 'HTTP/1.1 200 OK' + # ) + # )) }) diff --git a/tests/testthat/test-CurlAdapter.R b/tests/testthat/test-CurlAdapter.R new file mode 100644 index 0000000..9c18f7f --- /dev/null +++ b/tests/testthat/test-CurlAdapter.R @@ -0,0 +1,137 @@ +context("CurlAdapter") + +aa <- CurlAdapter$new() + +test_that("CurlAdapter bits are correct", { + skip_on_cran() + + expect_is(CurlAdapter, "R6ClassGenerator") + + expect_is(aa, "CurlAdapter") + expect_null(aa$build_curl_request) # pulled out of object, so should be NULL + expect_null(aa$build_curl_response) # pulled out of object, so should be NULL + expect_is(aa$disable, "function") + expect_is(aa$enable, "function") + expect_is(aa$handle_request, "function") + expect_is(aa$remove_curl_stubs, "function") + expect_is(aa$name, "character") + + expect_equal(aa$name, "curl_adapter") +}) + + +test_that("CurlAdapter behaves correctly", { + skip_on_cran() + + expect_message(aa$enable(), "CurlAdapter enabled!") + expect_message(aa$disable(), "CurlAdapter disabled!") +}) + + +test_that("build_curl_request/response fail well", { + skip_on_cran() + + expect_error(build_curl_request(), "argument \"x\" is missing") + expect_error(build_curl_response(), "argument \"resp\" is missing") +}) + + +context("CurlAdapter - with real data") +test_that("CurlAdapter works", { + skip_on_cran() + # skip_if_not_installed('vcr') # FIXME: not needed until curl supported in vcr + + # load("curl_obj.rda") + # curl_obj$url$handle <- curl::new_handle() + res <- CurlAdapter$new() + curl_obj <- list() + curl_obj$url <- "https://httpbin.org/get?foo=bar" + curl_obj$handle <- curl::new_handle() + curl_obj$called <- "curl_fetch_memoryurl = \"https://httpbin.org/get?foo=bar\"" + curl_obj$method <- "GET" + curl_obj$headers <- list( + accept = "*/*", + 'accept-encoding' = "gzip, deflate", + host = "localhost:9359" + # 'user-agent' = "R (3.5.2 x86_64-apple-darwin15.6.0 x86_64 darwin15.6.0)" + ) + + # with vcr message + # FIXME: not needed until curl supported in vcr + # library(vcr) + # expect_error( + # res$handle_request(curl_obj), + # "There is currently no cassette in use" + # ) + + # with webmockr message + # unload vcr + # unloadNamespace("vcr") + expect_error( + res$handle_request(curl_obj), + "Real HTTP connections are disabled.\nUnregistered request" + ) + + invisible(stub_request("get", "https://httpbin.org/get?foo=bar")) + + aa <- res$handle_request(curl_obj) + + expect_is(res, "CurlAdapter") + expect_is(aa, "list") + expect_equal(aa$url, "https://httpbin.org/get?foo=bar") + + # no response headers + expect_equal(length(aa$headers), 0) + + + # with headers + # clear registry + stub_registry_clear() + + # stub with headers + x <- stub_request("get", "https://httpbin.org/get?foo=bar") + x <- to_return(x, headers = list('User-Agent' = 'foo-bar')) + + aa <- res$handle_request(curl_obj) + + expect_is(res, "CurlAdapter") + expect_is(aa, "list") + expect_equal(aa$url, "https://httpbin.org/get?foo=bar") + expect_equal(aa$status_code, 200) + expect_equal(aa$modified, NA) + expect_equal(length(aa$times), 0) + expect_equal(length(aa$content), 0) + + # has headers + expect_gt(length(aa$headers), 1) + expect_is(aa$headers, "raw") + expect_is(rawToChar(aa$headers), "character") + expect_match(rawToChar(aa$headers), "User-Agent") + expect_match(rawToChar(aa$headers), "foo-bar") + + + # stub with redirect headers + my_url <- "https://doi.org/10.1007/978-3-642-40455-9_52-1" + x <- stub_request("get", my_url) + x <- to_return(x, status = 302, headers = + list( + status = 302, + location = "http://link.springer.com/10.1007/978-3-642-40455-9_52-1" + ) + ) + + curl_obj$url <- my_url + curl_obj$called <- sprintf("curl_fetch_memoryurl = \"%s\"", my_url) + res <- CurlAdapter$new() + aa <- res$handle_request(curl_obj) + + expect_equal(aa$url, my_url) + expect_equal(aa$status_code, 302) + + # has headers + expect_gt(length(aa$headers), 1) + expect_is(aa$headers, "raw") + heads <- rawToChar(aa$headers) + expect_match(heads, 'status') + expect_match(heads, 'location') +}) diff --git a/tests/testthat/test-HttpLibAdapaterRegistry.R b/tests/testthat/test-HttpLibAdapaterRegistry.R index 1fa4ed8..f8a460f 100644 --- a/tests/testthat/test-HttpLibAdapaterRegistry.R +++ b/tests/testthat/test-HttpLibAdapaterRegistry.R @@ -29,6 +29,20 @@ test_that("HttpLibAdapaterRegistry: behaves as expected", { expect_output(print(aa), "crul_adapter") }) +test_that("HttpLibAdapaterRegistry: behaves as expected", { + skip_on_cran() + + aa <- HttpLibAdapaterRegistry$new() + aa$register(HttrAdapter$new()) + + expect_length(aa$adapters, 1) + expect_is(aa$adapters[[1]], "HttrAdapter") + expect_equal(aa$adapters[[1]]$name, "httr_adapter") + + expect_output(print(aa), "HttpLibAdapaterRegistry") + expect_output(print(aa), "httr_adapter") +}) + test_that("HttpLibAdapaterRegistry fails well", { x <- HttpLibAdapaterRegistry$new() diff --git a/tests/testthat/test-RequestPattern.R b/tests/testthat/test-RequestPattern.R index 098c581..c45b2e6 100644 --- a/tests/testthat/test-RequestPattern.R +++ b/tests/testthat/test-RequestPattern.R @@ -20,18 +20,31 @@ test_that("RequestPattern: behaves as expected", { aa <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") rs1 <- RequestSignature$new(method = "get", uri = "https://httpbin.org/get") rs2 <- RequestSignature$new(method = "post", uri = "https://httpbin.org/get") + rs3 <- RequestSignature$new( + method = "get", + uri = "https:/httpbin.org/get", + options = list(headers = list(`User-Agent` = "foobar", stuff = "things")) + ) expect_true(aa$matches(rs1)) expect_false(aa$matches(rs2)) + expect_false(aa$matches(rs3)) expect_is(aa$to_s(), "character") expect_match(aa$to_s(), "GET") expect_match(aa$to_s(), "httpbin.org/get") }) +test_that("RequestPattern: uri_regex", { + x <- RequestPattern$new(method = "get", uri_regex = ".+ossref.org") + expect_is(x$uri_pattern, "UriPattern") + expect_equal(x$uri_pattern$to_s(), "http://.+ossref.org") + expect_equal(x$to_s(), "GET http://.+ossref.org") +}) + test_that("RequestPattern fails well", { + expect_error(RequestPattern$new(), "one of uri or uri_regex is required") x <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get") - expect_error(x$matches(), "argument \"request_signature\" is missing") expect_error(x$matches("adfadf"), "request_signature must be of class RequestSignature") @@ -68,9 +81,91 @@ test_that("HeadersPattern: structure is correct", { expect_named(aa$pattern, "a") expect_true(aa$matches(headers = list(a = 5))) expect_false(aa$matches(headers = list(a = 6))) + expect_false(aa$matches(list())) + + # with pattern empty + bb <- HeadersPattern$new(pattern = list()) + expect_true(bb$matches(list())) expect_error( expect_is(aa$matches(), "function"), "argument \"headers\" is missing" ) + + expect_equal(aa$to_s(), list(a = 5)) +}) + + + +context("BodyPattern") +test_that("BodyPattern: structure is correct", { + expect_is(BodyPattern, "R6ClassGenerator") + + bb <- RequestSignature$new( + method = "get", + uri = "https:/httpbin.org/get", + options = list( + body = list(foo = "bar", a = 5) + ) + ) + + aa <- BodyPattern$new(pattern = list(foo = "bar")) + expect_is(aa, "BodyPattern") + expect_is(aa$pattern, "list") + expect_named(aa$pattern, "foo") + expect_false(aa$matches(bb$body)) + + aaa <- BodyPattern$new(pattern = list(foo = "bar", a = 5)) + expect_true(aaa$matches(bb$body)) + + # with pattern empty + bb <- BodyPattern$new(pattern = list()) + expect_true(bb$matches(list())) + + expect_error( + aa$matches(), + "argument \"body\" is missing" + ) + + expect_equal(aa$to_s(), list(foo = "bar")) +}) + + + +context("UriPattern") +test_that("UriPattern: structure is correct", { + expect_is(UriPattern, "R6ClassGenerator") + + aa <- UriPattern$new(pattern = "http://foobar.com") + + expect_is(aa, "UriPattern") + expect_is(aa$pattern, "character") + expect_false(aa$regex) + expect_match(aa$pattern, "foobar") + # matches w/o slash + expect_true(aa$matches("http://foobar.com")) + # and matches w/ slash + expect_true(aa$matches("http://foobar.com/")) + + # fails well + expect_error( + expect_is(aa$matches(), "function"), + "argument \"uri\" is missing" + ) + + # regex usage + z <- UriPattern$new(regex_pattern = ".+ample\\..") + + expect_is(z, "UriPattern") + expect_is(z$pattern, "character") + expect_true(z$regex) + expect_true(z$matches("http://sample.org")) + expect_true(z$matches("http://example.com")) + expect_false(z$matches("http://tramples.net")) + + # add query params usage + z <- UriPattern$new(pattern = "http://foobar.com") + expect_equal(z$pattern, "http://foobar.com") + z$add_query_params(list(pizza = "cheese", cheese = "cheddar")) + expect_equal(z$pattern, "http://foobar.com?pizza=cheese&cheese=cheddar") }) diff --git a/tests/testthat/test-RequestSignature.R b/tests/testthat/test-RequestSignature.R index 810b090..b127d92 100644 --- a/tests/testthat/test-RequestSignature.R +++ b/tests/testthat/test-RequestSignature.R @@ -19,7 +19,7 @@ test_that("RequestSignature: works", { expect_equal(aa$uri, "https:/httpbin.org/get") expect_is(aa$to_s, "function") - expect_equal(aa$to_s(), "GET https:/httpbin.org/get") + expect_equal(aa$to_s(), "GET: https:/httpbin.org/get") }) test_that("RequestSignature: different methods work", { diff --git a/tests/testthat/test-Response.R b/tests/testthat/test-Response.R index 10e4735..83444a6 100644 --- a/tests/testthat/test-Response.R +++ b/tests/testthat/test-Response.R @@ -26,6 +26,7 @@ test_that("Response: bits are correct prior to having data", { expect_null(aa$request_headers) expect_null(aa$response_headers) + expect_null(aa$response_headers_all) expect_equal(aa$status_code, 200) expect_null(aa$url) expect_null(aa$name) @@ -49,6 +50,8 @@ test_that("Response: bits are correct after having data", { expect_named(aa$request_headers, "Content-Type") expect_is(aa$response_headers, "list") expect_named(aa$response_headers, "Host") + # response_headers_all doesn't exist in Response, it's specific to crul + expect_null(aa$response_headers_all) expect_equal(aa$status_code, 404) expect_equal(aa$url, "https://httpbin.org/get") diff --git a/tests/testthat/test-StubbedRequest.R b/tests/testthat/test-StubbedRequest.R index 2407bda..1cbf868 100644 --- a/tests/testthat/test-StubbedRequest.R +++ b/tests/testthat/test-StubbedRequest.R @@ -26,7 +26,7 @@ test_that("StubbedRequest: works", { 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") + expect_equal(aa$to_s(), "GET: https:/httpbin.org/get") # with expect_is(aa$with, "function") diff --git a/tests/testthat/test-flipswitch.R b/tests/testthat/test-flipswitch.R index 0626f03..e8e0b90 100644 --- a/tests/testthat/test-flipswitch.R +++ b/tests/testthat/test-flipswitch.R @@ -9,21 +9,64 @@ test_that("flipswitch in default state", { test_that("flipswitch - turn on with 'enable'", { aa <- enable() + expect_is(aa, "logical") + expect_equal(length(aa), 3) + expect_true(all(aa)) + + expect_true(webmockr_lightswitch$crul) + expect_true(webmockr_lightswitch$curl) + skip_if_not_installed("httr") + expect_true(webmockr_lightswitch$httr) +}) + +test_that("flipswitch - turn on with 'enable' - one pkg", { + # disable all + disable() + + # enable one pkg + aa <- enable('crul') + expect_is(aa, "logical") expect_equal(length(aa), 1) + expect_true(aa) expect_true(webmockr_lightswitch$crul) + skip_if_not_installed("httr") + expect_false(webmockr_lightswitch$httr) }) test_that("flipswitch - turn off with 'disable'", { aa <- disable() - expect_false(aa) + # all are FALSE + expect_true(!all(aa)) expect_false(webmockr_lightswitch$crul) + skip_if_not_installed("httr") + expect_false(webmockr_lightswitch$httr) }) test_that("enable and disable fail well", { - expect_error(enable(a = 5), "unused argument") - expect_error(disable(a = 5), "unused argument") + expect_error(enable(wasp = 5), "unused argument") + expect_error(disable(bee = 5), "unused argument") + + expect_error(enable(adapter = 'stuff'), + "adapter must be one of") + expect_error(disable(adapter = 'stuff'), + "adapter must be one of") + + # FIXME: not sure how to test when pkg not installed + # inside of test suite +}) + +test_that("enabled works", { + # disable all + disable() + + expect_false(enabled()) + expect_false(enabled('crul')) + expect_false(enabled('httr')) + expect_false(enabled('curl')) + + expect_error(enabled('foobar'), "'adapter' must be in the set") }) diff --git a/tests/testthat/test-no-cassette-in-use.R b/tests/testthat/test-no-cassette-in-use.R index ca76936..ae3b164 100644 --- a/tests/testthat/test-no-cassette-in-use.R +++ b/tests/testthat/test-no-cassette-in-use.R @@ -1,10 +1,11 @@ context("no_cassette_in_use") -library(vcr) -dir <- tempdir() -invisible(vcr_configure(dir = dir)) - test_that("no cassette in use behaves as expected", { + skip_if_not_installed('vcr') + library(vcr) + dir <- tempdir() + invisible(vcr_configure(dir = dir)) + crul::mock() x <- crul::HttpClient$new(url = "https://httpbin.org") @@ -13,14 +14,13 @@ test_that("no cassette in use behaves as expected", { x$get("get"), "There is currently no cassette in use" ) -}) + # cleanup + unlink(file.path(vcr_configuration()$dir, "turtle.yml")) -# cleanup -unlink(file.path(vcr_configuration()$dir, "turtle.yml")) + # reset configuration + vcr_configure_reset() -# reset configuration -vcr_configure_reset() - -# unload vcr -unloadNamespace("vcr") + # unload vcr + unloadNamespace("vcr") +}) diff --git a/tests/testthat/test-onload.R b/tests/testthat/test-onload.R new file mode 100644 index 0000000..58446f7 --- /dev/null +++ b/tests/testthat/test-onload.R @@ -0,0 +1,16 @@ +context("onload") + +test_that("onload: http_lib_adapter_registry", { + expect_is(http_lib_adapter_registry, "HttpLibAdapaterRegistry") + expect_is(http_lib_adapter_registry, "R6") + expect_equal(sort(ls(envir=http_lib_adapter_registry)), + c('adapters', 'clone', 'print', 'register')) + expect_is(http_lib_adapter_registry$adapters, "list") + expect_is(http_lib_adapter_registry$adapters[[1]], + "CrulAdapter") + expect_is(http_lib_adapter_registry$adapters[[2]], + "HttrAdapter") + expect_is(http_lib_adapter_registry$clone, "function") + expect_is(http_lib_adapter_registry$print, "function") + expect_is(http_lib_adapter_registry$register, "function") +}) diff --git a/tests/testthat/test-remove_request_stub.R b/tests/testthat/test-remove_request_stub.R new file mode 100644 index 0000000..087d12e --- /dev/null +++ b/tests/testthat/test-remove_request_stub.R @@ -0,0 +1,23 @@ +context("remove_request_stub") + +# clear stubs before starting +stub_registry_clear() + +test_that("remove_request_stub", { + # no stubs at beginning + expect_equal(length(stub_registry()$request_stubs), 0) + + # make a stub + x <- stub_request("get", "https://httpbin.org/get") + + # no there's a stub + expect_equal(length(stub_registry()$request_stubs), 1) + + # remove the stub + w <- remove_request_stub(x) + expect_is(w, "list") + expect_equal(length(w), 0) + + # no there's no stubs + expect_equal(length(stub_registry()$request_stubs), 0) +}) diff --git a/tests/testthat/test-request_registry.R b/tests/testthat/test-request_registry.R new file mode 100644 index 0000000..89b1d59 --- /dev/null +++ b/tests/testthat/test-request_registry.R @@ -0,0 +1,27 @@ +context("request_registry") + +test_that("request_registry: structure", { + expect_is(request_registry, "function") + expect_is(request_registry(), "RequestRegistry") + + enable() + stub_request("get", "https://httpbin.org/get") %>% + to_return(body = "success!", status = 200) + invisible( + crul::HttpClient$new(url = "https://httpbin.org")$get("get") + ) + disable() + + x <- request_registry() + expect_is(x, "RequestRegistry") + expect_is(x$clone, "function") + expect_is(x$print, "function") + expect_is(x$register_request, "function") + expect_null(x$request) + expect_is(x$request_signatures, "HashCounter") + expect_is(x$reset, "function") + + expect_is(x$request_signatures$hash, "list") + expect_match(names(x$request_signatures$hash), "GET") + expect_is(x$request_signatures$hash[[1]], 'numeric') +}) diff --git a/tests/testthat/test-stub_request.R b/tests/testthat/test-stub_request.R index 7315129..3602fd4 100644 --- a/tests/testthat/test-stub_request.R +++ b/tests/testthat/test-stub_request.R @@ -31,7 +31,7 @@ test_that("stub_request bits are correct", { 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_equal(aa$to_s(), "GET: https://httpbin.org/get") expect_is(aa$with, "function") expect_null(aa$with()) diff --git a/tests/testthat/test-to_return.R b/tests/testthat/test-to_return.R index 695ac50..057a109 100644 --- a/tests/testthat/test-to_return.R +++ b/tests/testthat/test-to_return.R @@ -1,5 +1,4 @@ -context("to_return") - +context("to_return: works as expected") stub_registry()$remove_all_request_stubs() test_that("no stubs exist before stub_request called", { @@ -51,3 +50,95 @@ test_that("stub_request fails well", { expect_error(to_return(zzz, headers = list(5, 6)), "'headers' must be a named list") expect_error(to_return(zzz, headers = list(a = 5, 6)), "'headers' must be a named list") }) + + +stub_registry_clear() +enable() +context("to_return: response headers returned all lowercase") +test_that("to_return (response) headers are all lowercase, crul", { + stub <- stub_request(uri = "http://httpbin.org/get") %>% + to_return(headers = list("Foo-Bar" = "baz")) + cli <- crul::HttpClient$new(url = "http://httpbin.org/") + x <- cli$get("get") + + expect_is(x$response_headers, "list") + expect_named(x$response_headers, "foo-bar") +}) + +stub_registry_clear() +test_that("to_return (response) headers are all lowercase, httr", { + loadNamespace("httr") + stub <- stub_request(uri = "http://httpbin.org/get") %>% + to_return(headers = list("Foo-Bar" = "baz")) + x <- httr::GET("http://httpbin.org/get") + + expect_is(x$headers, "list") + expect_named(x$headers, "foo-bar") +}) +disable() + + + +stub_registry_clear() +enable() +context("to_return: response header values are all character") +test_that("to_return response header values are all character, crul", { + cli <- crul::HttpClient$new(url = "http://httpbin.org/") + + stub_request(uri = "http://httpbin.org/get") %>% + to_return(headers = list("Foo-Bar" = 10)) + x <- cli$get("get") + + expect_is(x$response_headers, "list") + expect_named(x$response_headers, "foo-bar") + expect_is(x$response_headers$`foo-bar`, "character") + expect_equal(x$response_headers$`foo-bar`, "10") + + stub_registry_clear() + stub_request(uri = "http://httpbin.org/get") %>% + to_return(headers = list( + a = 10, b = 234233434, c = 2344.342342, + d = "brown", e = as.factor("blue") + )) + z <- cli$get("get") + + expect_is(z$response_headers, "list") + expect_named(z$response_headers, letters[1:5]) + invisible( + vapply(z$response_headers, function(z) expect_is(z, "character"), "") + ) + expect_equal(z$response_headers$c, "2344.342342") + expect_equal(z$response_headers$e, "blue") +}) + +stub_registry_clear() + +test_that("to_return response header values are all character, httr", { + loadNamespace("httr") + + stub_request(uri = "http://httpbin.org/get") %>% + to_return(headers = list("Foo-Bar" = 10)) + x <- httr::GET("http://httpbin.org/get") + + expect_is(x$headers, "list") + expect_named(x$headers, "foo-bar") + expect_is(x$headers$`foo-bar`, "character") + expect_equal(x$headers$`foo-bar`, "10") + + stub_registry_clear() + stub_request(uri = "http://httpbin.org/get") %>% + to_return(headers = list( + a = 10, b = 234233434, c = 2344.342342, + d = "brown", e = as.factor("blue") + )) + z <- httr::GET("http://httpbin.org/get") + + expect_is(z$headers, "list") + expect_named(z$headers, letters[1:5]) + invisible( + vapply(z$headers, function(z) expect_is(z, "character"), "") + ) + expect_equal(z$headers$c, "2344.342342") + expect_equal(z$headers$e, "blue") +}) +disable() diff --git a/tests/testthat/test-zutils.R b/tests/testthat/test-zutils.R index 0e4d80b..917dc88 100644 --- a/tests/testthat/test-zutils.R +++ b/tests/testthat/test-zutils.R @@ -179,3 +179,12 @@ test_that("hdl_lst2 works", { expect_equal(hdl_lst2(1.5), 1.5) }) + +context("query_mapper") +test_that("query_mapper", { + expect_is(query_mapper, "function") + expect_null(query_mapper(NULL)) + expect_equal(query_mapper(5), 5) + expect_equal(query_mapper('aaa'), 'aaa') + expect_equal(query_mapper(mtcars), mtcars) +}) diff --git a/webmockr.Rproj b/webmockr.Rproj index 398aa14..21a4da0 100644 --- a/webmockr.Rproj +++ b/webmockr.Rproj @@ -9,12 +9,9 @@ UseSpacesForTab: Yes NumSpacesForTab: 2 Encoding: UTF-8 -RnwWeave: knitr +RnwWeave: Sweave LaTeX: pdfLaTeX -AutoAppendNewline: Yes -StripTrailingWhitespace: Yes - BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source