skip_on_cran()
skip_if_offline(url_parse(hb())$domain)
context("Async - General")
test_that("Async works", {
expect_is(Async, "R6ClassGenerator")
aa <- Async$new(urls = c(hb('/get'), 'https://google.com'))
expect_is(aa, "Async")
expect_null(aa$handle)
expect_is(aa$urls, "character")
expect_equal(length(aa$urls), 2)
expect_is(aa$.__enclos_env__$private$gen_interface, "function")
expect_is(aa$get, "function")
expect_is(aa$post, "function")
expect_is(aa$put, "function")
expect_is(aa$patch, "function")
expect_is(aa$delete, "function")
expect_is(aa$head, "function")
# after calling
res <- aa$get()
expect_is(res, "asyncresponses")
expect_equal(length(res), 2)
expect_is(res[[1]], "HttpResponse")
expect_is(res[[1]]$request, "HttpRequest")
expect_is(res[[1]]$content, "raw")
})
test_that("Async fails well", {
expect_error(Async$new(), "\"urls\" is missing, with no default")
})
test_that("Async print method", {
aa <- Async$new(urls = c(hb('/get'), 'https://google.com'))
expect_is(aa, "Async")
expect_is(aa$print, "function")
expect_output(aa$print(), "crul async connection")
expect_output(aa$print(), "curl options")
expect_output(aa$print(), "proxies")
expect_output(aa$print(), "auth")
expect_output(aa$print(), "headers")
expect_output(aa$print(), "urls:")
expect_output(aa$print(), hb('/get'))
expect_output(aa$print(), 'https://google.com')
# > 10 urls
aa <- Async$new(urls = rep(hb('/get'), 12))
expect_output(aa$print(), "# ... with")
expect_output(aa$print(), hb('/get'))
})
test_that("Async curl options work", {
skip_on_ci() # not sure why, but not working on CI
aa <- Async$new(urls = c(hb('/get'), 'https://google.com'),
opts = list(timeout_ms = 100))
expect_output(aa$print(), "curl options")
expect_output(aa$print(), "timeout_ms: 100")
expect_equal(vapply(aa$get(), "[[", 1, "status_code"), c(0, 0))
})
test_that("Async headers work", {
aa <- Async$new(urls = c(hb('/get'), 'https://google.com'),
headers = list(foo = "bar"))
expect_output(aa$print(), "headers")
expect_output(aa$print(), "foo: bar")
bb <- aa$get()
expect_equal(vapply(bb, function(x) x$request_headers[[1]], ""),
c("bar", "bar"))
})
context("Async - get")
test_that("Async - get", {
aa <- Async$new(urls = c(hb('/get'),
'https://google.com'))
out <- aa$get()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "get")
expect_equal(out[[2]]$method, "get")
})
context("Async - post")
test_that("Async - post", {
aa <- Async$new(urls = c(hb('/post'),
hb('/post')))
out <- aa$post()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_equal(out[[1]]$method, "post")
})
context("Async - put")
test_that("Async - put", {
aa <- Async$new(urls = c(hb('/put'),
hb('/put')))
out <- aa$put()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "put")
expect_equal(out[[2]]$method, "put")
})
context("Async - patch")
test_that("Async - patch", {
aa <- Async$new(urls = c(hb('/patch'),
hb('/patch')))
out <- aa$patch()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "patch")
expect_equal(out[[2]]$method, "patch")
})
context("Async - delete")
test_that("Async - delete", {
aa <- Async$new(urls = c(hb('/delete'),
hb('/delete')))
out <- aa$delete()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "delete")
expect_equal(out[[2]]$method, "delete")
})
context("Async - head")
test_that("Async - head", {
aa <- Async$new(urls = c('https://google.com',
'https://nytimes.com'))
out <- aa$head()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "head")
expect_equal(out[[2]]$method, "head")
})
context("Async - verb")
test_that("Async - verb", {
aa <- Async$new(urls = c('https://google.com',
'https://nytimes.com'))
out <- aa$verb('get')
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "get")
expect_equal(out[[2]]$method, "get")
})
context("Async - verb")
test_that("Async - retry", {
aa <- Async$new(urls = c("https://nghttp2.org/httpbin/status/404",
"https://nghttp2.org/httpbin/status/429"))
out <- aa$retry(verb='get')
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_equal(out[[1]]$method, "get")
expect_equal(out[[2]]$method, "get")
expect_gt(length(out[[1]]$response_headers_all), 3)
expect_gt(length(out[[2]]$response_headers_all), 3)
})
context("Async - order of results")
test_that("Async - order", {
aa <- Async$new(urls = c(hb('/get?a=5'),
hb('/get?b=6'),
hb('/get?c=7')))
out <- aa$get()
expect_is(out, "asyncresponses")
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_is(out[[3]], "HttpResponse")
expect_match(out[[1]]$url, "a=5")
expect_match(out[[2]]$url, "b=6")
expect_match(out[[3]]$url, "c=7")
})
context("Async - disk w/ GET")
test_that("Async - writing to disk works", {
cc <- Async$new(
urls = c(
hb('/get?a=5'),
hb('/get?foo=bar'),
hb('/get?b=4'),
hb('/get?stuff=things'),
hb('/get?b=4&g=7&u=9&z=1')
)
)
files <- replicate(5, tempfile())
res <- cc$get(disk = files)
out <- lapply(files, readLines)
# cleanup
closeAllConnections()
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(out, "list")
expect_is(out[[1]], "character")
})
context("Async - disk w/ POST")
test_that("Async - writing to disk works", {
post_url <- hb('/post')
cc <- Async$new(urls = rep(post_url, 5))
files <- replicate(5, tempfile())
res <- cc$post(disk = files, body = list(a = 6))
out <- lapply(files, readLines)
# cleanup
closeAllConnections()
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(out, "list")
expect_is(out[[1]], "character")
expect_named(jsonlite::fromJSON(out[[1]])$form, "a")
})
context("Async - disk w/ PUT")
test_that("Async - writing to disk works", {
put_url <- hb('/put')
cc <- Async$new(urls = rep(put_url, 5))
files <- replicate(5, tempfile())
res <- cc$put(disk = files, body = list(a = 6))
out <- lapply(files, readLines)
# cleanup
closeAllConnections()
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(out, "list")
expect_is(out[[1]], "character")
expect_named(jsonlite::fromJSON(out[[1]])$form, "a")
})
context("Async - disk w/ PATCH")
test_that("Async - writing to disk works", {
patch_url <- hb('/patch')
cc <- Async$new(urls = rep(patch_url, 5))
files <- replicate(5, tempfile())
res <- cc$patch(disk = files, body = list(a = 6))
out <- lapply(files, readLines)
# cleanup
closeAllConnections()
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(out, "list")
expect_is(out[[1]], "character")
expect_named(jsonlite::fromJSON(out[[1]])$form, "a")
})
context("Async - disk w/ DELETE")
test_that("Async - writing to disk works", {
delete_url <- hb('/delete')
cc <- Async$new(urls = rep(delete_url, 5))
files <- replicate(5, tempfile())
res <- cc$delete(disk = files, body = list(a = 6))
out <- lapply(files, readLines)
# cleanup
closeAllConnections()
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(out, "list")
expect_is(out[[1]], "character")
expect_named(jsonlite::fromJSON(out[[1]])$form, "a")
})
context("Async - stream")
test_that("Async - streaming to disk works", {
bb <- Async$new(urls = c(hb('/get?a=5'),
hb('/get?b=6'),
hb('/get?c=7')))
lst <- c()
fun <- function(x) lst <<- append(lst, list(x))
out <- bb$get(stream = fun)
expect_is(bb, "Async")
expect_is(out[[1]], "HttpResponse")
expect_identical(out[[1]]$content, raw(0))
expect_identical(out[[2]]$content, raw(0))
expect_identical(out[[3]]$content, raw(0))
expect_is(lst, "list")
expect_is(rawToChar(lst[[1]]$content), "character")
expect_is(rawToChar(lst[[2]]$content), "character")
expect_is(rawToChar(lst[[3]]$content), "character")
})
context("Async - basic auth")
test_that("Async - with basic auth works", {
dd <- Async$new(
urls = rep(hb('/basic-auth/user/passwd'), 3),
auth = auth(user = "user", pwd = "passwd")
)
out <- dd$get()
expect_is(dd, "Async")
expect_equal(length(out), 3)
expect_is(out[[1]], "HttpResponse")
expect_is(out[[2]], "HttpResponse")
expect_is(out[[3]], "HttpResponse")
expect_is(out[[1]]$request$auth, "auth")
expect_equal(out[[1]]$request$auth$userpwd, "user:passwd")
expect_equal(out[[1]]$request$auth$httpauth, 1)
})
context("Async - failure behavior w/ bad URLs/etc.")
test_that("Async - failure behavior", {
urls <- c("http://stuffthings.gvb", "https://foo.com", "https://scottchamberlain.info")
conn <- Async$new(urls = urls)
res <- conn$get()
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(res[[2]], "HttpResponse")
expect_is(res[[3]], "HttpResponse")
expect_equal(res[[1]]$status_code, 0)
expect_equal(res[[2]]$status_code, 0)
expect_equal(res[[3]]$status_code, 200)
expect_false(res[[1]]$success())
expect_false(res[[2]]$success())
expect_true(res[[3]]$success())
expect_match(res[[1]]$parse("UTF-8"), "resolve host")
})
context("Async - failure behavior w/ bad URLs/etc. - disk")
test_that("Async - failure behavior", {
files <- replicate(3, tempfile())
urls <- c("http://stuffthings.gvb", "https://foo.com", "https://scottchamberlain.info")
conn <- Async$new(urls = urls)
res <- conn$get(disk = files)
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(res[[2]], "HttpResponse")
expect_is(res[[3]], "HttpResponse")
expect_equal(res[[1]]$status_code, 0)
expect_equal(res[[2]]$status_code, 0)
expect_equal(res[[3]]$status_code, 200)
expect_false(res[[1]]$success())
expect_false(res[[2]]$success())
expect_true(res[[3]]$success())
expect_match(res[[1]]$parse("UTF-8"), "resolve host")
expect_is(res[[2]]$parse("UTF-8"), "character")
expect_match(res[[3]]$parse("UTF-8"), "doctype")
expect_equal(length(readLines(files[1])), 0)
expect_equal(length(readLines(files[2])), 0)
expect_gt(length(readLines(files[3])), 10)
closeAllConnections()
})
context("Async - failure behavior w/ bad URLs/etc. - stream")
test_that("Async - failure behavior", {
mylist <- c()
fun <- function(x) mylist <<- append(mylist, list(x))
urls <- c("http://stuffthings.gvb", "https://foo.com", "https://scottchamberlain.info")
conn <- Async$new(urls = urls)
res <- conn$get(stream = fun)
expect_is(res, "asyncresponses")
expect_is(res[[1]], "HttpResponse")
expect_is(res[[2]], "HttpResponse")
expect_is(res[[3]], "HttpResponse")
# this doesn't mean anything really since we give a templated repsonse with
# status_code of 0
expect_equal(res[[1]]$status_code, 0)
expect_equal(res[[2]]$status_code, 0)
expect_equal(res[[3]]$status_code, 0)
# this doesn't mean anything really since we give a templated repsonse with
# status_code of 0
expect_false(res[[1]]$success())
expect_false(res[[2]]$success())
expect_false(res[[3]]$success())
# when fails on async, has the error message
expect_match(res[[1]]$parse("UTF-8"), "resolve host")
# when not a fail, has nothing
expect_identical(res[[3]]$parse("UTF-8"), "")
closeAllConnections()
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.