Skip to content

Commit

Permalink
#102 drop down to require curl v3.2 or less
Browse files Browse the repository at this point in the history 
fix #101 add ability to pass opts, proxies, auth, and headers to Async initialize, new()
update tests for the changes
  • Loading branch information
@sckott
sckott committed Feb 9, 2019
1 parent dba96ad commit 235ae59
Show file tree
Hide file tree
Showing 5 changed files with 185 additions and 40 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@ Roxygen: list(markdown = TRUE)
Encoding: UTF-8
Language: en-US
Imports:
curl (>= 3.1),
curl (<= 3.2),
R6 (>= 2.2.0),
urltools (>= 1.6.0),
httpcode (>= 0.2.0),
Expand Down
155 changes: 125 additions & 30 deletions R/async.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -59,9 +59,27 @@
#' res[[1]]$parse("UTF-8")
#' lapply(res, function(z) z$parse("UTF-8"))
#'
#' # curl options/headers with async
#' urls = c(
#' 'https://httpbin.org/',
#' 'https://httpbin.org/get?a=5',
#' 'https://httpbin.org/get?foo=bar'
#' )
#' cc <- Async$new(urls = urls,
#' opts = list(verbose = TRUE),
#' headers=list(foo = "bar")
#' )
#' cc
#' (res <- cc$get())
#'
#' # using auth with async
#' dd <- Async$new(urls = rep('https://httpbin.org/basic-auth/user/passwd', 3))
#' res <- dd$get(auth = auth(user = "user", pwd = "passwd"))
#' dd <- Async$new(
#' urls = rep('https://httpbin.org/basic-auth/user/passwd', 3),
#' auth = auth(user = "foo", pwd = "passwd"),
#' opts = list(verbose = TRUE)
#' )
#' dd
#' res <- dd$get()
#' res
#' vapply(res, function(z) z$status_code, double(1))
#' vapply(res, function(z) z$success(), logical(1))
Expand Down Expand Up @@ -93,9 +111,33 @@ Async <- R6::R6Class(
'Async',
public = list(
urls = NULL,
opts = NULL,
proxies = NULL,
auth = NULL,
headers = NULL,

print = function(x, ...) {
cat("<crul async connection> ", sep = "\n")

cat(" curl options: ", sep = "\n")
for (i in seq_along(self$opts)) {
cat(sprintf(" %s: %s", names(self$opts)[i],
self$opts[[i]]), sep = "\n")
}
cat(" proxies: ", sep = "\n")
if (length(self$proxies)) cat(paste(" -",
purl(self$proxies)), sep = "\n")
cat(" auth: ", sep = "\n")
if (length(self$auth$userpwd)) {
cat(paste(" -", self$auth$userpwd), sep = "\n")
cat(paste(" - type: ", self$auth$httpauth), sep = "\n")
}
cat(" headers: ", sep = "\n")
for (i in seq_along(self$headers)) {
cat(sprintf(" %s: %s", names(self$headers)[i],
self$headers[[i]]), sep = "\n")
}

cat(sprintf(" urls: (n: %s)", length(self$urls)), sep = "\n")
print_urls <- self$urls[1:min(c(length(self$urls), 10))]
for (i in seq_along(print_urls)) {
Expand All @@ -107,8 +149,12 @@ Async <- R6::R6Class(
invisible(self)
},

initialize = function(urls) {
initialize = function(urls, opts, proxies, auth, headers) {
self$urls <- urls
if (!missing(opts)) self$opts <- opts
if (!missing(proxies)) self$proxies <- proxies
if (!missing(auth)) self$auth <- auth
if (!missing(headers)) self$headers <- headers
},

get = function(path = NULL, query = list(), disk = NULL,
Expand Down Expand Up @@ -157,47 +203,96 @@ Async <- R6::R6Class(

private = list(
gen_interface = function(x, method, path, query = NULL, body = NULL,
encode = NULL, disk = NULL, stream = NULL, auth = NULL, ...) {

encode = NULL, disk = NULL, stream = NULL, ...) {
if (!is.null(disk)) {
if (length(disk) > 1) {
stopifnot(length(x) == length(disk))
reqs <- Map(function(z, m) {
switch(
method,
get = HttpRequest$new(url = z, auth = auth)$get(path = path, query = query,
disk = m, stream = stream, ...),
post = HttpRequest$new(url = z, auth = auth)$post(path = path, query = query,
body = body, encode = encode, disk = m, stream = stream,
...),
put = HttpRequest$new(url = z, auth = auth)$put(path = path, query = query,
body = body, encode = encode, disk = m, stream = stream,
...),
patch = HttpRequest$new(url = z, auth = auth)$patch(path = path, query = query,
get = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$get(
path = path, query = query, disk = m, stream = stream, ...
),
post = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$post(
path = path, query = query, body = body, encode = encode,
disk = m, stream = stream,
...
),
put = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$put(
path = path, query = query, body = body, encode = encode,
disk = m, stream = stream,
...
),
patch = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$patch(
path = path, query = query,
body = body, encode = encode, disk = m, stream = stream,
...),
delete = HttpRequest$new(url = z, auth = auth)$delete(path = path,
query = query, body = body, encode = encode, disk = m,
stream = stream, ...),
head = HttpRequest$new(url = z, auth = auth)$head(path = path, ...)
...
),
delete = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth, headers = self$headers
)$delete(
path = path, query = query, body = body, encode = encode,
disk = m, stream = stream, ...
),
head = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$head(path = path, ...)
)
}, x, disk)
}
} else {
reqs <- lapply(x, function(z) {
switch(
method,
get = HttpRequest$new(url = z, auth = auth)$get(path = path, query = query,
disk = disk, stream = stream, ...),
post = HttpRequest$new(url = z, auth = auth)$post(path = path, query = query,
body = body, encode = encode, disk = disk, stream = stream, ...),
put = HttpRequest$new(url = z, auth = auth)$put(path = path, query = query,
body = body, encode = encode, disk = disk, stream = stream, ...),
patch = HttpRequest$new(url = z, auth = auth)$patch(path = path, query = query,
body = body, encode = encode, disk = disk, stream = stream, ...),
delete = HttpRequest$new(url = z, auth = auth)$delete(path = path, query = query,
body = body, encode = encode, disk = disk, stream = stream, ...),
head = HttpRequest$new(url = z, auth = auth)$head(path = path, ...)
get = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers)$get(
path = path, query = query, disk = disk, stream = stream, ...
),
post = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$post(path = path, query = query, body = body, encode = encode,
disk = disk, stream = stream, ...
),
put = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$put(
path = path, query = query, body = body, encode = encode,
disk = disk, stream = stream, ...
),
patch = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$patch(
path = path, query = query, body = body, encode = encode,
disk = disk, stream = stream, ...
),
delete = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$delete(
path = path, query = query, body = body, encode = encode,
disk = disk, stream = stream, ...
),
head = HttpRequest$new(url = z, opts = self$opts,
proxies = self$proxies, auth = self$auth,
headers = self$headers
)$head(path = path, ...)
)
})
}
Expand Down
10 changes: 5 additions & 5 deletions R/httprequest.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -123,20 +123,20 @@ HttpRequest <- R6::R6Class(

# curl options: check for set_opts first
if (!is.null(crul_opts$opts)) self$opts <- crul_opts$opts
if (!missing(opts)) self$opts <- opts
if (!missing(opts)) self$opts <- opts %||% list()

# proxy: check for set_proxy first
if (!is.null(crul_opts$proxies)) self$proxies <- crul_opts$proxies
if (!missing(proxies)) {
if (!inherits(proxies, "proxy")) {
if (!inherits(proxies, "proxy") && !is.null(proxies)) {
stop("proxies input must be of class proxy", call. = FALSE)
}
self$proxies <- proxies
self$proxies <- proxies %||% list()
}

# auth: check for set_auth first
if (!is.null(crul_opts$auth)) self$auth <- crul_opts$auth
if (!missing(auth)) self$auth <- auth
if (!missing(auth)) self$auth <- auth %||% list()

# progress
if (!missing(progress)) {
Expand All @@ -146,7 +146,7 @@ HttpRequest <- R6::R6Class(

# headers: check for set_headers first
if (!is.null(crul_opts$headers)) self$headers <- crul_opts$headers
if (!missing(headers)) self$headers <- headers
if (!missing(headers)) self$headers <- headers %||% list()

if (!missing(handle)) self$handle <- handle
if (is.null(self$url) && is.null(self$handle)) {
Expand Down
22 changes: 20 additions & 2 deletions man/Async.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

36 changes: 34 additions & 2 deletions tests/testthat/test-async.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,10 @@ test_that("Async print method", {
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')
Expand All @@ -55,6 +59,31 @@ test_that("Async print method", {
})


test_that("Async curl options work", {
skip_on_cran()

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", {
skip_on_cran()

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", {
skip_on_cran()
Expand Down Expand Up @@ -318,8 +347,11 @@ context("Async - basic auth")
test_that("Async - with basic auth works", {
skip_on_cran()

dd <- Async$new(urls = rep(hb('/basic-auth/user/passwd'), 3))
out <- dd$get(auth = auth(user = "user", pwd = "passwd"))
dd <- Async$new(
urls = rep(hb('/basic-auth/user/passwd'), 3),
auth = auth(user = "user", pwd = "passwd")
)
out <- dd$get()

expect_is(dd, "Async")

Expand Down

0 comments on commit 235ae59

Please sign in to comment.