Merge branch 'main' into httr2

tests/testthat/helper-webmockr.R

@@ -16,3 +16,6 @@ re_escape <- function(strings){
   }
   strings
 }
+
+base_url = "https://hb.opencpu.org"
+hb <- function(x = NULL) if (is.null(x)) base_url else paste0(base_url, x)

tests/testthat/test-CrulAdapter.R

@@ -45,11 +45,11 @@ test_that("CrulAdapter: works when vcr is loaded but no cassette is inserted", {
     unloadNamespace("vcr")
   })
 
-  stub_request("get", "https://httpbin.org/get")
+  stub_request("get", hb("/get"))
   library("vcr")
 
   # works when no cassette is loaded
-  cli <- crul::HttpClient$new("https://httpbin.org")
+  cli <- crul::HttpClient$new(hb())
 
   expect_silent(x <- cli$get("get"))
   expect_is(x, "HttpResponse")
@@ -183,7 +183,7 @@ test_that("crul requests with JSON-encoded bodies work", {
   enable(adapter = "crul")
 
   body <- list(foo = "bar")
-  url <- "https://httpbin.org"
+  url <- hb()
 
   cli <- crul::HttpClient$new(url)
 

tests/testthat/test-HashCounter.R

@@ -16,7 +16,7 @@ test_that("HashCounter: structure", {
 test_that("HashCounter: works as expected", {
   x <- HashCounter$new()
 
-  a <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get")
+  a <- RequestSignature$new(method = "get", uri = hb("/get"))
   b <- RequestSignature$new(method = "post", uri = "https://www.wikipedia.org/")
 
   x$put(a)

tests/testthat/test-HttrAdapter.R

@@ -48,23 +48,23 @@ test_that("HttrAdapter: works when vcr is loaded but no cassette is inserted", {
     unloadNamespace("vcr")
   })
 
-  stub_request("get", "https://httpbin.org/get")
+  stub_request("get", hb("/get"))
   library("vcr")
 
   # works when no cassette is loaded
-  expect_silent(x <- httr::GET("https://httpbin.org/get"))
+  expect_silent(x <- httr::GET(hb("/get")))
   expect_is(x, "response")
 
   # # works when empty cassette is loaded
   vcr::vcr_configure(dir = tempdir())
   vcr::insert_cassette("empty")
-  expect_silent(x <- httr::GET("https://httpbin.org/get"))
+  expect_silent(x <- httr::GET(hb("/get")))
   vcr::eject_cassette("empty")
   expect_is(x, "response")
 })
 
 # library(httr)
-# z <- GET("https://httpbin.org/get")
+# z <- GET(hb("/get"))
 # httr_obj <- z$request
 # save(httr_obj, file = "tests/testthat/httr_obj.rda")
 
@@ -76,12 +76,12 @@ test_that("HttrAdapter date slot works", {
 
   path <- file.path(tempdir(), "foobar")
   vcr::vcr_configure(dir = path)
-  vcr::use_cassette("test-date", httr::GET("https://httpbin.org/get"))
+  vcr::use_cassette("test-date", httr::GET(hb("/get")))
   # list.files(path)
   # readLines(file.path(path, "test-date.yml"))
   vcr::insert_cassette("test-date")
 
-  x <- httr::GET("https://httpbin.org/get")
+  x <- httr::GET(hb("/get"))
 
   # $date is of correct format
   expect_output(print(x), "Date")
@@ -106,12 +106,12 @@ test_that("HttrAdapter insensitive headers work, webmockr flow", {
   unloadNamespace("vcr")
   httr_mock()
   stub_registry_clear()
-  invisible(stub_request("get", uri = "https://httpbin.org/get") %>%
+  invisible(stub_request("get", uri = hb("/get")) %>%
       to_return(
         body = list(foo = "bar"),
         headers = list("Content-Type" = "application/json")
       ))
-  x <- httr::GET("https://httpbin.org/get")
+  x <- httr::GET(hb("/get"))
 
   expect_equal(x$headers[["content-type"]], "application/json")
   expect_is(httr::content(x), "list")
@@ -129,10 +129,10 @@ test_that("HttrAdapter insensitive headers work, vcr flow", {
 
   path <- file.path(tempdir(), "helloworld")
   vcr::vcr_configure(dir = path)
-  vcr::use_cassette("test-date", GET("https://httpbin.org/get"))
+  vcr::use_cassette("test-date", GET(hb("/get")))
   vcr::insert_cassette("test-date")
 
-  x <- httr::GET("https://httpbin.org/get")
+  x <- httr::GET(hb("/get"))
 
   expect_equal(x$headers[["content-type"]], "application/json")
   expect_is(httr::content(x), "list")
@@ -167,17 +167,17 @@ test_that("HttrAdapter works", {
   unloadNamespace("vcr")
   expect_error(
     res$handle_request(httr_obj),
-    "Real HTTP connections are disabled.\nUnregistered request:\n  GET:  https://httpbin.org/get"
+    "Real HTTP connections are disabled.\nUnregistered request:\n  GET:  https://hb.opencpu.org/get"
   )
 
-  invisible(stub_request("get", "https://httpbin.org/get"))
+  invisible(stub_request("get", hb("/get")))
 
   aa <- res$handle_request(httr_obj)
 
   expect_is(res, "HttrAdapter")
   expect_is(aa, "response")
   expect_equal(aa$request$method, "GET")
-  expect_equal(aa$url, "https://httpbin.org/get")
+  expect_equal(aa$url, hb("/get"))
 
   # no response headers
   expect_equal(length(aa$headers), 0)
@@ -189,15 +189,15 @@ test_that("HttrAdapter works", {
   stub_registry_clear()
 
   # stub with headers
-  x <- stub_request("get", "https://httpbin.org/get")
+  x <- stub_request("get", hb("/get"))
   x <- to_return(x, headers = list("User-Agent" = "foo-bar"))
 
   aa <- res$handle_request(httr_obj)
 
   expect_is(res, "HttrAdapter")
   expect_is(aa, "response")
   expect_equal(aa$request$method, "GET")
-  expect_equal(aa$url, "https://httpbin.org/get")
+  expect_equal(aa$url, hb("/get"))
 
   # has headers and all_headers
   expect_equal(length(aa$headers), 1)
@@ -250,7 +250,7 @@ test_that("HttrAdapter works with httr::authenticate", {
   stub_registry_clear()
   # stub_registry()
   # request_registry()
-  z <- stub_request("get", uri = "https://httpbin.org/basic-auth/foo/bar") %>%
+  z <- stub_request("get", uri = hb("/basic-auth/foo/bar")) %>%
       to_return(
         body = list(foo = "bar"),
         headers = list("Content-Type" = "application/json")
@@ -264,7 +264,7 @@ test_that("HttrAdapter works with httr::authenticate", {
   # mocked httr requests with auth work
   # before the fixes in HttrAdapter: a real request through webmockr would
   #   not work with authenticate
-  x <- httr::GET("https://httpbin.org/basic-auth/foo/bar", httr::authenticate("foo", "bar"))
+  x <- httr::GET(hb("/basic-auth/foo/bar"), httr::authenticate("foo", "bar"))
   expect_is(x, "response")
   expect_equal(httr::content(x), list(foo = "bar"))
   expect_equal(x$headers, structure(list(`content-type` = "application/json"),
@@ -287,24 +287,24 @@ test_that("httr works with webmockr_allow_net_connect", {
 
   httr_mock()
   stub_registry_clear()
-  z <- stub_request("get", uri = "https://httpbin.org/get?stuff=things") %>%
+  z <- stub_request("get", uri = hb("/get?stuff=things")) %>%
     to_return(body = "yum=cheese")
-  x <- httr::GET("https://httpbin.org/get?stuff=things")
+  x <- httr::GET(hb("/get?stuff=things"))
   expect_true(httr::content(x, "text", encoding="UTF-8") == "yum=cheese")
 
   # allow net connect - stub still exists though - so not a real request
   webmockr_allow_net_connect()
-  z <- httr::GET("https://httpbin.org/get?stuff=things")
+  z <- httr::GET(hb("/get?stuff=things"))
   expect_true(httr::content(z, "text", encoding="UTF-8") == "yum=cheese")
 
   # allow net connect - stub now gone - so real request should happen
   stub_registry_clear()
-  w <- httr::GET("https://httpbin.org/get?stuff=things")
+  w <- httr::GET(hb("/get?stuff=things"))
   expect_false(httr::content(w, "text", encoding="UTF-8") == "yum=cheese")
 
   # disable net connect - now real requests can't be made
   webmockr_disable_net_connect()
-  expect_error(httr::GET("https://httpbin.org/get?stuff=things"),
+  expect_error(httr::GET(hb("/get?stuff=things")),
     "Real HTTP connections are disabled")
 })
 
@@ -313,15 +313,15 @@ test_that("httr requests with bodies work", {
 
   httr_mock()
   stub_registry_clear()
-  z <- stub_request("post", uri = "https://httpbin.org/post") %>%
+  z <- stub_request("post", uri = hb("/post")) %>%
     to_return(body = "asdffsdsdf")
-  x <- httr::POST("https://httpbin.org/post", body = list(stuff = "things"))
+  x <- httr::POST(hb("/post"), body = list(stuff = "things"))
   expect_true(httr::content(x, "text", encoding="UTF-8") == "asdffsdsdf")
 
   # now with allow net connect
   stub_registry_clear()
   webmockr_allow_net_connect()
-  x <- httr::POST("https://httpbin.org/post", body = list(stuff = "things"))
+  x <- httr::POST(hb("/post"), body = list(stuff = "things"))
   expect_identical(httr::content(x)$form, list(stuff = "things"))
 
   webmockr_disable_net_connect()
@@ -333,16 +333,16 @@ test_that("httr requests with nested list bodies work", {
   httr_mock()
   stub_registry_clear()
   body = list(id = ' ', method = 'x', params = list(pwd = 'p', user = 'a'))
-  z <- stub_request("post", uri = "https://httpbin.org/post") %>%
+  z <- stub_request("post", uri = hb("/post")) %>%
     wi_th(body = body) %>%
     to_return(body = "asdffsdsdf")
-  x <- httr::POST("https://httpbin.org/post", body = body)
+  x <- httr::POST(hb("/post"), body = body)
   expect_true(httr::content(x, "text", encoding="UTF-8") == "asdffsdsdf")
 
   # now with allow net connect
   stub_registry_clear()
   webmockr_allow_net_connect()
-  x <- httr::POST("https://httpbin.org/post",
+  x <- httr::POST(hb("/post"),
     body = jsonlite::toJSON(body), httr::content_type_json())
   expect_equal(
     jsonlite::fromJSON(rawToChar(x$content))$json,
@@ -359,22 +359,22 @@ test_that("httr requests with JSON-encoded bodies work", {
 
   stub_registry_clear()
   body <- list(foo = "bar")
-  z <- stub_request("post", uri = "https://httpbin.org/post") %>%
+  z <- stub_request("post", uri = hb("/post")) %>%
     wi_th(body = jsonlite::toJSON(body, auto_unbox = TRUE))
 
   # encoded body works
-  res <- httr::POST("https://httpbin.org/post", body = body, encode = "json")
+  res <- httr::POST(hb("/post"), body = body, encode = "json")
   expect_is(res, "response")
 
   # encoded but modified body fails
   expect_error(
-    httr::POST("https://httpbin.org/post", body = list(foo = "bar1"), encode = "json"),
+    httr::POST(hb("/post"), body = list(foo = "bar1"), encode = "json"),
     "Unregistered request"
   )
 
   # unencoded body fails
   expect_error(
-    httr::POST("https://httpbin.org/post", body = body),
+    httr::POST(hb("/post"), body = body),
     "Unregistered request"
   )
 })

tests/testthat/test-RequestPattern.R

@@ -3,7 +3,7 @@ context("RequestPattern")
 test_that("RequestPattern: structure is correct", {
   expect_is(RequestPattern, "R6ClassGenerator")
 
-  aa <- RequestPattern$new(method = "get", uri = "https://httpbin.org/get")
+  aa <- RequestPattern$new(method = "get", uri = hb("/get"))
 
   expect_is(aa, "RequestPattern")
   expect_null(aa$body_pattern)
@@ -17,12 +17,12 @@ test_that("RequestPattern: structure is correct", {
 })
 
 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")
+  aa <- RequestPattern$new(method = "get", uri = hb("/get"))
+  rs1 <- RequestSignature$new(method = "get", uri = hb("/get"))
+  rs2 <- RequestSignature$new(method = "post", uri = hb("/get"))
   rs3 <- RequestSignature$new(
     method = "get",
-    uri = "https:/httpbin.org/get",
+    uri = "https:/hb.opencpu.org",
     options = list(headers = list(`User-Agent` = "foobar", stuff = "things"))
   )
 
@@ -32,7 +32,7 @@ test_that("RequestPattern: behaves as expected", {
 
   expect_is(aa$to_s(), "character")
   expect_match(aa$to_s(), "GET")
-  expect_match(aa$to_s(), "httpbin.org/get")
+  expect_match(aa$to_s(), "hb.opencpu.org/get")
 })
 
 test_that("RequestPattern: uri_regex", {
@@ -44,7 +44,7 @@ test_that("RequestPattern: uri_regex", {
 
 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")
+  x <- RequestPattern$new(method = "get", uri = hb("/get"))
   expect_error(x$matches(), "argument \"request_signature\" is missing")
   expect_error(x$matches("adfadf"),
                "request_signature must be of class RequestSignature")
@@ -103,7 +103,7 @@ test_that("BodyPattern: structure is correct", {
 
   bb <- RequestSignature$new(
     method = "get",
-    uri = "https:/httpbin.org/get",
+    uri = hb("/get"),
     options = list(
       body = list(foo = "bar", a = 5)
     )

tests/testthat/test-RequestSignature.R

@@ -3,7 +3,7 @@ context("RequestSignature")
 test_that("RequestSignature: works", {
   expect_is(RequestSignature, "R6ClassGenerator")
 
-  aa <- RequestSignature$new(method = "get", uri = "https:/httpbin.org/get")
+  aa <- RequestSignature$new(method = "get", uri = hb("/get"))
 
   expect_is(aa, "RequestSignature")
 
@@ -18,14 +18,14 @@ test_that("RequestSignature: works", {
   expect_equal(aa$method, "get")
 
   expect_is(aa$uri, "character")
-  expect_equal(aa$uri, "https:/httpbin.org/get")
+  expect_equal(aa$uri, hb("/get"))
 
   expect_is(aa$to_s, "function")
-  expect_equal(aa$to_s(), "GET:  https:/httpbin.org/get")
+  expect_equal(aa$to_s(), "GET:  https://hb.opencpu.org/get")
 })
 
 test_that("RequestSignature: different methods work", {
-  aa <- RequestSignature$new(method = "post", uri = "https:/httpbin.org/post",
+  aa <- RequestSignature$new(method = "post", uri = hb("/post"),
     options = list(fields = list(foo = "bar")))
   aa$headers <- list(Accept = "application/json")
   aa$body <- list(foo = "bar")

tests/testthat/test-Response.R

@@ -35,9 +35,9 @@ test_that("Response: bits are correct prior to having data", {
 
 test_that("Response: bits are correct after having data", {
   aa <- Response$new()
-  aa$set_url("https://httpbin.org/get")
+  aa$set_url(hb("/get"))
   aa$set_request_headers(list('Content-Type' = "application/json"))
-  aa$set_response_headers(list('Host' = "httpbin.org"))
+  aa$set_response_headers(list('Host' = "hb.opencpu.org"))
   aa$set_status(404)
   aa$set_body("hello world")
   aa$set_exception("exception")
@@ -54,7 +54,7 @@ test_that("Response: bits are correct after having data", {
   expect_null(aa$response_headers_all)
 
   expect_equal(aa$status_code, 404)
-  expect_equal(aa$url, "https://httpbin.org/get")
+  expect_equal(aa$url, hb("/get"))
   expect_null(aa$name)
 
   expect_equal(aa$body, "hello world")
@@ -63,9 +63,9 @@ test_that("Response: bits are correct after having data", {
   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_respone_headers()[[1]], "hb.opencpu.org")
   expect_equal(aa$get_status(), 404)
-  expect_equal(aa$get_url(), "https://httpbin.org/get")
+  expect_equal(aa$get_url(), hb("/get"))
 
   expect_output(aa$print(), "<webmockr response>")
   expect_output(aa$print(), "headers")

tests/testthat/test-StubRegistry.R

@@ -31,7 +31,7 @@ test_that("StubRegistry: bits are correct after having data", {
   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")
+  stub2 <- StubbedRequest$new(method = "get", uri = hb())
 
   aa <- StubRegistry$new()
   expect_is(aa$register_stub(stub = stub1), "list")