crul/0000755000176200001440000000000013231437763011230 5ustar liggesuserscrul/inst/0000755000176200001440000000000013231433525012175 5ustar liggesuserscrul/inst/doc/0000755000176200001440000000000013231433524012741 5ustar liggesuserscrul/inst/doc/async.Rmd0000644000176200001440000001762213230436233014531 0ustar liggesusers async with crul =============== Asynchronous requests with `crul`. There are two interfaces to asynchronous requests in `crul`: 1. Simple async: any number of URLs, all treated with the same curl options, headers, etc., and only one HTTP method type at a time. 2. Varied request async: build any type of request and execute all asynchronously. The first option takes less thinking, less work, and is good solution when you just want to hit a bunch of URLs asynchronously. The second option is ideal when you want to set curl options/headers on each request and/or want to do different types of HTTP methods on each request. One thing to think about before using async is whether the data provider is okay with it. It's possible that a data provider's service may be brought down if you do too many async requests. ```r library("crul") ``` ## simple async Build request object with 1 or more URLs ```r (cc <- Async$new( urls = c( 'https://httpbin.org/get?a=5', 'https://httpbin.org/get?a=5&b=6', 'https://httpbin.org/ip' ) )) #> #> urls: #> https://httpbin.org/get?a=5 #> https://httpbin.org/get?a=5&b=6 #> https://httpbin.org/ip ``` Make request with any HTTP method ```r (res <- cc$get()) #> [[1]] #> #> url: https://httpbin.org/get?a=5 #> request_headers: #> response_headers: #> status: HTTP/1.1 200 OK #> connection: keep-alive #> server: meinheld/0.6.1 #> date: Fri, 19 Jan 2018 18:44:29 GMT #> content-type: application/json #> access-control-allow-origin: * #> access-control-allow-credentials: true #> x-powered-by: Flask #> x-processed-time: 0.000792026519775 #> content-length: 346 #> via: 1.1 vegur #> params: #> a: 5 #> status: 200 #> #> [[2]] #> #> url: https://httpbin.org/get?a=5&b=6 #> request_headers: #> response_headers: #> status: HTTP/1.1 200 OK #> connection: keep-alive #> server: meinheld/0.6.1 #> date: Fri, 19 Jan 2018 18:44:29 GMT #> content-type: application/json #> access-control-allow-origin: * #> access-control-allow-credentials: true #> x-powered-by: Flask #> x-processed-time: 0.00130796432495 #> content-length: 365 #> via: 1.1 vegur #> params: #> a: 5 #> b: 6 #> status: 200 #> #> [[3]] #> #> url: https://httpbin.org/ip #> request_headers: #> response_headers: #> status: HTTP/1.1 200 OK #> connection: keep-alive #> server: meinheld/0.6.1 #> date: Fri, 19 Jan 2018 18:44:28 GMT #> content-type: application/json #> access-control-allow-origin: * #> access-control-allow-credentials: true #> x-powered-by: Flask #> x-processed-time: 0.000822067260742 #> content-length: 32 #> via: 1.1 vegur #> status: 200 ``` You get back a list matching length of the number of input URLs Access object variables and methods just as with `HttpClient` results, here just one at a time. ```r res[[1]]$url #> [1] "https://httpbin.org/get?a=5" res[[1]]$success() #> [1] TRUE res[[1]]$parse("UTF-8") #> [1] "{\n \"args\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5\"\n}\n" ``` Or apply access/method calls across many results, e.g., parse all results ```r lapply(res, function(z) z$parse("UTF-8")) #> [[1]] #> [1] "{\n \"args\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5\"\n}\n" #> #> [[2]] #> [1] "{\n \"args\": {\n \"a\": \"5\", \n \"b\": \"6\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5&b=6\"\n}\n" #> #> [[3]] #> [1] "{\n \"origin\": \"50.22.155.214\"\n}\n" ``` ## varied request async ```r req1 <- HttpRequest$new( url = "https://httpbin.org/get?a=5", opts = list( verbose = TRUE ) ) req1$get() #> get #> url: https://httpbin.org/get?a=5 #> curl options: #> verbose: TRUE #> proxies: #> auth: #> headers: req2 <- HttpRequest$new( url = "https://httpbin.org/post?a=5&b=6" ) req2$post(body = list(a = 5)) #> post #> url: https://httpbin.org/post?a=5&b=6 #> curl options: #> proxies: #> auth: #> headers: (res <- AsyncVaried$new(req1, req2)) #> #> requests: #> get: https://httpbin.org/get?a=5 #> post: https://httpbin.org/post?a=5&b=6 ``` Make requests asynchronously ```r res$request() ``` Parse all results ```r res$parse() #> [1] "{\n \"args\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5\"\n}\n" #> [2] "{\n \"args\": {\n \"a\": \"5\", \n \"b\": \"6\"\n }, \n \"data\": \"\", \n \"files\": {}, \n \"form\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Content-Length\": \"137\", \n \"Content-Type\": \"multipart/form-data; boundary=------------------------14f323a90518346b\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"json\": null, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/post?a=5&b=6\"\n}\n" ``` ```r lapply(res$parse(), jsonlite::prettify) #> [[1]] #> { #> "args": { #> "a": "5" #> }, #> "headers": { #> "Accept": "application/json, text/xml, application/xml, */*", #> "Accept-Encoding": "gzip, deflate", #> "Connection": "close", #> "Host": "httpbin.org", #> "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> }, #> "origin": "50.22.155.214", #> "url": "https://httpbin.org/get?a=5" #> } #> #> #> [[2]] #> { #> "args": { #> "a": "5", #> "b": "6" #> }, #> "data": "", #> "files": { #> #> }, #> "form": { #> "a": "5" #> }, #> "headers": { #> "Accept": "application/json, text/xml, application/xml, */*", #> "Accept-Encoding": "gzip, deflate", #> "Connection": "close", #> "Content-Length": "137", #> "Content-Type": "multipart/form-data; boundary=------------------------14f323a90518346b", #> "Host": "httpbin.org", #> "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> }, #> "json": null, #> "origin": "50.22.155.214", #> "url": "https://httpbin.org/post?a=5&b=6" #> } #> ``` Status codes ```r res$status_code() #> [1] 200 200 ``` crul/inst/doc/crul_vignette.Rmd0000644000176200001440000001734413230436233016267 0ustar liggesusers crul introduction ================= `crul` is an HTTP client for R. ## Install Stable CRAN version ```r install.packages("crul") ``` Dev version ```r devtools::install_github("ropensci/crul") ``` ```r library("crul") ``` ## the client `HttpClient` is where to start ```r (x <- HttpClient$new( url = "https://httpbin.org", opts = list( timeout = 1 ), headers = list( a = "hello world" ) )) #> #> url: https://httpbin.org #> curl options: #> timeout: 1 #> proxies: #> auth: #> headers: #> a: hello world ``` Makes a R6 class, that has all the bits and bobs you'd expect for doing HTTP requests. When it prints, it gives any defaults you've set. As you update the object you can see what's been set ```r x$opts #> $timeout #> [1] 1 ``` ```r x$headers #> $a #> [1] "hello world" ``` ## do some http The client object created above has http methods that you can call, and pass paths to, as well as query parameters, body values, and any other curl options. Here, we'll do a __GET__ request on the route `/get` on our base url `https://httpbin.org` (the full url is then `https://httpbin.org/get`) ```r res <- x$get("get") ``` The response from a http request is another R6 class `HttpResponse`, which has slots for the outputs of the request, and some functions to deal with the response: Status code ```r res$status_code #> [1] 200 ``` The content ```r res$content #> [1] 7b 0a 20 20 22 61 72 67 73 22 3a 20 7b 7d 2c 20 0a 20 20 22 68 65 61 #> [24] 64 65 72 73 22 3a 20 7b 0a 20 20 20 20 22 41 22 3a 20 22 68 65 6c 6c #> [47] 6f 20 77 6f 72 6c 64 22 2c 20 0a 20 20 20 20 22 41 63 63 65 70 74 22 #> [70] 3a 20 22 61 70 70 6c 69 63 61 74 69 6f 6e 2f 6a 73 6f 6e 2c 20 74 65 #> [93] 78 74 2f 78 6d 6c 2c 20 61 70 70 6c 69 63 61 74 69 6f 6e 2f 78 6d 6c #> [116] 2c 20 2a 2f 2a 22 2c 20 0a 20 20 20 20 22 41 63 63 65 70 74 2d 45 6e #> [139] 63 6f 64 69 6e 67 22 3a 20 22 67 7a 69 70 2c 20 64 65 66 6c 61 74 65 #> [162] 22 2c 20 0a 20 20 20 20 22 43 6f 6e 6e 65 63 74 69 6f 6e 22 3a 20 22 #> [185] 63 6c 6f 73 65 22 2c 20 0a 20 20 20 20 22 48 6f 73 74 22 3a 20 22 68 #> [208] 74 74 70 62 69 6e 2e 6f 72 67 22 2c 20 0a 20 20 20 20 22 55 73 65 72 #> [231] 2d 41 67 65 6e 74 22 3a 20 22 6c 69 62 63 75 72 6c 2f 37 2e 35 34 2e #> [254] 30 20 72 2d 63 75 72 6c 2f 33 2e 31 20 63 72 75 6c 2f 30 2e 35 2e 30 #> [277] 22 0a 20 20 7d 2c 20 0a 20 20 22 6f 72 69 67 69 6e 22 3a 20 22 35 30 #> [300] 2e 32 32 2e 31 35 35 2e 32 31 34 22 2c 20 0a 20 20 22 75 72 6c 22 3a #> [323] 20 22 68 74 74 70 73 3a 2f 2f 68 74 74 70 62 69 6e 2e 6f 72 67 2f 67 #> [346] 65 74 22 0a 7d 0a ``` HTTP method ```r res$method #> [1] "get" ``` Request headers ```r res$request_headers #> $`User-Agent` #> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> #> $`Accept-Encoding` #> [1] "gzip, deflate" #> #> $Accept #> [1] "application/json, text/xml, application/xml, */*" #> #> $a #> [1] "hello world" ``` Response headers ```r res$response_headers #> $status #> [1] "HTTP/1.1 200 OK" #> #> $connection #> [1] "keep-alive" #> #> $server #> [1] "meinheld/0.6.1" #> #> $date #> [1] "Fri, 19 Jan 2018 18:44:35 GMT" #> #> $`content-type` #> [1] "application/json" #> #> $`access-control-allow-origin` #> [1] "*" #> #> $`access-control-allow-credentials` #> [1] "true" #> #> $`x-powered-by` #> [1] "Flask" #> #> $`x-processed-time` #> [1] "0.00126600265503" #> #> $`content-length` #> [1] "351" #> #> $via #> [1] "1.1 vegur" ``` And you can parse the content with a provided function: ```r res$parse() #> [1] "{\n \"args\": {}, \n \"headers\": {\n \"A\": \"hello world\", \n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get\"\n}\n" jsonlite::fromJSON(res$parse()) #> $args #> named list() #> #> $headers #> $headers$A #> [1] "hello world" #> #> $headers$Accept #> [1] "application/json, text/xml, application/xml, */*" #> #> $headers$`Accept-Encoding` #> [1] "gzip, deflate" #> #> $headers$Connection #> [1] "close" #> #> $headers$Host #> [1] "httpbin.org" #> #> $headers$`User-Agent` #> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> #> #> $origin #> [1] "50.22.155.214" #> #> $url #> [1] "https://httpbin.org/get" ``` With the `HttpClient` object, which holds any configuration stuff we set, we can make other HTTP verb requests. For example, a `HEAD` request: ```r x$post( path = "post", body = list(hello = "world") ) ``` ## write to disk ```r x <- HttpClient$new(url = "https://httpbin.org") f <- tempfile() res <- x$get(disk = f) # when using write to disk, content is a path res$content #> [1] "/var/folders/fc/n7g_vrvn0sx_st0p8lxb3ts40000gn/T//Rtmp2d65n7/file58e3155bfa5b" ``` Read lines ```r readLines(res$content, n = 10) #> [1] "" #> [2] "" #> [3] "" #> [4] " " #> [5] " " #> [6] " httpbin(1): HTTP Client Testing Service" #> [7] "

async with crul

Asynchronous requests with crul.

There are two interfaces to asynchronous requests in crul:

  1. Simple async: any number of URLs, all treated with the same curl options, headers, etc., and only one HTTP method type at a time.
  2. Varied request async: build any type of request and execute all asynchronously.

The first option takes less thinking, less work, and is good solution when you just want to hit a bunch of URLs asynchronously.

The second option is ideal when you want to set curl options/headers on each request and/or want to do different types of HTTP methods on each request.

One thing to think about before using async is whether the data provider is okay with it. It’s possible that a data provider’s service may be brought down if you do too many async requests.

library("crul")

simple async

Build request object with 1 or more URLs

(cc <- Async$new(
  urls = c(
    'https://httpbin.org/get?a=5',
    'https://httpbin.org/get?a=5&b=6',
    'https://httpbin.org/ip'
  )
))
#> <crul async connection> 
#>   urls: 
#>    https://httpbin.org/get?a=5
#>    https://httpbin.org/get?a=5&b=6
#>    https://httpbin.org/ip

Make request with any HTTP method

(res <- cc$get())
#> [[1]]
#> <crul response> 
#>   url: https://httpbin.org/get?a=5
#>   request_headers: 
#>   response_headers: 
#>     status: HTTP/1.1 200 OK
#>     connection: keep-alive
#>     server: meinheld/0.6.1
#>     date: Fri, 19 Jan 2018 18:44:29 GMT
#>     content-type: application/json
#>     access-control-allow-origin: *
#>     access-control-allow-credentials: true
#>     x-powered-by: Flask
#>     x-processed-time: 0.000792026519775
#>     content-length: 346
#>     via: 1.1 vegur
#>   params: 
#>     a: 5
#>   status: 200
#> 
#> [[2]]
#> <crul response> 
#>   url: https://httpbin.org/get?a=5&b=6
#>   request_headers: 
#>   response_headers: 
#>     status: HTTP/1.1 200 OK
#>     connection: keep-alive
#>     server: meinheld/0.6.1
#>     date: Fri, 19 Jan 2018 18:44:29 GMT
#>     content-type: application/json
#>     access-control-allow-origin: *
#>     access-control-allow-credentials: true
#>     x-powered-by: Flask
#>     x-processed-time: 0.00130796432495
#>     content-length: 365
#>     via: 1.1 vegur
#>   params: 
#>     a: 5
#>     b: 6
#>   status: 200
#> 
#> [[3]]
#> <crul response> 
#>   url: https://httpbin.org/ip
#>   request_headers: 
#>   response_headers: 
#>     status: HTTP/1.1 200 OK
#>     connection: keep-alive
#>     server: meinheld/0.6.1
#>     date: Fri, 19 Jan 2018 18:44:28 GMT
#>     content-type: application/json
#>     access-control-allow-origin: *
#>     access-control-allow-credentials: true
#>     x-powered-by: Flask
#>     x-processed-time: 0.000822067260742
#>     content-length: 32
#>     via: 1.1 vegur
#>   status: 200

You get back a list matching length of the number of input URLs

Access object variables and methods just as with HttpClient results, here just one at a time.

res[[1]]$url
#> [1] "https://httpbin.org/get?a=5"
res[[1]]$success()
#> [1] TRUE
res[[1]]$parse("UTF-8")
#> [1] "{\n  \"args\": {\n    \"a\": \"5\"\n  }, \n  \"headers\": {\n    \"Accept\": \"application/json, text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\", \n    \"Connection\": \"close\", \n    \"Host\": \"httpbin.org\", \n    \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n  }, \n  \"origin\": \"50.22.155.214\", \n  \"url\": \"https://httpbin.org/get?a=5\"\n}\n"

Or apply access/method calls across many results, e.g., parse all results

lapply(res, function(z) z$parse("UTF-8"))
#> [[1]]
#> [1] "{\n  \"args\": {\n    \"a\": \"5\"\n  }, \n  \"headers\": {\n    \"Accept\": \"application/json, text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\", \n    \"Connection\": \"close\", \n    \"Host\": \"httpbin.org\", \n    \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n  }, \n  \"origin\": \"50.22.155.214\", \n  \"url\": \"https://httpbin.org/get?a=5\"\n}\n"
#> 
#> [[2]]
#> [1] "{\n  \"args\": {\n    \"a\": \"5\", \n    \"b\": \"6\"\n  }, \n  \"headers\": {\n    \"Accept\": \"application/json, text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\", \n    \"Connection\": \"close\", \n    \"Host\": \"httpbin.org\", \n    \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n  }, \n  \"origin\": \"50.22.155.214\", \n  \"url\": \"https://httpbin.org/get?a=5&b=6\"\n}\n"
#> 
#> [[3]]
#> [1] "{\n  \"origin\": \"50.22.155.214\"\n}\n"

varied request async

req1 <- HttpRequest$new(
  url = "https://httpbin.org/get?a=5",
  opts = list(
    verbose = TRUE
  )
)
req1$get()
#> <crul http request> get
#>   url: https://httpbin.org/get?a=5
#>   curl options: 
#>     verbose: TRUE
#>   proxies: 
#>   auth: 
#>   headers:

req2 <- HttpRequest$new(
  url = "https://httpbin.org/post?a=5&b=6"
)
req2$post(body = list(a = 5))
#> <crul http request> post
#>   url: https://httpbin.org/post?a=5&b=6
#>   curl options: 
#>   proxies: 
#>   auth: 
#>   headers:

(res <- AsyncVaried$new(req1, req2))
#> <crul async varied connection> 
#>   requests: 
#>    get: https://httpbin.org/get?a=5 
#>    post: https://httpbin.org/post?a=5&b=6

Make requests asynchronously

res$request()

Parse all results

res$parse()
#> [1] "{\n  \"args\": {\n    \"a\": \"5\"\n  }, \n  \"headers\": {\n    \"Accept\": \"application/json, text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\", \n    \"Connection\": \"close\", \n    \"Host\": \"httpbin.org\", \n    \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n  }, \n  \"origin\": \"50.22.155.214\", \n  \"url\": \"https://httpbin.org/get?a=5\"\n}\n"                                                                                                                                                                                                                                                                   
#> [2] "{\n  \"args\": {\n    \"a\": \"5\", \n    \"b\": \"6\"\n  }, \n  \"data\": \"\", \n  \"files\": {}, \n  \"form\": {\n    \"a\": \"5\"\n  }, \n  \"headers\": {\n    \"Accept\": \"application/json, text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\", \n    \"Connection\": \"close\", \n    \"Content-Length\": \"137\", \n    \"Content-Type\": \"multipart/form-data; boundary=------------------------14f323a90518346b\", \n    \"Host\": \"httpbin.org\", \n    \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n  }, \n  \"json\": null, \n  \"origin\": \"50.22.155.214\", \n  \"url\": \"https://httpbin.org/post?a=5&b=6\"\n}\n"
lapply(res$parse(), jsonlite::prettify)
#> [[1]]
#> {
#>     "args": {
#>         "a": "5"
#>     },
#>     "headers": {
#>         "Accept": "application/json, text/xml, application/xml, */*",
#>         "Accept-Encoding": "gzip, deflate",
#>         "Connection": "close",
#>         "Host": "httpbin.org",
#>         "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"
#>     },
#>     "origin": "50.22.155.214",
#>     "url": "https://httpbin.org/get?a=5"
#> }
#>  
#> 
#> [[2]]
#> {
#>     "args": {
#>         "a": "5",
#>         "b": "6"
#>     },
#>     "data": "",
#>     "files": {
#> 
#>     },
#>     "form": {
#>         "a": "5"
#>     },
#>     "headers": {
#>         "Accept": "application/json, text/xml, application/xml, */*",
#>         "Accept-Encoding": "gzip, deflate",
#>         "Connection": "close",
#>         "Content-Length": "137",
#>         "Content-Type": "multipart/form-data; boundary=------------------------14f323a90518346b",
#>         "Host": "httpbin.org",
#>         "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"
#>     },
#>     "json": null,
#>     "origin": "50.22.155.214",
#>     "url": "https://httpbin.org/post?a=5&b=6"
#> }
#> 

Status codes

res$status_code()
#> [1] 200 200
crul/inst/doc/how-to-use-crul.html0000644000176200001440000232626213231433524016616 0ustar liggesusers how-to-use-crul.utf8

How to use crul

The following aims to help you decide how to use crul in different scenarios.

First, crul is aimed a bit more at developers than at the casual user doing HTTP requests. That is, crul is probably a better fit for an R package developer, mainly because it heavily uses R6 - an interface that’s very unlike the interface in httr but very similar to interacting with classes in Ruby/Python.

Second, there is not yet, but will be soon, the ability to mock HTTP requests. We are working on that, and should have it integrated soon. When that feature arrives we’ll update this vignette.

Load the library

library("crul")

A simple HTTP request function

Most likely you’ll want to do a GET request - so let’s start with that - though the details are not much different for other HTTP verbs.

And in most cases you’ll likely not want to do asynchronous requests - though see below if you do.

You’ll probably want to write a small function, like so (annotated for clarity)

make_request <- function(url) {
  # create a HttpClient object, defining the url
  cli <- crul::HttpClient$new(url = url)
  # do a GET request
  res <- cli$get()
  # check to see if request failed or succeeded
  # - if succeeds this will return nothing and proceeds to next step
  res$raise_for_status()
  # parse response to plain text (JSON in this case) - most likely you'll 
  # want UTF-8 encoding
  txt <- res$parse("UTF-8")
  # parse the JSON to an R list
  jsonlite::fromJSON(txt)
}

Use the function

make_request("https://httpbin.org/get")
#> $args
#> named list()
#> 
#> $headers
#> $headers$Accept
#> [1] "application/json, text/xml, application/xml, */*"
#> 
#> $headers$`Accept-Encoding`
#> [1] "gzip, deflate"
#> 
#> $headers$Connection
#> [1] "close"
#> 
#> $headers$Host
#> [1] "httpbin.org"
#> 
#> $headers$`User-Agent`
#> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"
#> 
#> 
#> $origin
#> [1] "50.22.155.214"
#> 
#> $url
#> [1] "https://httpbin.org/get"

Now you can use the make_request function in your script or package.

More customized function

Once you get more familiar (or if you’re already familiar with HTTP) you may want to have more control, toggle more switches.

In the next function, we’ll allow for users to pass in curl options, use a custom HTTP status checker, and xxx.

make_request2 <- function(url, ...) {
  # create a HttpClient object, defining the url
  cli <- crul::HttpClient$new(url = url)
  # do a GET request, allow curl options to be passed in
  res <- cli$get(...)
  # check to see if request failed or succeeded
  # - a custom approach this time combining status code, 
  #   explanation of the code, and message from the server
  if (res$status_code > 201) {
    mssg <- jsonlite::fromJSON(res$parse("UTF-8"))$message$message
    x <- res$status_http()
    stop(
      sprintf("HTTP (%s) - %s\n  %s", x$status_code, x$explanation, mssg),
      call. = FALSE
    )
  }
  # parse response
  txt <- res$parse("UTF-8")
  # parse the JSON to an R list
  jsonlite::fromJSON(txt)
}

Use the function

make_request2("https://api.crossref.org/works?rows=0")
#> $status
#> [1] "ok"
#> 
#> $`message-type`
#> [1] "work-list"
#> 
#> $`message-version`
#> [1] "1.0.0"
#> 
#> $message
#> $message$facets
#> named list()
#> 
#> $message$`total-results`
#> [1] 94347210
#> 
#> $message$items
#> list()
#> 
#> $message$`items-per-page`
#> [1] 0
#> 
#> $message$query
#> $message$query$`start-index`
#> [1] 0
#> 
#> $message$query$`search-terms`
#> NULL

No different from the first function (besides the URL). However, now we can pass in curl options:

make_request2("https://api.crossref.org/works?rows=0", verbose = TRUE)
make_request2("https://api.crossref.org/works?rows=0", timeout_ms = 1)

We can also pass named parameters supported in the get method, including query, disk, and stream.

make_request2("https://api.crossref.org/works", query = list(rows = 0))
#> $status
#> [1] "ok"
#> 
#> $`message-type`
#> [1] "work-list"
#> 
#> $`message-version`
#> [1] "1.0.0"
#> 
#> $message
#> $message$facets
#> named list()
#> 
#> $message$`total-results`
#> [1] 94347210
#> 
#> $message$items
#> list()
#> 
#> $message$`items-per-page`
#> [1] 0
#> 
#> $message$query
#> $message$query$`start-index`
#> [1] 0
#> 
#> $message$query$`search-terms`
#> NULL

In addition, the failure behavior is different, and customized to the specific web resource we are working with

make_request2("https://api.crossref.org/works?rows=asdf")
#> Error: HTTP (400) - Bad request syntax or unsupported method
#>   Integer specified as asdf but must be a positive integer less than or equal to 1000.

Asynchronous requests

You may want to use asynchronous HTTP requests when any one HTTP request takes “too long”. This is of course all relative. You may be dealing with a server that responds very slowly, or other circumstances.

See the async with crul vignette for more details on asynchronous requests.

crul/inst/doc/how-to-use-crul.Rmd0000644000176200001440000001205413230436233016360 0ustar liggesusers How to use crul =============== The following aims to help you decide how to use `crul` in different scenarios. First, `crul` is aimed a bit more at developers than at the casual user doing HTTP requests. That is, `crul` is probably a better fit for an R package developer, mainly because it heavily uses `R6` - an interface that's very unlike the interface in `httr` but very similar to interacting with classes in Ruby/Python. Second, there is not yet, but will be soon, the ability to mock HTTP requests. We are working on that, and should have it integrated soon. When that feature arrives we'll update this vignette. Load the library ```r library("crul") ``` ## A simple HTTP request function Most likely you'll want to do a `GET` request - so let's start with that - though the details are not much different for other HTTP verbs. And in most cases you'll likely not want to do asynchronous requests - though see below if you do. You'll probably want to write a small function, like so (annotated for clarity) ```r make_request <- function(url) { # create a HttpClient object, defining the url cli <- crul::HttpClient$new(url = url) # do a GET request res <- cli$get() # check to see if request failed or succeeded # - if succeeds this will return nothing and proceeds to next step res$raise_for_status() # parse response to plain text (JSON in this case) - most likely you'll # want UTF-8 encoding txt <- res$parse("UTF-8") # parse the JSON to an R list jsonlite::fromJSON(txt) } ``` Use the function ```r make_request("https://httpbin.org/get") #> $args #> named list() #> #> $headers #> $headers$Accept #> [1] "application/json, text/xml, application/xml, */*" #> #> $headers$`Accept-Encoding` #> [1] "gzip, deflate" #> #> $headers$Connection #> [1] "close" #> #> $headers$Host #> [1] "httpbin.org" #> #> $headers$`User-Agent` #> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> #> #> $origin #> [1] "50.22.155.214" #> #> $url #> [1] "https://httpbin.org/get" ``` Now you can use the `make_request` function in your script or package. ## More customized function Once you get more familiar (or if you're already familiar with HTTP) you may want to have more control, toggle more switches. In the next function, we'll allow for users to pass in curl options, use a custom HTTP status checker, and xxx. ```r make_request2 <- function(url, ...) { # create a HttpClient object, defining the url cli <- crul::HttpClient$new(url = url) # do a GET request, allow curl options to be passed in res <- cli$get(...) # check to see if request failed or succeeded # - a custom approach this time combining status code, # explanation of the code, and message from the server if (res$status_code > 201) { mssg <- jsonlite::fromJSON(res$parse("UTF-8"))$message$message x <- res$status_http() stop( sprintf("HTTP (%s) - %s\n %s", x$status_code, x$explanation, mssg), call. = FALSE ) } # parse response txt <- res$parse("UTF-8") # parse the JSON to an R list jsonlite::fromJSON(txt) } ``` Use the function ```r make_request2("https://api.crossref.org/works?rows=0") #> $status #> [1] "ok" #> #> $`message-type` #> [1] "work-list" #> #> $`message-version` #> [1] "1.0.0" #> #> $message #> $message$facets #> named list() #> #> $message$`total-results` #> [1] 94347210 #> #> $message$items #> list() #> #> $message$`items-per-page` #> [1] 0 #> #> $message$query #> $message$query$`start-index` #> [1] 0 #> #> $message$query$`search-terms` #> NULL ``` No different from the first function (besides the URL). However, now we can pass in curl options: ```r make_request2("https://api.crossref.org/works?rows=0", verbose = TRUE) make_request2("https://api.crossref.org/works?rows=0", timeout_ms = 1) ``` We can also pass named parameters supported in the `get` method, including `query`, `disk`, and `stream`. ```r make_request2("https://api.crossref.org/works", query = list(rows = 0)) #> $status #> [1] "ok" #> #> $`message-type` #> [1] "work-list" #> #> $`message-version` #> [1] "1.0.0" #> #> $message #> $message$facets #> named list() #> #> $message$`total-results` #> [1] 94347210 #> #> $message$items #> list() #> #> $message$`items-per-page` #> [1] 0 #> #> $message$query #> $message$query$`start-index` #> [1] 0 #> #> $message$query$`search-terms` #> NULL ``` In addition, the failure behavior is different, and customized to the specific web resource we are working with ```r make_request2("https://api.crossref.org/works?rows=asdf") #> Error: HTTP (400) - Bad request syntax or unsupported method #> Integer specified as asdf but must be a positive integer less than or equal to 1000. ``` ## Asynchronous requests You may want to use asynchronous HTTP requests when any one HTTP request takes "too long". This is of course all relative. You may be dealing with a server that responds very slowly, or other circumstances. See the __async with crul__ vignette for more details on asynchronous requests. crul/inst/doc/crul_vignette.html0000644000176200001440000233676213231433524016524 0ustar liggesusers crul_vignette.utf8

crul introduction

crul is an HTTP client for R.

Install

Stable CRAN version

install.packages("crul")

Dev version

devtools::install_github("ropensci/crul")
library("crul")

the client

HttpClient is where to start

(x <- HttpClient$new(
  url = "https://httpbin.org",
  opts = list(
    timeout = 1
  ),
  headers = list(
    a = "hello world"
  )
))
#> <crul connection> 
#>   url: https://httpbin.org
#>   curl options: 
#>     timeout: 1
#>   proxies: 
#>   auth: 
#>   headers: 
#>     a: hello world

Makes a R6 class, that has all the bits and bobs you’d expect for doing HTTP requests. When it prints, it gives any defaults you’ve set. As you update the object you can see what’s been set

x$opts
#> $timeout
#> [1] 1
x$headers
#> $a
#> [1] "hello world"

do some http

The client object created above has http methods that you can call, and pass paths to, as well as query parameters, body values, and any other curl options.

Here, we’ll do a GET request on the route /get on our base url https://httpbin.org (the full url is then https://httpbin.org/get)

res <- x$get("get")

The response from a http request is another R6 class HttpResponse, which has slots for the outputs of the request, and some functions to deal with the response:

Status code

res$status_code
#> [1] 200

The content

res$content
#>   [1] 7b 0a 20 20 22 61 72 67 73 22 3a 20 7b 7d 2c 20 0a 20 20 22 68 65 61
#>  [24] 64 65 72 73 22 3a 20 7b 0a 20 20 20 20 22 41 22 3a 20 22 68 65 6c 6c
#>  [47] 6f 20 77 6f 72 6c 64 22 2c 20 0a 20 20 20 20 22 41 63 63 65 70 74 22
#>  [70] 3a 20 22 61 70 70 6c 69 63 61 74 69 6f 6e 2f 6a 73 6f 6e 2c 20 74 65
#>  [93] 78 74 2f 78 6d 6c 2c 20 61 70 70 6c 69 63 61 74 69 6f 6e 2f 78 6d 6c
#> [116] 2c 20 2a 2f 2a 22 2c 20 0a 20 20 20 20 22 41 63 63 65 70 74 2d 45 6e
#> [139] 63 6f 64 69 6e 67 22 3a 20 22 67 7a 69 70 2c 20 64 65 66 6c 61 74 65
#> [162] 22 2c 20 0a 20 20 20 20 22 43 6f 6e 6e 65 63 74 69 6f 6e 22 3a 20 22
#> [185] 63 6c 6f 73 65 22 2c 20 0a 20 20 20 20 22 48 6f 73 74 22 3a 20 22 68
#> [208] 74 74 70 62 69 6e 2e 6f 72 67 22 2c 20 0a 20 20 20 20 22 55 73 65 72
#> [231] 2d 41 67 65 6e 74 22 3a 20 22 6c 69 62 63 75 72 6c 2f 37 2e 35 34 2e
#> [254] 30 20 72 2d 63 75 72 6c 2f 33 2e 31 20 63 72 75 6c 2f 30 2e 35 2e 30
#> [277] 22 0a 20 20 7d 2c 20 0a 20 20 22 6f 72 69 67 69 6e 22 3a 20 22 35 30
#> [300] 2e 32 32 2e 31 35 35 2e 32 31 34 22 2c 20 0a 20 20 22 75 72 6c 22 3a
#> [323] 20 22 68 74 74 70 73 3a 2f 2f 68 74 74 70 62 69 6e 2e 6f 72 67 2f 67
#> [346] 65 74 22 0a 7d 0a

HTTP method

res$method
#> [1] "get"

Request headers

res$request_headers
#> $`User-Agent`
#> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"
#> 
#> $`Accept-Encoding`
#> [1] "gzip, deflate"
#> 
#> $Accept
#> [1] "application/json, text/xml, application/xml, */*"
#> 
#> $a
#> [1] "hello world"

Response headers

res$response_headers
#> $status
#> [1] "HTTP/1.1 200 OK"
#> 
#> $connection
#> [1] "keep-alive"
#> 
#> $server
#> [1] "meinheld/0.6.1"
#> 
#> $date
#> [1] "Fri, 19 Jan 2018 18:44:35 GMT"
#> 
#> $`content-type`
#> [1] "application/json"
#> 
#> $`access-control-allow-origin`
#> [1] "*"
#> 
#> $`access-control-allow-credentials`
#> [1] "true"
#> 
#> $`x-powered-by`
#> [1] "Flask"
#> 
#> $`x-processed-time`
#> [1] "0.00126600265503"
#> 
#> $`content-length`
#> [1] "351"
#> 
#> $via
#> [1] "1.1 vegur"

And you can parse the content with a provided function:

res$parse()
#> [1] "{\n  \"args\": {}, \n  \"headers\": {\n    \"A\": \"hello world\", \n    \"Accept\": \"application/json, text/xml, application/xml, */*\", \n    \"Accept-Encoding\": \"gzip, deflate\", \n    \"Connection\": \"close\", \n    \"Host\": \"httpbin.org\", \n    \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n  }, \n  \"origin\": \"50.22.155.214\", \n  \"url\": \"https://httpbin.org/get\"\n}\n"
jsonlite::fromJSON(res$parse())
#> $args
#> named list()
#> 
#> $headers
#> $headers$A
#> [1] "hello world"
#> 
#> $headers$Accept
#> [1] "application/json, text/xml, application/xml, */*"
#> 
#> $headers$`Accept-Encoding`
#> [1] "gzip, deflate"
#> 
#> $headers$Connection
#> [1] "close"
#> 
#> $headers$Host
#> [1] "httpbin.org"
#> 
#> $headers$`User-Agent`
#> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"
#> 
#> 
#> $origin
#> [1] "50.22.155.214"
#> 
#> $url
#> [1] "https://httpbin.org/get"

With the HttpClient object, which holds any configuration stuff we set, we can make other HTTP verb requests. For example, a HEAD request:

x$post(
  path = "post", 
  body = list(hello = "world")
)

write to disk

x <- HttpClient$new(url = "https://httpbin.org")
f <- tempfile()
res <- x$get(disk = f)
# when using write to disk, content is a path
res$content 
#> [1] "/var/folders/fc/n7g_vrvn0sx_st0p8lxb3ts40000gn/T//Rtmp2d65n7/file58e3155bfa5b"

Read lines

readLines(res$content, n = 10)
#>  [1] "<!DOCTYPE html>"                                                                           
#>  [2] "<html>"                                                                                    
#>  [3] "<head>"                                                                                    
#>  [4] "  <meta http-equiv='content-type' value='text/html;charset=utf8'>"                         
#>  [5] "  <meta name='generator' value='Ronn/v0.7.3 (http://github.com/rtomayko/ronn/tree/0.7.3)'>"
#>  [6] "  <title>httpbin(1): HTTP Client Testing Service</title>"                                  
#>  [7] "  <style type='text/css' media='all'>"                                                     
#>  [8] "  /* style: man */"                                                                        
#>  [9] "  body#manpage {margin:0}"                                                                 
#> [10] "  .mp {max-width:100ex;padding:0 9ex 1ex 4ex}"

stream data

(x <- HttpClient$new(url = "https://httpbin.org"))
#> <crul connection> 
#>   url: https://httpbin.org
#>   curl options: 
#>   proxies: 
#>   auth: 
#>   headers:
res <- x$get('stream/5', stream = function(x) cat(rawToChar(x)))
#> {"headers": {"Accept": "application/json, text/xml, application/xml, */*", "Accept-Encoding": "gzip, deflate", "Host": "httpbin.org", "Connection": "close", "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"}, "origin": "50.22.155.214", "id": 0, "url": "https://httpbin.org/stream/5", "args": {}}
#> {"headers": {"Accept": "application/json, text/xml, application/xml, */*", "Accept-Encoding": "gzip, deflate", "Host": "httpbin.org", "Connection": "close", "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"}, "origin": "50.22.155.214", "id": 1, "url": "https://httpbin.org/stream/5", "args": {}}
#> {"headers": {"Accept": "application/json, text/xml, application/xml, */*", "Accept-Encoding": "gzip, deflate", "Host": "httpbin.org", "Connection": "close", "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"}, "origin": "50.22.155.214", "id": 2, "url": "https://httpbin.org/stream/5", "args": {}}
#> {"headers": {"Accept": "application/json, text/xml, application/xml, */*", "Accept-Encoding": "gzip, deflate", "Host": "httpbin.org", "Connection": "close", "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"}, "origin": "50.22.155.214", "id": 3, "url": "https://httpbin.org/stream/5", "args": {}}
#> {"headers": {"Accept": "application/json, text/xml, application/xml, */*", "Accept-Encoding": "gzip, deflate", "Host": "httpbin.org", "Connection": "close", "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0"}, "origin": "50.22.155.214", "id": 4, "url": "https://httpbin.org/stream/5", "args": {}}
# when streaming, content is NULL
res$content 
#> NULL
crul/tests/0000755000176200001440000000000013231433525012362 5ustar liggesuserscrul/tests/testthat/0000755000176200001440000000000013231433525014222 5ustar liggesuserscrul/tests/testthat/test-utils.R0000644000176200001440000000207313070473662016473 0ustar liggesuserscontext("encode") test_that("encode", { aa <- encode("https://httpbin.org") bb <- encode(I("https://httpbin.org")) expect_is(aa, "character") expect_is(bb, "AsIs") expect_match(aa, "%3A") expect_false(grepl("%3A", bb)) }) context("has_name") test_that("has_name", { expect_false(has_name(5)) expect_true(all(has_name(mtcars))) expect_true(has_name(list(a = 5))) expect_false(has_name(list(5))) }) context("has_namez") test_that("has_namez", { expect_false(has_namez(5)) expect_true(has_namez(mtcars)) expect_true(has_namez(list(a = 5))) expect_false(has_namez(list(5))) }) context("make_query") test_that("make_query", { aa <- make_query(list(foo = "hello", bar = "world")) expect_is(aa, "character") expect_match(aa, "foo") expect_match(aa, "&") expect_match(aa, "=") }) context("curl_opts_check") test_that("curl_opts_check works", { expect_null(curl_opts_check(verbose = TRUE)) expect_null(curl_opts_check(timeout_ms = 0.001)) expect_error( curl_opts_check(httppost = 1), "the following curl options are not allowed") }) crul/tests/testthat/test-proxies.R0000644000176200001440000000330413070473662017022 0ustar liggesuserscontext("proxies") test_that("proxy without http requests works", { aa <- proxy("http://97.77.104.22:3128") bb <- proxy("97.77.104.22:3128") cc <- proxy("http://97.77.104.22:3128", "foo", "bar") dd <- proxy("http://97.77.104.22:3128", "foo", "bar", auth = "digest") ee <- proxy("http://97.77.104.22:3128", "foo", "bar", auth = "ntlm") expect_is(aa, "proxy") expect_is(unclass(aa), "list") expect_is(aa$proxy, "character") expect_type(aa$proxyport, "double") expect_type(aa$proxyauth, "double") expect_is(bb, "proxy") expect_is(unclass(bb), "list") expect_is(bb$proxy, "character") expect_type(bb$proxyport, "double") expect_type(bb$proxyauth, "double") expect_is(cc, "proxy") expect_is(unclass(cc), "list") expect_is(cc$proxy, "character") expect_type(cc$proxyport, "double") expect_type(cc$proxyauth, "double") expect_is(dd, "proxy") expect_is(unclass(dd), "list") expect_is(dd$proxy, "character") expect_type(dd$proxyport, "double") expect_type(dd$proxyauth, "double") expect_is(ee, "proxy") expect_is(unclass(ee), "list") expect_is(ee$proxy, "character") expect_type(ee$proxyport, "double") expect_type(ee$proxyauth, "double") }) test_that("proxy - using in HttpClient", { aa <- HttpClient$new( url = "http://www.google.com", proxies = proxy("http://97.77.104.22:3128") ) expect_is(aa, "HttpClient") expect_is(aa$proxies, "proxy") }) test_that("proxy fails well", { expect_error(proxy(), "proxy URL not of correct form") expect_error(proxy(user = mtcars), "proxy URL not of correct form") expect_error(proxy("adff", user = 5), "user must be of class character") expect_error(proxy("adff", pwd = 5), "pwd must be of class character") }) crul/tests/testthat/test-client.R0000644000176200001440000000302713070473662016611 0ustar liggesuserscontext("HttpClient") test_that("HttpClient works", { skip_on_cran() expect_is(HttpClient, "R6ClassGenerator") aa <- HttpClient$new(url = "https://httpbin.org") expect_is(aa, "HttpClient") expect_null(aa$handle) expect_length(aa$opts, 0) expect_is(aa$url, "character") expect_is(aa$.__enclos_env__$private$make_request, "function") expect_is(aa$post, "function") expect_is(aa$get, "function") }) test_that("HttpClient fails well", { skip_on_cran() expect_error(HttpClient$new(), "need one of url or handle") }) context("HttpClient - disk") test_that("HttpClient works", { skip_on_cran() aa <- HttpClient$new(url = "https://httpbin.org") f <- tempfile() res <- aa$get("get", disk = f) lns <- readLines(res$content, n = 10) expect_is(aa, "HttpClient") expect_is(res$content, "character") expect_gt(length(lns), 0) unlink(f) }) test_that("HttpClient disk fails well", { skip_on_cran() aa <- HttpClient$new(url = "https://httpbin.org") expect_error(aa$get("get", disk = 5), "invalid 'path' argument") }) context("HttpClient - stream") test_that("HttpClient works", { skip_on_cran() aa <- HttpClient$new(url = "https://httpbin.org") expect_output( res <- aa$get('stream/50', stream = function(x) cat(rawToChar(x))), "headers" ) expect_is(res, "HttpResponse") expect_null(res$content) }) test_that("HttpClient disk fails well", { skip_on_cran() aa <- HttpClient$new(url = "https://httpbin.org") expect_error(aa$get("get", stream = 5), "could not find function \"fun\"") }) crul/tests/testthat/test-headers.R0000644000176200001440000000133113164226143016734 0ustar liggesuserscontext("headers") test_that("headers work - just default headers", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$get('get') expect_is(aa, "HttpResponse") expect_named(aa$request_headers, c('User-Agent', 'Accept-Encoding', 'Accept')) }) test_that("headers work - user headers passed", { skip_on_cran() cli <- HttpClient$new( url = "https://httpbin.org", headers = list(hello = "world") ) bb <- cli$get('get') expect_is(bb, "HttpResponse") expect_named(bb$request_headers, c('User-Agent', 'Accept-Encoding', 'Accept', 'hello')) expect_true( any(grepl("Hello", names(jsonlite::fromJSON(bb$parse("UTF-8"))$headers)))) }) crul/tests/testthat/test-user-agent.R0000644000176200001440000000031413010522535017365 0ustar liggesuserscontext("user-agent") test_that("user-agent", { skip_on_cran() aa <- make_ua() expect_is(aa, "character") expect_match(aa, 'libcurl') expect_match(aa, 'r-curl') expect_match(aa, 'crul') }) crul/tests/testthat/test-status.R0000644000176200001440000000214313040733452016645 0ustar liggesuserscontext("request: status") test_that("HTTP status is as expected", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") # im a teapot aa <- cli$get("status/418") expect_is(aa, "HttpResponse") expect_is(aa$content, "raw") expect_equal(aa$method, "get") expect_equal(aa$status_code, 418) expect_match(aa$response_headers[[1]], "I'M A TEAPOT") # method not allowed bb <- cli$get("status/405") expect_is(bb, "HttpResponse") expect_is(bb$content, "raw") expect_equal(bb$method, "get") expect_equal(bb$status_code, 405) expect_match(bb$response_headers[[1]], "METHOD NOT ALLOWED") # service unavailable cc <- cli$get("status/503") expect_is(cc, "HttpResponse") expect_is(cc$content, "raw") expect_equal(cc$method, "get") expect_equal(cc$status_code, 503) expect_match(cc$response_headers[[1]], "SERVICE UNAVAILABLE") # Partial Content dd <- cli$get("status/206") expect_is(dd, "HttpResponse") expect_is(dd$content, "raw") expect_equal(dd$method, "get") expect_equal(dd$status_code, 206) expect_match(dd$response_headers[[1]], "PARTIAL CONTENT") }) crul/tests/testthat/test-delete.R0000644000176200001440000000177413164226173016601 0ustar liggesuserscontext("request: delete") test_that("delete request works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$delete("delete") expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "delete") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) expect_null(aa$request$fields) }) test_that("delete request with body", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$delete("delete", body = list(hello = "world")) expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "delete") expect_is(aa$parse, "function") expect_is(aa$parse("UTF-8"), "character") expect_true(aa$success()) expect_named(aa$request$fields, "hello") expect_equal(aa$request$fields[[1]], "world") }) crul/tests/testthat/test-get.R0000644000176200001440000000216313010507611016074 0ustar liggesuserscontext("request: get") test_that("get request works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$get("get") expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) }) test_that("get request - query parameters", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") querya <- list(a = "Asdfadsf", hello = "world") aa <- cli$get("get", query = querya) expect_is(aa, "HttpResponse") expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "get") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) library(urltools) params <- unlist(lapply( strsplit(urltools::url_parse(aa$request$url$url)$parameter, "&")[[1]], function(x) { tmp <- strsplit(x, "=")[[1]] as.list(stats::setNames(tmp[2], tmp[1])) } ), FALSE) expect_equal(params, querya) }) crul/tests/testthat/test-url_build_parse.R0000644000176200001440000000541113070473662020505 0ustar liggesuserscontext("url build") test_that("url build works", { skip_on_cran() aa <- url_build("https://httpbin.org") bb <- url_build("https://httpbin.org", "get") cc <- url_build("https://httpbin.org", "get", list(foo = "bar")) expect_is(aa, "character") expect_match(aa, "https") expect_match(aa, "httpbin.org") expect_is(bb, "character") expect_match(bb, "https") expect_match(bb, "httpbin.org") expect_match(bb, "get") expect_is(cc, "character") expect_match(cc, "https") expect_match(cc, "httpbin.org") expect_match(cc, "?foo=bar") }) test_that("build fails well", { skip_on_cran() # url param required expect_error(url_build(), "argument \"url\" is missing") # wrong types expect_error(url_build(5), "url must be of class character") expect_error(url_build("ASDf", path = 5), "path must be of class character") expect_error(url_build("adff", query = 5), "query must be of class list") # query list is named expect_error(url_build("As", query = list(4, 5)), "all query elements must be named") }) context("url parse") test_that("url parse works", { skip_on_cran() aa <- url_parse("https://httpbin.org") bb <- url_parse("https://httpbin.org/get?foo=bar") cc <- url_parse("https://httpbin.org/get?foo=bar&stuff=things") expect_is(aa, "list") expect_named(aa, c('scheme', 'domain', 'port', 'path', 'parameter', 'fragment')) expect_is(aa$scheme, "character") expect_equal(aa$scheme, "https") expect_is(aa$domain, "character") expect_true(is.na(aa$path)) expect_true(is.na(aa$parameter)) expect_is(bb, "list") expect_named(bb, c('scheme', 'domain', 'port', 'path', 'parameter', 'fragment')) expect_is(bb$scheme, "character") expect_equal(bb$scheme, "https") expect_is(bb$domain, "character") expect_equal(bb$path, "get") expect_is(bb$parameter, "list") expect_equal(bb$parameter$foo, "bar") expect_is(cc, "list") expect_named(cc, c('scheme', 'domain', 'port', 'path', 'parameter', 'fragment')) expect_is(cc$scheme, "character") expect_equal(cc$scheme, "https") expect_is(cc$domain, "character") expect_equal(cc$path, "get") expect_is(cc$parameter, "list") expect_equal(cc$parameter$foo, "bar") expect_equal(cc$parameter$stuff, "things") }) test_that("parse fails well", { skip_on_cran() # url param required expect_error(url_build(), "argument \"url\" is missing") # wrong types expect_error(url_build(5), "url must be of class character") expect_error(url_build("ASDf", path = 5), "path must be of class character") expect_error(url_build("adff", query = 5), "query must be of class list") # query list is named expect_error(url_build("As", query = list(4, 5)), "all query elements must be named") }) crul/tests/testthat/test-paths.R0000644000176200001440000000236513164342457016457 0ustar liggesuserscontext("paths") test_that("paths work", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$get(path = 'get') expect_is(aa, "HttpResponse") urlsp <- strsplit(aa$url, "/")[[1]] expect_equal(urlsp[length(urlsp)], "get") expect_equal(aa$status_code, 200) }) test_that("path - multiple route paths work", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") bb <- cli$get('status/200') expect_is(bb, "HttpResponse") urlsp <- strsplit(bb$url, "/")[[1]] expect_equal(urlsp[4:5], c('status', '200')) expect_equal(bb$status_code, 200) }) test_that("path - paths don't work if paths already on URL", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org/get/adsfasdf") bb <- cli$get('stuff') expect_is(bb, "HttpResponse") expect_equal(bb$status_code, 404) expect_true(grepl("stuff", bb$url)) expect_false(grepl("adsfasdf", bb$url)) }) test_that("path - work with routes that have spaces", { skip_on_cran() cli <- HttpClient$new(url = "http://www.marinespecies.org") bb <- cli$get('rest/AphiaRecordsByName/Platanista gangetica') expect_is(bb, "HttpResponse") urlsp <- strsplit(bb$url, "/")[[1]] expect_equal(urlsp[length(urlsp)], 'Platanista%20gangetica') }) crul/tests/testthat/test-request.R0000644000176200001440000000346213070473662017026 0ustar liggesuserscontext("HttpRequest") test_that("HttpRequest works", { expect_is(HttpRequest, "R6ClassGenerator") aa <- HttpRequest$new(url = "https://httpbin.org") expect_is(aa, "HttpRequest") expect_null(aa$handle) expect_length(aa$opts, 0) expect_is(aa$url, "character") expect_is(aa$headers, "list") expect_is(aa$post, "function") expect_is(aa$get, "function") expect_is(aa$print, "function") expect_output(aa$print(), " ") }) test_that("HttpRequest - get", { aa <- HttpRequest$new(url = "https://httpbin.org")$get() expect_is(aa, "HttpRequest") expect_equal(aa$method(), "get") expect_equal(aa$url, "https://httpbin.org") }) test_that("HttpRequest - post", { aa <- HttpRequest$new(url = "https://httpbin.org")$post() expect_is(aa, "HttpRequest") expect_equal(aa$method(), "post") expect_equal(aa$url, "https://httpbin.org") }) test_that("HttpRequest - put", { aa <- HttpRequest$new(url = "https://httpbin.org")$put() expect_is(aa, "HttpRequest") expect_equal(aa$method(), "put") expect_equal(aa$url, "https://httpbin.org") }) test_that("HttpRequest - patch", { aa <- HttpRequest$new(url = "https://httpbin.org")$patch() expect_is(aa, "HttpRequest") expect_equal(aa$method(), "patch") expect_equal(aa$url, "https://httpbin.org") }) test_that("HttpRequest - delete", { aa <- HttpRequest$new(url = "https://httpbin.org")$delete() expect_is(aa, "HttpRequest") expect_equal(aa$method(), "delete") expect_equal(aa$url, "https://httpbin.org") }) test_that("HttpRequest - head", { aa <- HttpRequest$new(url = "https://httpbin.org")$head() expect_is(aa, "HttpRequest") expect_equal(aa$method(), "head") expect_equal(aa$url, "https://httpbin.org") }) test_that("HttpRequest fails well", { expect_error(HttpRequest$new(), "need one of url or handle") }) crul/tests/testthat/test-handle.R0000644000176200001440000000046713070473662016573 0ustar liggesuserscontext("handle") test_that("handle - works", { aa <- handle("https://httpbin.org") expect_is(aa, "list") expect_is(aa$url, "character") expect_is(aa$handle, "curl_handle") expect_match(aa$url, "https") }) test_that("handle fails well", { expect_error(handle(), "argument \"url\" is missing") }) crul/tests/testthat/test-asyncvaried.R0000644000176200001440000000643413230425266017643 0ustar liggesuserscontext("AsyncVaried") test_that("AsyncVaried works", { skip_on_cran() expect_is(AsyncVaried, "R6ClassGenerator") req1 <- HttpRequest$new(url = "https://httpbin.org/get")$get() req2 <- HttpRequest$new(url = "https://httpbin.org/post")$post() aa <- AsyncVaried$new(req1, req2) expect_is(aa, "AsyncVaried") expect_is(aa$.__enclos_env__$private$async_request, "function") expect_is(aa$parse, "function") expect_is(aa$content, "function") expect_is(aa$requests, "function") # before requests expect_equal(length(aa$content()), 0) expect_equal(length(aa$status()), 0) expect_equal(length(aa$status_code()), 0) expect_equal(length(aa$times()), 0) # after requests aa$request() expect_equal(length(aa$content()), 2) expect_equal(length(aa$status()), 2) expect_equal(length(aa$status_code()), 2) expect_equal(length(aa$times()), 2) }) test_that("AsyncVaried fails well", { skip_on_cran() expect_error(AsyncVaried$new(), "must pass in at least one request") expect_error(AsyncVaried$new(5), "all inputs must be of class 'HttpRequest'") }) context("AsyncVaried - order of results") test_that("AsyncVaried - order", { skip_on_cran() req1 <- HttpRequest$new(url = "https://httpbin.org/get?a=5")$get() req2 <- HttpRequest$new(url = "https://httpbin.org/get?b=6")$get() req3 <- HttpRequest$new(url = "https://httpbin.org/get?c=7")$get() aa <- AsyncVaried$new(req1, req2, req3) aa$request() out <- aa$responses() expect_is(out, "list") 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("AsyncVaried - disk") test_that("AsyncVaried - writing to disk works", { skip_on_cran() f <- tempfile() g <- tempfile() req1 <- HttpRequest$new(url = "https://httpbin.org/get")$get(disk = f) req2 <- HttpRequest$new(url = "https://httpbin.org/post")$post(disk = g) req3 <- HttpRequest$new(url = "https://httpbin.org/get")$get() out <- AsyncVaried$new(req1, req2, req3) out$request() cont <- out$content() lines_f <- readLines(f) lines_g <- readLines(g) expect_is(out, "AsyncVaried") expect_is(cont, "list") expect_is(cont[[1]], "raw") expect_identical(cont[[1]], raw(0)) expect_is(cont[[2]], "raw") expect_identical(cont[[2]], raw(0)) expect_is(cont[[3]], "raw") expect_gt(length(cont[[3]]), 0) expect_is(lines_f, "character") expect_gt(length(lines_f), 0) expect_is(lines_g, "character") expect_gt(length(lines_g), 0) # cleanup closeAllConnections() }) context("AsyncVaried - stream") test_that("AsyncVaried - streaming to disk works", { skip_on_cran() lst <- c() fun <- function(x) lst <<- c(lst, x) req1 <- HttpRequest$new(url = "https://httpbin.org/get" )$get(query = list(foo = "bar"), stream = fun) req2 <- HttpRequest$new(url = "https://httpbin.org/get" )$get(query = list(hello = "world"), stream = fun) out <- AsyncVaried$new(req1, req2) suppressWarnings(out$request()) expect_is(out, "AsyncVaried") expect_identical(out$responses()[[1]]$content, raw(0)) expect_identical(out$responses()[[2]]$content, raw(0)) expect_is(lst, "raw") expect_is(rawToChar(lst), "character") expect_match(rawToChar(lst), "application/json") }) crul/tests/testthat/test-query.R0000644000176200001440000000174413070473662016504 0ustar liggesuserscontext("query") test_that("query works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$get('get', query = list(hello = "world")) expect_is(aa, "HttpResponse") expect_match(aa$url, "hello") expect_match(aa$url, "world") expect_match(jsonlite::fromJSON(aa$parse())$url, "hello") expect_match(jsonlite::fromJSON(aa$parse())$url, "world") }) test_that("query - multiple params of same name work", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$get('get', query = list(hello = 5, hello = 6)) expect_is(aa, "HttpResponse") expect_equal(length(gregexpr("hello", aa$url)[[1]]), 2) expect_equal( length(gregexpr("hello", jsonlite::fromJSON(aa$parse())$url)[[1]]), 2) }) test_that("query - length 0 query list works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$get('get', query = list()) expect_is(aa, "HttpResponse") expect_false(grepl("\\?", aa$url)) }) crul/tests/testthat/test-head.R0000644000176200001440000000201613230427607016225 0ustar liggesuserscontext("request: head") test_that("head request works", { skip_on_cran() cli <- HttpClient$new(url = "https://www.google.com") aa <- cli$head() expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "head") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) # content is empty expect_equal(aa$content, raw(0)) }) test_that("head - query passed to head doesn't fail", { skip_on_cran() cli <- HttpClient$new(url = "https://www.google.com") aa <- cli$head(query = list(foo = "bar")) expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "head") expect_is(aa$parse, "function") expect_true(aa$success()) expect_match(aa$request$url$url, "foo") expect_match(aa$request$url$url, "bar") # content is empty expect_equal(aa$content, raw(0)) }) crul/tests/testthat/test-mocking.R0000644000176200001440000000303113230270674016751 0ustar liggesuserscontext("mocking: mock function") test_that("crul_opts env", { skip_on_cran() expect_is(crul_opts, "environment") expect_false(crul_opts$mock) }) test_that("mock function", { skip_on_cran() expect_is(mock, "function") expect_true(mock()) expect_true(crul_opts$mock) expect_false(mock(FALSE)) expect_false(crul_opts$mock) }) context("mocking: HttpClient") test_that("mocking with HttpClient", { skip_on_cran() library(webmockr) url <- "https://httpbin.org" st <- stub_request("get", file.path(url, "get")) #webmockr:::webmockr_stub_registry # webmockr IS NOT enabled cli <- HttpClient$new(url = url) aa <- cli$get("get") # webmockr IS enabled mock() bb <- cli$get("get") # content and times differ btw the two expect_is(aa, "HttpResponse") expect_is(bb, "HttpResponse") expect_is(aa$content, "raw") expect_equal(length(bb$content), 0) expect_is(aa$times, "numeric") expect_null(bb$times) }) context("mocking: HttpClient when not stubbed yet") test_that("mocking with HttpClient: ", { skip_on_cran() library(webmockr) url <- "https://httpbin.org" st <- stub_request("get", file.path(url, "get")) #webmockr:::webmockr_stub_registry # webmockr IS NOT enabled cli <- HttpClient$new(url = url) expect_error( cli$post("post"), "Real HTTP connections are disabled" ) expect_error( cli$post("post"), "You can stub this request with the following snippet" ) expect_error( cli$post("post"), "registered request stubs" ) }) # turn mocking off mock(FALSE) crul/tests/testthat/test-patch.R0000644000176200001440000000175413010467710016426 0ustar liggesuserscontext("request: patch") test_that("patch request works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$patch("patch") expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "patch") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) expect_null(aa$request$fields) }) test_that("patch request with body", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$patch("patch", body = list(hello = "world")) expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "patch") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) expect_named(aa$request$fields, "hello") expect_equal(aa$request$fields[[1]], "world") }) crul/tests/testthat/test-async.R0000644000176200001440000001155413230425266016447 0ustar liggesuserscontext("Async - General") test_that("Async works", { skip_on_cran() expect_is(Async, "R6ClassGenerator") aa <- Async$new(urls = c('https://httpbin.org/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, "list") 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", { skip_on_cran() expect_error(Async$new(), "\"urls\" is missing, with no default") }) context("Async - get") test_that("Async - get", { skip_on_cran() aa <- Async$new(urls = c('https://httpbin.org/get', 'https://google.com')) out <- aa$get() expect_is(out, "list") 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", { skip_on_cran() aa <- Async$new(urls = c('https://httpbin.org/post', 'https://httpbin.org/post')) out <- aa$post() expect_is(out, "list") expect_is(out[[1]], "HttpResponse") expect_equal(out[[1]]$method, "post") }) context("Async - put") test_that("Async - put", { skip_on_cran() aa <- Async$new(urls = c('https://httpbin.org/put', 'https://httpbin.org/put')) out <- aa$put() expect_is(out, "list") 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", { skip_on_cran() aa <- Async$new(urls = c('https://httpbin.org/patch', 'https://httpbin.org/patch')) out <- aa$patch() expect_is(out, "list") 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", { skip_on_cran() aa <- Async$new(urls = c('https://httpbin.org/delete', 'https://httpbin.org/delete')) out <- aa$delete() expect_is(out, "list") 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", { skip_on_cran() aa <- Async$new(urls = c('https://google.com', 'https://nytimes.com')) out <- aa$head() expect_is(out, "list") expect_is(out[[1]], "HttpResponse") expect_is(out[[2]], "HttpResponse") expect_equal(out[[1]]$method, "head") expect_equal(out[[2]]$method, "head") }) context("Async - order of results") test_that("Async - order", { skip_on_cran() aa <- Async$new(urls = c('https://httpbin.org/get?a=5', 'https://httpbin.org/get?b=6', 'https://httpbin.org/get?c=7')) out <- aa$get() expect_is(out, "list") 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") test_that("Async - writing to disk works", { skip_on_cran() cc <- Async$new( urls = c( 'https://httpbin.org/get?a=5', 'https://httpbin.org/get?foo=bar', 'https://httpbin.org/get?b=4', 'https://httpbin.org/get?stuff=things', 'https://httpbin.org/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, "list") expect_is(res[[1]], "HttpResponse") expect_is(out, "list") expect_is(out[[1]], "character") }) context("Async - stream") test_that("Async - streaming to disk works", { skip_on_cran() bb <- Async$new(urls = c('https://httpbin.org/get?a=5', 'https://httpbin.org/get?b=6', 'https://httpbin.org/get?c=7')) mylist <- c() fun <- function(x) mylist <<- c(mylist, 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(mylist, "raw") expect_is(rawToChar(mylist), "character") expect_match(rawToChar(mylist), "application/json") }) crul/tests/testthat/test-put.R0000644000176200001440000000174113117574004016136 0ustar liggesuserscontext("request: put") test_that("put request works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$put("put") expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "put") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) expect_null(aa$request$fields) }) test_that("put request with body", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$put("put", body = list(hello = "world")) expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "put") expect_is(aa$parse, "function") expect_is(aa$parse("UTF-8"), "character") expect_true(aa$success()) expect_named(aa$request$fields, "hello") expect_equal(aa$request$fields[[1]], "world") }) crul/tests/testthat/test-post.R0000644000176200001440000000425113164342331016310 0ustar liggesuserscontext("request: post") test_that("post request works", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$post("post") expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "post") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) expect_null(aa$request$fields) }) test_that("post request with body", { skip_on_cran() cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$post("post", body = list(hello = "world")) expect_is(aa, "HttpResponse") expect_is(aa$handle, 'curl_handle') expect_is(aa$content, "raw") expect_is(aa$method, "character") expect_equal(aa$method, "post") expect_is(aa$parse, "function") expect_is(aa$parse(), "character") expect_true(aa$success()) expect_named(aa$request$fields, "hello") expect_equal(aa$request$fields[[1]], "world") }) test_that("post request with file upload", { skip_on_cran() # txt file ## as file file <- upload(system.file("CITATION")) cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$post("post", body = list(a = file)) expect_is(aa, "HttpResponse") expect_is(aa$content, "raw") expect_null(aa$request$options$readfunction) out <- jsonlite::fromJSON(aa$parse("UTF-8")) expect_named(out$files, "a") expect_match(out$files$a, "bibentry") ## as data aa2 <- cli$post("post", body = file) expect_is(aa2, "HttpResponse") expect_is(aa2$content, "raw") expect_is(aa2$request$options$readfunction, "function") out <- jsonlite::fromJSON(aa2$parse("UTF-8")) expect_equal(length(out$files), 0) expect_is(out$data, "character") expect_match(out$data, "bibentry") # binary file: jpeg file <- upload(file.path(Sys.getenv("R_DOC_DIR"), "html/logo.jpg")) cli <- HttpClient$new(url = "https://httpbin.org") aa <- cli$post("post", body = list(a = file)) expect_is(aa, "HttpResponse") expect_is(aa$content, "raw") expect_named(aa$request$fields, "a") out <- jsonlite::fromJSON(aa$parse("UTF-8")) expect_named(out$files, "a") expect_match(out$files$a, "data:image/jpeg") }) crul/tests/testthat/test-auth.R0000644000176200001440000000336213070474352016273 0ustar liggesuserscontext("authenticate") test_that("auth construction works", { basic <- auth(user = "foo", pwd = "bar", auth = "basic") digest <- auth(user = "foo", pwd = "bar", auth = "digest") ntlm <- auth(user = "foo", pwd = "bar", auth = "ntlm") any <- auth(user = "foo", pwd = "bar", auth = "any") expect_is(basic, "auth") expect_is(digest, "auth") expect_is(ntlm, "auth") expect_is(any, "auth") expect_named(basic, c('userpwd', 'httpauth')) expect_named(digest, c('userpwd', 'httpauth')) expect_named(ntlm, c('userpwd', 'httpauth')) expect_named(any, c('userpwd', 'httpauth')) expect_equal(attr(basic, "type"), "basic") expect_equal(attr(digest, "type"), "digest") expect_equal(attr(ntlm, "type"), "ntlm") expect_equal(attr(any, "type"), "any") }) test_that("auth works with HttpClient", { aa <- HttpClient$new( url = "https://httpbin.org/basic-auth/user/passwd", auth = auth(user = "foo", pwd = "bar") ) expect_is(aa, "HttpClient") expect_is(aa$auth, "auth") expect_equal(aa$auth$userpwd, "foo:bar") expect_equal(aa$auth$httpauth, 1) }) test_that("auth works with HttpRequest", { aa <- HttpRequest$new( url = "https://httpbin.org/basic-auth/user/passwd", auth = auth(user = "foo", pwd = "bar") ) expect_is(aa, "HttpRequest") expect_is(aa$auth, "auth") expect_equal(aa$auth$userpwd, "foo:bar") expect_equal(aa$auth$httpauth, 1) }) test_that("auth fails well", { expect_error(auth(), "argument \"user\" is missing") expect_error(auth(user = "asdf"), "argument \"pwd\" is missing") expect_error(auth(5, 5), "user must be of class character") expect_error(auth("adsf", 5), "pwd must be of class character") expect_error( auth("asdf", "asdf", 5), "inherits\\(x, \"character\"\\) is not TRUE") }) crul/tests/testthat/test-paginator.R0000644000176200001440000000242313230270674017312 0ustar liggesuserscontext("Paginator") cli <- HttpClient$new(url = "http://api.crossref.org") aa <- Paginator$new(client = cli, by = "query_params", limit_param = "rows", offset_param = "offset", limit = 50, limit_chunk = 10) test_that("Paginator works", { skip_on_cran() expect_is(cli, "HttpClient") expect_is(Paginator, "R6ClassGenerator") expect_is(aa, "Paginator") expect_is(aa$.__enclos_env__$private$page, "function") expect_is(aa$parse, "function") expect_is(aa$content, "function") expect_is(aa$responses, "function") # before requests expect_equal(length(aa$content()), 0) expect_equal(length(aa$status()), 0) expect_equal(length(aa$status_code()), 0) expect_equal(length(aa$times()), 0) # after requests invisible(aa$get("works")) expect_equal(length(aa$content()), 5) expect_equal(length(aa$status()), 5) expect_equal(length(aa$status_code()), 5) expect_equal(length(aa$times()), 5) }) test_that("Paginator fails well", { skip_on_cran() expect_error(Paginator$new(), "argument \"client\" is missing") expect_error(Paginator$new(cli), "'to' must be of length 1") expect_error(Paginator$new(cli, 5), "'by' has to be 'query_params' for now") expect_error(Paginator$new(5, "query_params"), "'client' has to be an object of class 'HttpClient'") }) crul/tests/testthat/test-response.R0000644000176200001440000000174213070473662017173 0ustar liggesuserscontext("HttpResponse") test_that("HttpResponse works", { expect_is(HttpResponse, "R6ClassGenerator") aa <- HttpResponse$new( method = "get", url = "https://httpbin.org", status_code = 201, request_headers = list(useragent = "foo bar"), content = charToRaw("hello world"), request = list() ) expect_is(aa, "HttpResponse") expect_null(aa$handle) expect_null(aa$opts) expect_is(aa$url, "character") expect_is(aa$method, "character") expect_is(aa$content, "raw") expect_null(aa$modified) expect_is(aa$parse, "function") expect_is(aa$raise_for_status, "function") expect_is(aa$request_headers, "list") expect_null(aa$response_headers) expect_equal(aa$status_code, 201) expect_is(aa$status_http, "function") expect_is(aa$success, "function") expect_true(aa$success()) expect_null(aa$times) expect_is(aa$request, "list") }) test_that("HttpResponse fails well", { expect_error(HttpResponse$new(), "argument \"url\" is missing") }) crul/tests/test-all.R0000644000176200001440000000004713004760142014227 0ustar liggesuserslibrary("testthat") test_check("crul") crul/NAMESPACE0000644000176200001440000000154113230270674012443 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method(as.character,form_file) export(Async) export(AsyncVaried) export(HttpClient) export(HttpRequest) export(HttpResponse) export(HttpStubbedResponse) export(Paginator) export(auth) export(handle) export(mock) export(proxy) export(upload) export(url_build) export(url_parse) importFrom(R6,R6Class) importFrom(curl,curl_escape) importFrom(curl,curl_fetch_disk) importFrom(curl,curl_fetch_memory) importFrom(curl,curl_fetch_stream) importFrom(curl,curl_options) importFrom(curl,curl_version) importFrom(curl,handle_reset) importFrom(curl,handle_setform) importFrom(curl,handle_setheaders) importFrom(curl,handle_setopt) importFrom(curl,multi_add) importFrom(curl,multi_cancel) importFrom(curl,multi_list) importFrom(curl,multi_run) importFrom(curl,new_handle) importFrom(curl,new_pool) importFrom(curl,parse_headers) crul/NEWS.md0000644000176200001440000001323113230435473012321 0ustar liggesuserscrul 0.5.0 ========== ### NEW FEATURES * Gains a new R6 class `Paginator` to help users automatically paginate through multiple requests. It only supports query parameter based paginating for now. We'll add support later for other types including cursors (e.g., used in Solr servers), and for link headers (e.g., used in the GitHub API). Please get in touch if you find any problems with `Paginator`. (#56) * Async classes `Async` and `Asyncvaried` gain ability to write to disk and stream data (to disk or elsewhere, e.g. R console or to an R object) (#46) thanks @artemklevtsov for the push to do this ### MINOR IMPROVEMENTS * Improved documentation for `auth` to indicate that `user` and `pwd` are indeed required - and to further indicate that one can pass in `NULL` to those parameters (similar to an empty string `""` in `httr::authenticate`) when one e.g. may want to use `gssnegotiate` method (#43) * Fixed query builder so that one can now protect query parameters by wrapping them in `I()` (#55) ### BUG FIXES * Fixed bug in `head` requests with `HttpClient` when passing `query` parameter - it was failing previously. Added `query` parameter back. (#52) crul 0.4.0 ========== ### NEW FEATURES * file uploads now work, see new function `upload()` and examples (#25) ### MINOR IMPROVEMENTS * fixes to reused curl handles - within a connection object only, not across connection objects (#45) * `crul` now drops any options passed in to `opts` or to `...` that are not in set of allowed curl options, see `curl::curl_options()` (#49) * cookies should now be persisted across requests within a connection object, see new doc `?cookies` for how to set cookies (#44) * gather cainfo and use in curl options when applicable (#51) * remove `disk` and `stream` from `head` method in `HttpClient` and `HttpRequest` as no body returned in a HEAD request crul 0.3.8 ========== ### BUG FIXES * Fixed `AsyncVaried` to return async responses in the order that they were passed in. This also fixes this exact same behavior in `Async` because `Async` uses `AsyncVaried` internally. (#41) thanks @dirkschumacher for reporting crul 0.3.6 ========== * Note: This version gains support for integration with `webmockr`, which is now on CRAN. ### NEW FEATURES * New function `auth()` to do simple authentication (#33) * New function `HttpStubbedResponse` for making a stubbed response object for the `webmockr` integration (#4) * New function `mock()` to turn on mocking - it's off by default. If `webmockr` is not installed but user attempts to use mocking we error with message to install `webmockr` (#4) ### MINOR IMPROVEMENTS * Use `gzip-deflate` by deafult for each request to make sure gzip compression is used if the server can do it (#34) * Change `useragent` to `User-Agent` as default user agent header (#35) * Now we make sure that user supplied headers override the default headers if they are of the same name (#36) crul 0.3.4 ========== ### NEW FEATURES * New utility functions `url_build` and `url_parse` (#31) ### MINOR IMPROVEMENTS * Now using markdown for documentation (#32) * Better documentation for `AsyncVaried` (#30) * New vignette on how to use `crul` in realistic scenarios rather than brief examples to demonstrate individual features (#29) * Better documentation for `HttpRequest` (#28) * Included more tests ### BUG FIXES * Fixed put/patch/delete as weren't passing body correctly in `HttpClient` (#26) * DRY out code for preparing requests - simplify to use helper functions (#27) crul 0.3.0 ========== ### NEW FEATURES * Added support for asynchronous HTTP requests, including two new R6 classes: `Async` and `AsyncVaried`. The former being a simpler interface treating all URLs with same options/HTTP method, and the latter allowing any type of request through the new R6 class `HttpRequest` (#8) (#24) * New R6 class `HttpRequest` to support `AsyncVaried` - this method only defines a request, but does not execute it. (#8) ### MINOR IMPROVEMENTS * Added support for proxies (#22) ### BUG FIXES * Fixed parsing of headers from FTP servers (#21) crul 0.2.0 ========== ### MINOR IMPROVEMENTS * Created new manual files for various tasks to document usage better (#19) * URL encode paths - should fix any bugs where spaces between words caused errors previously (#17) * URL encode query parameters - should fix any bugs where spaces between words caused errors previously (#11) * request headers now passed correctly to response object (#13) * response headers now parsed to a list for easier access (#14) * Now supporting multiple query parameters of the same name, wasn't possible in last version (#15) crul 0.1.6 ========== ### NEW FEATURES * Improved options for using curl options. Can manually add to list of curl options or pass in via `...`. And we check that user doesn't pass in prohibited options (`curl` package takes care of checking that options are valid) (#5) * Incorporated `fauxpas` package for dealing with HTTP conditions. It's a Suggest, so only used if installed (#6) * Added support for streaming via `curl::curl_fetch_stream`. `stream` param defaults to `NULL` (thus ignored), or pass in a function to use streaming. Only one of memory, streaming or disk allowed. (#9) * Added support for streaming via `curl::curl_fetch_disk`. `disk` param defaults to `NULL` (thus ignored), or pass in a path to write to disk instead of use memory. Only one of memory, streaming or disk allowed. (#12) ### MINOR IMPROVEMENTS * Added missing `raise_for_status()` method on the `HttpResponse` class (#10) ### BUG FIXES * Was importing `httpcode` but wasn't using it in the package. Now using the package in `HttpResponse` crul 0.1.0 ========== ### NEW FEATURES * Released to CRAN. crul/R/0000755000176200001440000000000013231433525011421 5ustar liggesuserscrul/R/upload.R0000644000176200001440000000065013164335761013041 0ustar liggesusers#' upload file #' #' @export #' @param path (character) a single path, file must exist #' @param type (character) a file type, guessed by [mime::guess_type] if #' not given upload <- function(path, type = NULL) { stopifnot(is.character(path), length(path) == 1, file.exists(path)) if (is.null(type)) type <- mime::guess_type(path) curl::form_file(path, type) } #' @export as.character.form_file <- function(x, ...) x crul/R/make_url.R0000644000176200001440000000442413230270674013352 0ustar liggesusersmake_url <- function(url = NULL, handle = NULL, path, query) { if (!is.null(handle)) { url <- handle$url } else { handle <- handle_find(url) url <- handle$url } if (!is.null(path)) { urltools::path(url) <- path } url <- gsub("\\s", "%20", url) url <- add_query(query, url) return(list(url = url, handle = handle$handle)) } # query <- list(a = 5, a = 6) # query <- list(a = 5) # query <- list() # add_query(query, "https://httpbin.org") add_query <- function(x, url) { if (length(x)) { quer <- list() for (i in seq_along(x)) { if (!inherits(x[[i]], "AsIs")) { x[[i]] <- urltools::url_encode(x[[i]]) } quer[[i]] <- paste(names(x)[i], x[[i]], sep = "=") #quer[[i]] <- paste(names(x)[i], urltools::url_encode(x[[i]]), sep = "=") } parms <- paste0(quer, collapse = "&") paste0(url, "?", parms) } else { return(url) } } #' Build and parse URLs #' #' @export #' @param url (character) a url #' @param path (character) a path #' @param query (list) a named list of query parameters #' @return `url_build` returns a character string URL; `url_parse` #' returns a list with URL components #' @examples #' url_build("https://httpbin.org") #' url_build("https://httpbin.org", "get") #' url_build("https://httpbin.org", "post") #' url_build("https://httpbin.org", "get", list(foo = "bar")) #' #' url_parse("httpbin.org") #' url_parse("http://httpbin.org") #' url_parse(url = "https://httpbin.org") #' url_parse("https://httpbin.org/get") #' url_parse("https://httpbin.org/get?foo=bar") #' url_parse("https://httpbin.org/get?foo=bar&stuff=things") #' url_parse("https://httpbin.org/get?foo=bar&stuff=things[]") url_build <- function(url, path = NULL, query = NULL) { assert(url, "character") assert(path, "character") assert(query, "list") if (!has_namez(query)) stop("all query elements must be named", call. = FALSE) make_url(url, handle = NULL, path, query)$url } #' @export #' @rdname url_build url_parse <- function(url) { tmp <- urltools::url_parse(url) tmp <- as.list(tmp) if (!is.na(tmp$parameter)) { tmp$parameter <- unlist( lapply(strsplit(tmp$parameter, "&")[[1]], function(x) { z <- strsplit(x, split = "=")[[1]] as.list(stats::setNames(z[2], z[1])) }), FALSE) } return(tmp) } crul/R/curl_options.R0000644000176200001440000000054713040733452014272 0ustar liggesusersnonacccurl <- c("httpget", "httppost", "post", "postfields", "postfieldsize", "customrequest") curl_opts_check <- function(...) { x <- list(...) if (any(names(x) %in% nonacccurl)) { stop( paste0("the following curl options are not allowed:\n ", paste(nonacccurl, collapse = ", ")), call. = FALSE ) } } crul/R/crul-package.r0000644000176200001440000000254113230270674014147 0ustar liggesusers#' **HTTP R client** #' #' @section Package API: #' \itemize{ #' \item [HttpClient()] - create a connection client, set all #' your http options, make http requests #' \item [HttpResponse()] - mostly for internal use, handles #' http responses #' \item [Paginator()] - auto-paginate through requests #' \item [Async()] - asynchronous requests #' \item [AsyncVaried()] - varied asynchronous requests #' \item [HttpRequest()] - generate an HTTP request, mostly for #' use in building requests to be used in `Async` or `AsyncVaried` #' \item [mock()] - Turn on/off mocking, via `webmockr` #' \item [auth()] - Simple authentication helper #' \item [proxy()] - Proxy helper #' } #' #' @section HTTP conditions: #' We use `fauxpas` if you have it installed for handling HTTP #' conditions but if it's not installed we use \pkg{httpcode} #' #' @section Mocking: #' Mocking HTTP requests is supported via the \pkg{webmockr} #' package. See [mock] for guidance. #' #' @importFrom curl curl_escape curl_fetch_disk curl_fetch_memory #' curl_fetch_stream curl_options curl_version handle_reset handle_setform #' handle_setheaders handle_setopt multi_add multi_cancel multi_list #' multi_run new_handle new_pool parse_headers #' @importFrom R6 R6Class #' @name crul-package #' @aliases crul #' @author Scott Chamberlain \email{myrmecocystus@@gmail.com} #' @docType package NULL crul/R/async.R0000644000176200001440000001273013230425266012666 0ustar liggesusers#' Simple async client #' #' A client to work with many URLs, but all with the same HTTP method #' #' @export #' @param urls (character) one or more URLs (required) #' @family async #' @details #' **Methods** #' \describe{ #' \item{`get(path, query, disk, stream, ...)`}{ #' make async GET requests for all URLs #' } #' \item{`post(path, query, body, encode, disk, stream, ...)`}{ #' make async POST requests for all URLs #' } #' \item{`put(path, query, body, encode, disk, stream, ...)`}{ #' make async PUT requests for all URLs #' } #' \item{`patch(path, query, body, encode, disk, stream, ...)`}{ #' make async PATCH requests for all URLs #' } #' \item{`delete(path, query, body, encode, disk, stream, ...)`}{ #' make async DELETE requests for all URLs #' } #' \item{`head(path, ...)`}{ #' make async HEAD requests for all URLs #' } #' } #' #' See [HttpClient()] for information on parameters. #' #' @format NULL #' @usage NULL #' @return a list, with objects of class [HttpResponse()]. #' Responses are returned in the order they are passed in. #' @examples \dontrun{ #' cc <- Async$new( #' urls = c( #' 'https://httpbin.org/', #' 'https://httpbin.org/get?a=5', #' 'https://httpbin.org/get?foo=bar' #' ) #' ) #' cc #' (res <- cc$get()) #' res[[1]] #' res[[1]]$url #' res[[1]]$success() #' res[[1]]$status_http() #' res[[1]]$response_headers #' res[[1]]$method #' res[[1]]$content #' res[[1]]$parse("UTF-8") #' #' lapply(res, function(z) z$parse("UTF-8")) #' } Async <- R6::R6Class( 'Async', public = list( urls = NULL, print = function(x, ...) { cat(" ", sep = "\n") cat(" urls: ", sep = "\n") for (i in seq_along(self$urls)) { cat(paste0(" ", self$urls[[i]]), sep = "\n") } invisible(self) }, initialize = function(urls) { self$urls <- urls }, get = function(path = NULL, query = list(), disk = NULL, stream = NULL, ...) { private$gen_interface(self$urls, "get", path, query, disk = disk, stream = stream, ...) }, post = function(path = NULL, query = list(), body = NULL, encode = "multipart", disk = NULL, stream = NULL, ...) { private$gen_interface(self$urls, "post", path, query, body, encode, disk, stream, ...) }, put = function(path = NULL, query = list(), body = NULL, encode = "multipart", disk = NULL, stream = NULL, ...) { private$gen_interface(self$urls, "put", path, query, body, encode, disk, stream, ...) }, patch = function(path = NULL, query = list(), body = NULL, encode = "multipart", disk = NULL, stream = NULL, ...) { private$gen_interface(self$urls, "patch", path, query, body, encode, disk, stream, ...) }, delete = function(path = NULL, query = list(), body = NULL, encode = "multipart", disk = NULL, stream = NULL, ...) { private$gen_interface(self$urls, "delete", path, query, body, encode, disk, stream, ...) }, head = function(path = NULL, ...) { private$gen_interface(self$urls, "head", path, ...) } ), private = list( gen_interface = function(x, method, path, query = NULL, body = 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)$get(path = path, query = query, disk = m, stream = stream, ...), post = HttpRequest$new(url = z)$post(path = path, query = query, body = body, encode = encode, disk = m, stream = stream, ...), put = HttpRequest$new(url = z)$put(path = path, query = query, body = body, encode = encode, disk = m, stream = stream, ...), patch = HttpRequest$new(url = z)$patch(path = path, query = query, body = body, encode = encode, disk = m, stream = stream, ...), delete = HttpRequest$new(url = z)$delete(path = path, query = query, body = body, encode = encode, disk = m, stream = stream, ...), head = HttpRequest$new(url = z)$head(path = path, ...) ) }, x, disk) } } else { reqs <- lapply(x, function(z) { switch( method, get = HttpRequest$new(url = z)$get(path = path, query = query, disk = disk, stream = stream, ...), post = HttpRequest$new(url = z)$post(path = path, query = query, body = body, encode = encode, disk = disk, stream = stream, ...), put = HttpRequest$new(url = z)$put(path = path, query = query, body = body, encode = encode, disk = disk, stream = stream, ...), patch = HttpRequest$new(url = z)$patch(path = path, query = query, body = body, encode = encode, disk = disk, stream = stream, ...), delete = HttpRequest$new(url = z)$delete(path = path, query = query, body = body, encode = encode, disk = disk, stream = stream, ...), head = HttpRequest$new(url = z)$head(path = path, ...) ) }) } tmp <- AsyncVaried$new(.list = reqs) tmp$request() tmp$responses() } ) ) crul/R/onLoad.R0000644000176200001440000000015613106761536012771 0ustar liggesuserscrul_opts = NULL .onLoad <- function(libname, pkgname){ crul_opts <<- new.env() crul_opts$mock <<- FALSE } crul/R/auth.R0000644000176200001440000000301113230431355012476 0ustar liggesusers#' Authentication #' #' @export #' @param user (character) username, required. see Details. #' @param pwd (character) password, required. see Details. #' @param auth (character) authentication type, one of basic (default), #' digest, digest_ie, gssnegotiate, ntlm, or any. required #' #' @details #' Only supporting simple auth for now, OAuth later maybe. #' #' For `user` and `pwd` you are required to pass in some value. #' The value can be `NULL` to - which is equivalent to passing in an #' empty string like `""` in `httr::authenticate`. You may want to pass #' in `NULL` for both `user` and `pwd` for example if you are using #' `gssnegotiate` auth type. See example below. #' #' @examples #' auth(user = "foo", pwd = "bar", auth = "basic") #' auth(user = "foo", pwd = "bar", auth = "digest") #' auth(user = "foo", pwd = "bar", auth = "ntlm") #' auth(user = "foo", pwd = "bar", auth = "any") #' #' # with HttpClient #' (res <- HttpClient$new( #' url = "https://httpbin.org/basic-auth/user/passwd", #' auth = auth(user = "user", pwd = "passwd") #' )) #' res$auth #' x <- res$get() #' jsonlite::fromJSON(x$parse("UTF-8")) #' #' # with HttpRequest #' (res <- HttpRequest$new( #' url = "https://httpbin.org/basic-auth/user/passwd", #' auth = auth(user = "user", pwd = "passwd") #' )) #' res$auth #' #' # gssnegotiate auth #' auth(NULL, NULL, "gssnegotiate") auth <- function(user, pwd, auth = "basic") { structure(ccp(list( userpwd = make_up(user, pwd), httpauth = auth_type(auth) )), class = "auth", type = auth) } crul/R/cookies.R0000644000176200001440000000222413163022720013173 0ustar liggesusers#' Working with cookies #' #' @name cookies #' @examples #' x <- HttpClient$new( #' url = "https://httpbin.org", #' opts = list( #' cookie = "c=1;f=5", #' verbose = TRUE #' ) #' ) #' x #' #' # set cookies #' (res <- x$get("cookies")) #' jsonlite::fromJSON(res$parse("UTF-8")) #' #' (x <- HttpClient$new(url = "https://httpbin.org")) #' res <- x$get("cookies/set", query = list(foo = 123, bar = "ftw")) #' jsonlite::fromJSON(res$parse("UTF-8")) #' curl::handle_cookies(handle = res$handle) #' #' # reuse handle #' res2 <- x$get("get", query = list(hello = "world")) #' jsonlite::fromJSON(res2$parse("UTF-8")) #' curl::handle_cookies(handle = res2$handle) #' #' # DOAJ #' x <- HttpClient$new(url = "https://doaj.org") #' res <- x$get("api/v1/journals/f3f2e7f23d444370ae5f5199f85bc100", #' verbose = TRUE) #' res$response_headers$`set-cookie` #' curl::handle_cookies(handle = res$handle) #' res2 <- x$get("api/v1/journals/9abfb36b06404e8a8566e1a44180bbdc", #' verbose = TRUE) #' #' ## reset handle #' x$handle_pop() #' ## cookies no longer sent, as handle reset #' res2 <- x$get("api/v1/journals/9abfb36b06404e8a8566e1a44180bbdc", #' verbose = TRUE) NULL crul/R/asyncvaried.R0000644000176200001440000001565413230425266014071 0ustar liggesusers#' Async client for different request types #' #' @export #' @param ...,.list Any number of objects of class [HttpRequest()], #' must supply inputs to one of these parameters, but not both #' @family async #' @return An object of class `AsyncVaried` with variables and methods. #' Responses are returned in the order they are passed in. #' @details #' **Methods** #' \describe{ #' \item{`request()`}{ #' Execute asynchronous requests #' - returns: nothing, responses stored inside object, #' though will print messages if you choose verbose output #' } #' \item{`requests()`}{ #' list requests #' - returns: a list of `HttpRequest` objects, empty list before #' requests made #' } #' \item{`responses()`}{ #' list responses #' - returns: a list of `HttpResponse` objects, empty list before #' requests made #' } #' \item{`parse(encoding = "UTF-8")`}{ #' parse content #' - returns: character vector, empty character vector before #' requests made #' } #' \item{`status_code()`}{ #' (integer) HTTP status codes #' - returns: numeric vector, empty numeric vector before #' requests made #' } #' \item{`status()`}{ #' (list) HTTP status objects #' - returns: a list of `http_code` objects, empty list before #' requests made #' } #' \item{`content()`}{ #' raw content #' - returns: raw list, empty list before requests made #' } #' \item{`times()`}{ #' curl request times #' - returns: list of named numeric vectors, empty list before #' requests made #' } #' } #' #' @format NULL #' @usage NULL #' @examples \dontrun{ #' # pass in requests via ... #' req1 <- HttpRequest$new( #' url = "https://httpbin.org/get", #' opts = list(verbose = TRUE), #' headers = list(foo = "bar") #' )$get() #' req2 <- HttpRequest$new(url = "https://httpbin.org/post")$post() #' #' # Create an AsyncVaried object #' out <- AsyncVaried$new(req1, req2) #' #' # before you make requests, the methods return empty objects #' out$status() #' out$status_code() #' out$content() #' out$times() #' out$parse() #' out$responses() #' #' # make requests #' out$request() #' #' # access various parts #' ## http status objects #' out$status() #' ## status codes #' out$status_code() #' ## content (raw data) #' out$content() #' ## times #' out$times() #' ## parsed content #' out$parse() #' ## response objects #' out$responses() #' #' # pass in requests in a list via .list param #' reqlist <- list( #' HttpRequest$new(url = "https://httpbin.org/get")$get(), #' HttpRequest$new(url = "https://httpbin.org/post")$post(), #' HttpRequest$new(url = "https://httpbin.org/put")$put(), #' HttpRequest$new(url = "https://httpbin.org/delete")$delete(), #' HttpRequest$new(url = "https://httpbin.org/get?g=5")$get(), #' HttpRequest$new( #' url = "https://httpbin.org/post")$post(body = list(y = 9)), #' HttpRequest$new( #' url = "https://httpbin.org/get")$get(query = list(hello = "world")) #' ) #' #' out <- AsyncVaried$new(.list = reqlist) #' out$request() #' out$status() #' out$status_code() #' out$content() #' out$times() #' out$parse() #' } AsyncVaried <- R6::R6Class( 'AsyncVaried', public = list( print = function(x, ...) { cat(" ", sep = "\n") cat(" requests: ", sep = "\n") for (i in seq_along(private$reqs)) { cat(sprintf(" %s: %s", private$reqs[[i]]$payload$method, private$reqs[[i]]$url), "\n") } invisible(self) }, initialize = function(..., .list = list()) { if (length(.list)) { private$reqs <- .list } else { private$reqs <- list(...) } if (length(private$reqs) == 0) { stop("must pass in at least one request", call. = FALSE) } if ( any(vapply(private$reqs, function(x) class(x)[1], "") != "HttpRequest") ) { stop("all inputs must be of class 'HttpRequest'", call. = FALSE) } }, request = function() { private$output <- private$async_request(private$reqs) }, responses = function() { private$output %||% list() }, requests = function() { private$reqs }, parse = function(encoding = "UTF-8") { vapply(private$output, function(z) z$parse(encoding = encoding), "") }, status_code = function() { vapply(private$output, function(z) z$status_code, 1) }, status = function() { lapply(private$output, function(z) z$status_http()) }, content = function() { lapply(private$output, function(z) z$content) }, times = function() { lapply(private$output, function(z) z$times) } ), private = list( reqs = NULL, output = NULL, reqq = NULL, async_request = function(reqs) { crulpool <- curl::new_pool() multi_res <- list() make_request <- function(i) { w <- reqs[[i]]$payload h <- w$url$handle curl::handle_setopt(h, .list = w$options) if (!is.null(w$fields)) { curl::handle_setform(h, .list = w$fields) } curl::handle_setheaders(h, .list = w$headers) if (is.null(w$disk) && is.null(w$stream)) { curl::multi_add( handle = h, done = function(res) multi_res[[i]] <<- res, pool = crulpool ) } else { if (!is.null(w$disk) && is.null(w$stream)) { stopifnot(inherits(w$disk, "character")) ff <- file(w$disk, open = "wb") curl::multi_add( handle = h, done = function(res) multi_res[[i]] <<- res, data = ff, pool = crulpool ) } else if (is.null(w$disk) && !is.null(w$stream)) { stopifnot(is.function(w$stream)) curl::multi_add( handle = h, done = function(res) multi_res[[i]] <<- res, data = w$stream, pool = crulpool ) } } } for (i in seq_along(reqs)) make_request(i) # run all requests curl::multi_run(pool = crulpool) remain <- curl::multi_list(crulpool) if (length(remain)) lapply(remain, curl::multi_cancel) multi_res <- ccp(multi_res) Map(function(z, b) { HttpResponse$new( method = b$payload$method, url = z$url, status_code = z$status_code, request_headers = c(useragent = b$payload$options$useragent, b$headers), response_headers = { if (grepl("^ftp://", z$url)) { list() } else { headers_parse(curl::parse_headers(rawToChar(z$headers))) } }, modified = z$modified, times = z$times, content = z$content, handle = b$handle, request = b ) }, multi_res, reqs) } ) ) crul/R/writing-options.R0000644000176200001440000000405513230425266014726 0ustar liggesusers#' Writing data options #' #' @name writing-options #' @examples #' # write to disk #' (x <- HttpClient$new(url = "https://httpbin.org")) #' f <- tempfile() #' res <- x$get("get", disk = f) #' res$content # when using write to disk, content is a path #' readLines(res$content) #' close(file(f)) #' #' # streaming response #' (x <- HttpClient$new(url = "https://httpbin.org")) #' res <- x$get('stream/50', stream = function(x) cat(rawToChar(x))) #' res$content # when streaming, content is NULL #' #' #' ## Async #' (cc <- Async$new( #' urls = c( #' 'https://httpbin.org/get?a=5', #' 'https://httpbin.org/get?foo=bar', #' 'https://httpbin.org/get?b=4', #' 'https://httpbin.org/get?stuff=things', #' 'https://httpbin.org/get?b=4&g=7&u=9&z=1' #' ) #' )) #' files <- replicate(5, tempfile()) #' (res <- cc$get(disk = files, verbose = TRUE)) #' lapply(files, readLines) #' #' ## Async varied #' ### disk #' f <- tempfile() #' g <- tempfile() #' req1 <- HttpRequest$new(url = "https://httpbin.org/get")$get(disk = f) #' req2 <- HttpRequest$new(url = "https://httpbin.org/post")$post(disk = g) #' req3 <- HttpRequest$new(url = "https://httpbin.org/get")$get() #' (out <- AsyncVaried$new(req1, req2, req3)) #' out$request() #' out$content() #' readLines(f) #' readLines(g) #' close(file(f)) #' close(file(g)) #' #' ### stream - to console #' fun <- function(x) cat(rawToChar(x)) #' req1 <- HttpRequest$new(url = "https://httpbin.org/get" #' )$get(query = list(foo = "bar"), stream = fun) #' req2 <- HttpRequest$new(url = "https://httpbin.org/get" #' )$get(query = list(hello = "world"), stream = fun) #' (out <- AsyncVaried$new(req1, req2)) #' out$request() #' out$content() #' #' ### stream - to an R object #' lst <- c() #' fun <- function(x) lst <<- c(lst, x) #' req1 <- HttpRequest$new(url = "https://httpbin.org/get" #' )$get(query = list(foo = "bar"), stream = fun) #' req2 <- HttpRequest$new(url = "https://httpbin.org/get" #' )$get(query = list(hello = "world"), stream = fun) #' (out <- AsyncVaried$new(req1, req2)) #' out$request() #' lst #' cat(rawToChar(lst)) NULL crul/R/handle.R0000644000176200001440000000163313163023707013003 0ustar liggesusers#' Make a handle #' #' @export #' @param url (character) A url. required. #' @param ... options passed on to [curl::new_handle()] #' @examples #' handle("https://httpbin.org") #' #' # handles - pass in your own handle #' h <- handle("https://httpbin.org") #' (res <- HttpClient$new(handle = h)) #' out <- res$get("get") handle <- function(url, ...) { list(url = url, handle = curl::new_handle(...)) } handle_pop <- function(url) { name <- handle_make(url) if (exists(name, envir = crul_global_pool)) { rm(list = name, envir = crul_global_pool) } } handle_make <- function(x) { urltools::url_compose(urltools::url_parse(x)) } crul_global_pool <- new.env(hash = TRUE, parent = emptyenv()) handle_find <- function(x) { z <- handle_make(x) if (exists(z, crul_global_pool)) { handle <- crul_global_pool[[z]] } else { handle <- handle(z) crul_global_pool[[z]] <- handle } return(handle) } crul/R/httprequest.R0000644000176200001440000001602313164465737014155 0ustar liggesusers#' HTTP request object #' #' @export #' @template args #' @seealso [post-requests], [delete-requests], #' [http-headers], [writing-options] #' #' @details This R6 class doesn't do actual HTTP requests as does #' [HttpClient()] - it is for building requests to use for async HTTP #' requests in [AsyncVaried()] #' #' Note that you can access HTTP verbs after creating an `HttpRequest` #' object, just as you can with `HttpClient`. See examples for usage. #' #' Also note that when you call HTTP verbs on a `HttpRequest` object you #' don't need to assign the new object to a variable as the new details #' you've added are added to the object itself. #' #' **Methods** #' \describe{ #' \item{`get(path, query, disk, stream, ...)`}{ #' Define a GET request #' } #' \item{`post(path, query, body, disk, stream, ...)`}{ #' Define a POST request #' } #' \item{`put(path, query, body, disk, stream, ...)`}{ #' Define a PUT request #' } #' \item{`patch(path, query, body, disk, stream, ...)`}{ #' Define a PATCH request #' } #' \item{`delete(path, query, body, disk, stream, ...)`}{ #' Define a DELETE request #' } #' \item{`head(path, ...)`}{ #' Define a HEAD request #' } #' \item{`method()`}{ #' Get the HTTP method (if defined) #' - returns character string #' } #' } #' #' See [HttpClient()] for information on parameters. #' #' @format NULL #' @usage NULL #' #' @examples #' x <- HttpRequest$new(url = "https://httpbin.org/get") #' ## note here how the HTTP method is shown on the first line to the right #' x$get() #' #' ## assign to a new object to keep the output #' z <- x$get() #' ### get the HTTP method #' z$method() #' #' (x <- HttpRequest$new(url = "https://httpbin.org/get")$get()) #' x$url #' x$payload #' #' (x <- HttpRequest$new(url = "https://httpbin.org/post")) #' x$post(body = list(foo = "bar")) #' #' HttpRequest$new( #' url = "https://httpbin.org/get", #' headers = list( #' `Content-Type` = "application/json" #' ) #' ) HttpRequest <- R6::R6Class( 'HttpRequest', public = list( url = NULL, opts = list(), proxies = list(), auth = list(), headers = list(), handle = NULL, payload = NULL, print = function(x, ...) { cat(paste0(" ", self$method()), sep = "\n") cat(paste0(" url: ", if (is.null(self$url)) self$handle$url else self$url), 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") } invisible(self) }, initialize = function(url, opts, proxies, auth, headers, handle) { if (!missing(url)) self$url <- url if (!missing(opts)) self$opts <- opts if (!missing(proxies)) { if (!inherits(proxies, "proxy")) { stop("proxies input must be of class proxy", call. = FALSE) } self$proxies <- proxies } if (!missing(auth)) self$auth <- auth if (!missing(headers)) self$headers <- headers if (!missing(handle)) self$handle <- handle if (is.null(self$url) && is.null(self$handle)) { stop("need one of url or handle", call. = FALSE) } }, get = function(path = NULL, query = list(), disk = NULL, stream = NULL, ...) { curl_opts_check(...) url <- make_url_async(self$url, self$handle, path, query) rr <- list( url = url, method = "get", options = ccp(list(httpget = TRUE, cainfo = find_cert_bundle())), headers = def_head() ) rr$headers <- norm_headers(rr$headers, self$headers) rr$options <- utils::modifyList( rr$options, c(self$opts, self$proxies, self$auth, ...)) rr$disk <- disk rr$stream <- stream self$payload <- rr return(self) }, post = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- make_url_async(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("post", url, self, opts, ...) rr$disk <- disk rr$stream <- stream self$payload <- rr return(self) }, put = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- make_url_async(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("put", url, self, opts, ...) rr$disk <- disk rr$stream <- stream self$payload <- rr return(self) }, patch = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- make_url_async(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("patch", url, self, opts, ...) rr$disk <- disk rr$stream <- stream self$payload <- rr return(self) }, delete = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- make_url_async(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("delete", url, self, opts, ...) rr$disk <- disk rr$stream <- stream self$payload <- rr return(self) }, head = function(path = NULL, ...) { curl_opts_check(...) url <- make_url_async(self$url, self$handle, path, NULL) opts <- list(customrequest = "HEAD", nobody = TRUE) rr <- list( url = url, method = "head", options = ccp(c(opts, cainfo = find_cert_bundle())), headers = self$headers ) rr$options <- utils::modifyList(rr$options, c(self$opts, self$proxies, ...)) self$payload <- rr return(self) }, method = function() self$payload$method ) ) make_url_async <- function(url = NULL, handle = NULL, path, query) { if (!is.null(handle)) { url <- handle$url } if (!is.null(path)) { urltools::path(url) <- path } url <- gsub("\\s", "%20", url) url <- add_query(query, url) if (!is.null(handle)) { curl::handle_setopt(handle, url = url) } else { handle <- curl::new_handle(url = url) } return(list(url = url, handle = handle)) } crul/R/query.R0000644000176200001440000000137513070473662012726 0ustar liggesusers# adapted from https://github.com/hadley/httr encode <- function(x) { if (inherits(x, "AsIs")) return(x) curl::curl_escape(x) } has_namez <- function(x) { length(Filter(nzchar, names(x))) == length(x) } # adapted from https://github.com/hadley/httr has_name <- function(x) { nms <- names(x) if (is.null(nms)) return(rep(FALSE, length(x))) !is.na(nms) & nms != "" } # adapted from https://github.com/hadley/httr make_query <- function(x) { if (length(x) == 0) { return("") } if (!all(has_name(x))) { stop("All components of query must be named", call. = FALSE) } stopifnot(is.list(x)) x <- ccp(x) names <- curl::curl_escape(names(x)) values <- vapply(x, encode, character(1)) paste0(names, "=", values, collapse = "&") } crul/R/stubbed-response.R0000644000176200001440000000617313106761536015046 0ustar liggesusers#' stubbed response object #' #' @export #' @param url (character) A url #' @param opts (list) curl options #' @param handle A handle #' @details #' \strong{Methods} #' \describe{ #' \item{\code{parse()}}{ #' Parse the raw response content to text #' } #' \item{\code{success()}}{ #' Was status code less than or equal to 201. #' returns boolean #' } #' \item{\code{status_http()}}{ #' Get HTTP status code, message, and explanation #' } #' \item{\code{raise_for_status()}}{ #' Check HTTP status and stop with appropriate #' HTTP error code and message if >= 300. #' - If you have \code{fauxpas} installed we use that, #' otherwise use \pkg{httpcode} #' } #' } #' @format NULL #' @usage NULL #' @examples #' (x <- HttpStubbedResponse$new(method = "get", url = "https://httpbin.org")) #' x$url #' x$method HttpStubbedResponse <- R6::R6Class( 'HttpStubbedResponse', public = list( method = NULL, url = NULL, opts = NULL, handle = NULL, status_code = NULL, request_headers = NULL, content = NULL, request = NULL, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" url: ", self$url), sep = "\n") cat(" request_headers: ", sep = "\n") for (i in seq_along(self$request_headers)) { cat(sprintf(" %s: %s", names(self$request_headers)[i], self$request_headers[[i]]), sep = "\n") } cat(" response_headers: NULL", sep = "\n") params <- parse_params(self$url) if (!is.null(params)) { cat(" params: ", sep = "\n") for (i in seq_along(params)) { cat(paste0(" ", sub("=", ": ", params[[i]], "=")), sep = "\n") } } if (!is.null(self$status_code)) cat(paste0(" status: ", self$status_code), sep = "\n") invisible(self) }, initialize = function(method, url, opts, handle, status_code, request_headers, content, request) { if (!missing(method)) self$method <- method if (!missing(url)) self$url <- url if (!missing(opts)) self$opts <- opts if (!missing(handle)) self$handle <- handle if (!missing(status_code)) self$status_code <- as.numeric(status_code) if (!missing(request_headers)) self$request_headers <- request_headers if (!missing(content)) self$content <- content if (!missing(request)) self$request <- request }, parse = function(encoding = NULL) { iconv(readBin(self$content, character()), from = guess_encoding(encoding), to = "UTF-8") }, success = function() { self$status_code <= 201 }, status_http = function(verbose = FALSE) { httpcode::http_code(code = self$status_code, verbose = verbose) }, raise_for_status = function() { if (self$status_code >= 300) { if (!requireNamespace("fauxpas", quietly = TRUE)) { x <- httpcode::http_code(code = self$status_code) stop(sprintf("%s (HTTP %s)", x$message, x$status_code), call. = FALSE) } else { fauxpas::http(self, behavior = "stop") } } } ) ) crul/R/http-headers.R0000644000176200001440000000130713040733452014135 0ustar liggesusers#' Working with HTTP headers #' #' @name http-headers #' @examples #' (x <- HttpClient$new(url = "https://httpbin.org")) #' #' # set headers #' (res <- HttpClient$new( #' url = "https://httpbin.org", #' opts = list( #' verbose = TRUE #' ), #' headers = list( #' a = "stuff", #' b = "things" #' ) #' )) #' res$headers #' # reassign header value #' res$headers$a <- "that" #' # define new header #' res$headers$c <- "what" #' # request #' res$get('get') #' #' ## setting content-type via headers #' (res <- HttpClient$new( #' url = "https://httpbin.org", #' opts = list( #' verbose = TRUE #' ), #' headers = list(`Content-Type` = "application/json") #' )) #' res$get('get') NULL crul/R/body.R0000644000176200001440000000425113164341466012512 0ustar liggesusersmake_type <- function(x) { if (is.null(x)) { return() } if (substr(x, 1, 1) == ".") { x <- mime::guess_type(x, empty = NULL) } list(`Content-Type` = x) } # adapted from https://github.com/hadley/httr raw_body <- function(body, type = NULL) { if (is.character(body)) { body <- charToRaw(paste(body, collapse = "\n")) } stopifnot(is.raw(body)) list( opts = list( post = TRUE, postfieldsize = length(body), postfields = body ), type = make_type(type %||% "") ) } # adapted from https://github.com/hadley/httr prep_body <- function(body, encode, type = NULL) { if (identical(body, FALSE)) { return(list(opts = list(post = TRUE, nobody = TRUE))) } if (is.character(body) || is.raw(body)) { return(raw_body(body, type = type)) } if (inherits(body, "form_file")) { con <- file(body$path, "rb") size <- file.info(body$path)$size return( list( opts = list( post = TRUE, readfunction = function(nbytes, ...) { if (is.null(con)) return(raw()) bin <- readBin(con, "raw", nbytes) if (length(bin) < nbytes) { close(con) con <<- NULL } bin }, postfieldsize_large = size ), type = make_type(body$type) ) ) } if (is.null(body)) { return(raw_body(raw())) } if (!is.list(body)) { stop("Unknown type of `body`: must be NULL, FALSE, character, raw or list", call. = FALSE) } body <- ccp(body) if (!encode %in% c('raw', 'form', 'json', 'multipart')) { stop("encode must be one of raw, form, json, or multipart", call. = FALSE) } if (encode == "raw") { raw_body(body) } else if (encode == "form") { raw_body(make_query(body), "application/x-www-form-urlencoded") } else if (encode == "json") { raw_body(jsonlite::toJSON(body, auto_unbox = TRUE), "application/json") } else if (encode == "multipart") { if (!all(has_name(body))) { stop("All components of body must be named", call. = FALSE) } list( opts = list( post = TRUE ), fields = lapply(body, as.character) ) } } crul/R/use_agent.R0000644000176200001440000000040713004743306013516 0ustar liggesusersmake_ua <- function() { versions <- c( libcurl = curl::curl_version()$version, `r-curl` = as.character(utils::packageVersion("curl")), crul = as.character(utils::packageVersion("crul")) ) paste0(names(versions), "/", versions, collapse = " ") } crul/R/client.R0000644000176200001440000002304113230430037013014 0ustar liggesusers#' HTTP client #' #' @export #' @template args #' @details #' **Methods** #' \describe{ #' \item{`get(path, query, disk, stream, ...)`}{ #' Make a GET request #' } #' \item{`post(path, query, body, disk, stream, ...)`}{ #' Make a POST request #' } #' \item{`put(path, query, body, disk, stream, ...)`}{ #' Make a PUT request #' } #' \item{`patch(path, query, body, disk, stream, ...)`}{ #' Make a PATCH request #' } #' \item{`delete(path, query, body, disk, stream, ...)`}{ #' Make a DELETE request #' } #' \item{`head(path, query, ...)`}{ #' Make a HEAD request #' } #' } #' #' @format NULL #' @usage NULL #' @details Possible parameters (not all are allowed in each HTTP verb): #' \itemize{ #' \item path - URL path, appended to the base URL #' \item query - query terms, as a named list #' \item body - body as an R list #' \item encode - one of form, multipart, json, or raw #' \item disk - a path to write to. if NULL (default), memory used. #' See [curl::curl_fetch_disk()] for help. #' \item stream - an R function to determine how to stream data. if #' NULL (default), memory used. See [curl::curl_fetch_stream()] #' for help #' \item ... curl options, only those in the acceptable set from #' [curl::curl_options()] except the following: httpget, httppost, #' post, postfields, postfieldsize, and customrequest #' } #' #' @section handles: #' curl handles are re-used on the level of the connection object, that is, #' each `HttpClient` object is separate from one another so as to better #' separate connections. #' #' @seealso [post-requests], [delete-requests], [http-headers], #' [writing-options], [cookies] #' #' @examples #' (x <- HttpClient$new(url = "https://httpbin.org")) #' x$url #' (res_get1 <- x$get('get')) #' res_get1$content #' res_get1$response_headers #' res_get1$parse() #' #' (res_get2 <- x$get('get', query = list(hello = "world"))) #' res_get2$parse() #' library("jsonlite") #' jsonlite::fromJSON(res_get2$parse()) #' #' # post request #' (res_post <- x$post('post', body = list(hello = "world"))) #' #' ## empty body request #' x$post('post') #' #' # put request #' (res_put <- x$put('put')) #' #' # delete request #' (res_delete <- x$delete('delete')) #' #' # patch request #' (res_patch <- x$patch('patch')) #' #' # head request #' (res_head <- x$head()) #' #' # query params are URL encoded for you, so DO NOT do it yourself #' ## if you url encode yourself, it gets double encoded, and that's bad #' (x <- HttpClient$new(url = "https://httpbin.org")) #' res <- x$get("get", query = list(a = 'hello world')) HttpClient <- R6::R6Class( 'HttpClient', public = list( url = NULL, opts = list(), proxies = list(), auth = list(), headers = list(), handle = NULL, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" url: ", if (is.null(self$url)) self$handle$url else self$url), 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") } invisible(self) }, initialize = function(url, opts, proxies, auth, headers, handle) { private$crul_h_pool <- new.env(hash = TRUE, parent = emptyenv()) if (!missing(url)) self$url <- url if (!missing(opts)) self$opts <- opts if (!missing(proxies)) { if (!inherits(proxies, "proxy")) { stop("proxies input must be of class proxy", call. = FALSE) } self$proxies <- proxies } if (!missing(auth)) self$auth <- auth if (!missing(headers)) self$headers <- headers if (!missing(handle)) self$handle <- handle if (is.null(self$url) && is.null(self$handle)) { stop("need one of url or handle", call. = FALSE) } }, get = function(path = NULL, query = list(), disk = NULL, stream = NULL, ...) { curl_opts_check(...) url <- private$make_url(self$url, self$handle, path, query) rr <- list( url = url, method = "get", options = ccp(list(httpget = TRUE, cainfo = find_cert_bundle())), headers = def_head() ) rr$headers <- norm_headers(rr$headers, self$headers) rr$options <- utils::modifyList( rr$options, c(self$opts, self$proxies, self$auth, ...)) rr$options <- curl_opts_fil(rr$options) rr$disk <- disk rr$stream <- stream private$make_request(rr) }, post = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- private$make_url(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("post", url, self, opts, ...) rr$disk <- disk rr$stream <- stream private$make_request(rr) }, put = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- private$make_url(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("put", url, self, opts, ...) rr$disk <- disk rr$stream <- stream private$make_request(rr) }, patch = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- private$make_url(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("patch", url, self, opts, ...) rr$disk <- disk rr$stream <- stream private$make_request(rr) }, delete = function(path = NULL, query = list(), body = NULL, disk = NULL, stream = NULL, encode = "multipart", ...) { curl_opts_check(...) url <- private$make_url(self$url, self$handle, path, query) opts <- prep_body(body, encode) rr <- prep_opts("delete", url, self, opts, ...) rr$disk <- disk rr$stream <- stream private$make_request(rr) }, head = function(path = NULL, query = list(), ...) { curl_opts_check(...) url <- private$make_url(self$url, self$handle, path, query) opts <- list(customrequest = "HEAD", nobody = TRUE) rr <- list( url = url, method = "head", options = ccp(c(opts, cainfo = find_cert_bundle())), headers = self$headers ) rr$options <- utils::modifyList( rr$options, c(self$opts, self$proxies, ...)) private$make_request(rr) }, handle_pop = function() { name <- handle_make(self$url) if (exists(name, envir = private$crul_h_pool)) { rm(list = name, envir = private$crul_h_pool) } } ), private = list( request = NULL, crul_h_pool = NULL, handle_find = function(x) { z <- handle_make(x) if (exists(z, private$crul_h_pool)) { handle <- private$crul_h_pool[[z]] } else { handle <- handle(z) private$crul_h_pool[[z]] <- handle } return(handle) }, make_url = function(url = NULL, handle = NULL, path, query) { if (!is.null(handle)) { url <- handle$url } else { handle <- private$handle_find(url) url <- handle$url } if (!is.null(path)) { urltools::path(url) <- path } url <- gsub("\\s", "%20", url) url <- add_query(query, url) return(list(url = url, handle = handle$handle)) }, make_request = function(opts) { if (xor(!is.null(opts$disk), !is.null(opts$stream))) { if (!is.null(opts$disk) && !is.null(opts$stream)) { stop("disk and stream can not be used together", call. = FALSE) } } curl::handle_setopt(opts$url$handle, .list = opts$options) if (!is.null(opts$fields)) { curl::handle_setform(opts$url$handle, .list = opts$fields) } curl::handle_setheaders(opts$url$handle, .list = opts$headers) on.exit(curl::handle_reset(opts$url$handle), add = TRUE) if (crul_opts$mock) { check_for_package("webmockr") adap <- webmockr::CrulAdapter$new() return(adap$handle_request(opts)) } else { resp <- crul_fetch(opts) } # build response HttpResponse$new( method = opts$method, url = resp$url, status_code = resp$status_code, request_headers = c(useragent = opts$options$useragent, opts$headers), response_headers = { if (grepl("^ftp://", resp$url)) { list() } else { hh <- rawToChar(resp$headers %||% raw(0)) if (is.null(hh) || nchar(hh) == 0) { list() } else { headers_parse(curl::parse_headers(hh)) } } }, modified = resp$modified, times = resp$times, content = resp$content, handle = opts$url$handle, request = opts ) } ) ) crul/R/post-requests.R0000644000176200001440000000417013164466644014421 0ustar liggesusers#' HTTP POST/PUT/PATCH requests #' #' @name post-requests #' @examples #' (x <- HttpClient$new(url = "https://httpbin.org")) #' #' # POST requests #' ## a list #' (res_post <- x$post('post', body = list(hello = "world"), verbose = TRUE)) #' #' ## a string #' (res_post <- x$post('post', body = "hello world", verbose = TRUE)) #' #' ## empty body request #' x$post('post') #' #' ## form requests #' \dontrun{ #' (cli <- HttpClient$new( #' url = "http://apps.kew.org/wcsp/advsearch.do" #' )) #' cli$post( #' encode = "form", #' body = list( #' page = 'advancedSearch', #' genus = 'Gagea', #' species = 'pratensis', #' selectedLevel = 'cont' #' ) #' ) #' } #' #' (x <- HttpClient$new(url = "https://httpbin.org")) #' res <- x$post("post", #' encode = "json", #' body = list( #' genus = 'Gagea', #' species = 'pratensis' #' ) #' ) #' jsonlite::fromJSON(res$parse()) #' #' # PUT requests #' (x <- HttpClient$new(url = "https://httpbin.org")) #' (res <- x$put(path = "put", #' encode = "json", #' body = list( #' genus = 'Gagea', #' species = 'pratensis' #' ) #' )) #' jsonlite::fromJSON(res$parse("UTF-8")) #' #' res <- x$put("put", body = "foo bar") #' jsonlite::fromJSON(res$parse("UTF-8")) #' #' #' # PATCH requests #' (x <- HttpClient$new(url = "https://httpbin.org")) #' (res <- x$patch(path = "patch", #' encode = "json", #' body = list( #' genus = 'Gagea', #' species = 'pratensis' #' ) #' )) #' jsonlite::fromJSON(res$parse("UTF-8")) #' #' res <- x$patch("patch", body = "foo bar") #' jsonlite::fromJSON(res$parse("UTF-8")) #' #' #' # Upload files #' ## image #' path <- file.path(Sys.getenv("R_DOC_DIR"), "html/logo.jpg") #' (x <- HttpClient$new(url = "https://httpbin.org")) #' res <- x$post(path = "post", body = list(y = upload(path))) #' res$content #' #' ## text file, in a list #' (x <- HttpClient$new(url = "https://httpbin.org")) #' file <- upload(system.file("CITATION")) #' res <- x$post(path = "post", body = list(y = file)) #' jsonlite::fromJSON(res$parse("UTF-8")) #' #' ## text file, as data #' res <- x$post(path = "post", body = file) #' jsonlite::fromJSON(res$parse("UTF-8")) NULL crul/R/paginator.R0000644000176200001440000002110113230270674013526 0ustar liggesusers#' Paginator client #' #' A client to help you paginate #' #' @export #' @param client an object of class `HttpClient`, from a call to [HttpClient] #' @param by (character) how to paginate. Only 'query_params' supported for #' now. In the future will support 'link_headers' and 'cursor'. See Details. #' @param limit_param (character) the name of the limit parameter. #' Default: limit #' @param offset_param (character) the name of the offset parameter. #' Default: offset #' @param limit (numeric/integer) the maximum records wanted #' @param limit_chunk (numeric/integer) the number by which to chunk requests, #' e.g., 10 would be be each request gets 10 records #' @details #' **Methods** #' \describe{ #' \item{`get(path, query, ...)`}{ #' make a paginated GET request #' } #' \item{`post(path, query, body, encode, ...)`}{ #' make a paginated POST request #' } #' \item{`put(path, query, body, encode, ...)`}{ #' make a paginated PUT request #' } #' \item{`patch(path, query, body, encode, ...)`}{ #' make a paginated PATCH request #' } #' \item{`delete(path, query, body, encode, ...)`}{ #' make a paginated DELETE request #' } #' \item{`head(path, ...)`}{ #' make a paginated HEAD request - not sure if this makes any sense #' or not yet #' } #' \item{`responses()`}{ #' list responses #' - returns: a list of `HttpResponse` objects, empty list before #' requests made #' } #' \item{`parse(encoding = "UTF-8")`}{ #' parse content #' - returns: character vector, empty character vector before #' requests made #' } #' \item{`status_code()`}{ #' (integer) HTTP status codes #' - returns: numeric vector, empty numeric vector before #' requests made #' } #' \item{`status()`}{ #' (list) HTTP status objects #' - returns: a list of `http_code` objects, empty list before #' requests made #' } #' \item{`content()`}{ #' raw content #' - returns: raw list, empty list before requests made #' } #' \item{`times()`}{ #' curl request times #' - returns: list of named numeric vectors, empty list before #' requests made #' } #' } #' #' See [HttpClient()] for information on parameters. #' #' @format NULL #' @usage NULL #' #' @section Methods to paginate: #' #' Supported now: #' #' - `query_params`: the most common way, so is the default. This method #' involves setting how many records and what record to start at for each #' request. We send these query parameters for you. #' #' Supported later: #' #' - `link_headers`: link headers are URLS for the next/previous/last #' request given in the response header from the server. This is relatively #' uncommon, though is recommended by JSONAPI and is implemented by a #' well known API (GitHub). #' - `cursor`: this works by a single string given back in each response, to #' be passed in the subsequent response, and so on until no more records #' remain. This is common in Solr #' #' @return a list, with objects of class [HttpResponse()]. #' Responses are returned in the order they are passed in. #' #' @examples \dontrun{ #' (cli <- HttpClient$new(url = "http://api.crossref.org")) #' cc <- Paginator$new(client = cli, limit_param = "rows", #' offset_param = "offset", limit = 50, limit_chunk = 10) #' cc #' cc$get('works') #' cc #' cc$responses() #' cc$status() #' cc$status_code() #' cc$times() #' cc$content() #' cc$parse() #' lapply(cc$parse(), jsonlite::fromJSON) #' } Paginator <- R6::R6Class( 'Paginator', public = list( http_req = NULL, by = "query_params", limit_chunk = NULL, limit_param = NULL, offset_param = NULL, limit = NULL, req = NULL, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0( " base url: ", if (is.null(self$http_req)) self$http_req$handle$url else self$http_req$url), sep = "\n") cat(paste0(" by: ", self$by), sep = "\n") cat(paste0(" limit_chunk: ", self$limit_chunk %||% ""), sep = "\n") cat(paste0(" limit_param: ", self$limit_param %||% ""), sep = "\n") cat(paste0(" offset_param: ", self$offset_param %||% ""), sep = "\n") cat(paste0(" limit: ", self$limit %||% ""), sep = "\n") cat(paste0(" status: ", if (length(private$resps) == 0) { "not run yet" } else { paste0(length(private$resps), " requests done") }), sep = "\n") invisible(self) }, initialize = function(client, by = "query_params", limit_param, offset_param, limit, limit_chunk) { if (!inherits(client, "HttpClient")) stop("'client' has to be an object of class 'HttpClient'", call. = FALSE) self$http_req <- client if (by != "query_params") stop("'by' has to be 'query_params' for now", call. = FALSE) self$by <- by if (!missing(limit_chunk)) self$limit_chunk <- limit_chunk if (!missing(limit_param)) self$limit_param <- limit_param if (!missing(offset_param)) self$offset_param <- offset_param if (!missing(limit)) self$limit <- limit if (self$by == "query_params") { private$offset_iters <- c(0, seq(from=0, to=self$limit, by=self$limit_chunk)[-1]) private$offset_iters <- private$offset_iters[-length(private$offset_iters)] private$offset_args <- as.list(stats::setNames(private$offset_iters, rep(self$offset_param, length(private$offset_iters)))) } }, # HTTP verbs get = function(path = NULL, query = list(), ...) { private$page("get", path, query, ...) }, post = function(path = NULL, query = list(), body = NULL, encode = "multipart", ...) { private$page("post", path, query, body, encode, ...) }, put = function(path = NULL, query = list(), body = NULL, encode = "multipart", ...) { private$page("put", path, query, body, encode, ...) }, patch = function(path = NULL, query = list(), body = NULL, encode = "multipart", ...) { private$page("patch", path, query, body, encode, ...) }, delete = function(path = NULL, query = list(), body = NULL, encode = "multipart", ...) { private$page("delete", path, query, body, encode, ...) }, head = function(path = NULL, ...) { private$page("head", path, ...) }, # functions to inspect output responses = function() { private$resps %||% list() }, status_code = function() { vapply(private$resps, function(z) z$status_code, 1) }, status = function() { lapply(private$resps, function(z) z$status_http()) }, parse = function(encoding = "UTF-8") { vapply(private$resps, function(z) z$parse(encoding = encoding), "") }, content = function() { lapply(private$resps, function(z) z$content) }, times = function() { lapply(private$resps, function(z) z$times) } ), private = list( offset_iters = NULL, offset_args = NULL, resps = NULL, page = function(method, path, query, body, encode, ...) { tmp <- list() for (i in seq_along(private$offset_iters)) { off <- private$offset_args[i] off[self$limit_param] <- self$limit_chunk tmp[[i]] <- switch( method, get = self$http_req$get(path, query = ccp(c(query, off)), ...), post = self$http_req$post(path, query = ccp(c(query, off)), body = body, encode = encode, ...), put = self$http_req$put(path, query = ccp(c(query, off)), body = body, encode = encode, ...), patch = self$http_req$patch(path, query = ccp(c(query, off)), body = body, encode = encode, ...), delete = self$http_req$delete(path, query = ccp(c(query, off)), body = body, encode = encode, ...), head = self$http_req$head(path, ...) ) } private$resps <- tmp message("OK\n") } ) ) # sttrim <- function(str) { # gsub("^\\s+|\\s+$", "", str) # } # parse_links <- function(w) { # if (is.null(w)) { # NULL # } else { # if (inherits(w, "character")) { # links <- sttrim(strsplit(w, ",")[[1]]) # lapply(links, each_link) # } else { # nms <- sapply(w, "[[", "name") # tmp <- unlist(w[nms %in% "next"]) # grep("http", tmp, value = TRUE) # } # } # } # each_link <- function(z) { # tmp <- sttrim(strsplit(z, ";")[[1]]) # nm <- gsub("\"|(rel)|=", "", tmp[2]) # url <- gsub("^<|>$", "", tmp[1]) # list(name = nm, url = url) # } crul/R/proxies.R0000644000176200001440000000525013070474352013243 0ustar liggesusers#' proxy options #' #' @name proxies #' @param url (character) URL, with scheme (http/https), domain and #' port (must be numeric). required. #' @param user (character) username, optional #' @param pwd (character) password, optional #' @param auth (character) authentication type, one of basic (default), #' digest, digest_ie, gssnegotiate, ntlm, or any. optional #' #' @details See for a list of proxies you #' can use #' #' @examples #' proxy("http://97.77.104.22:3128") #' proxy("97.77.104.22:3128") #' proxy("http://97.77.104.22:3128", "foo", "bar") #' proxy("http://97.77.104.22:3128", "foo", "bar", auth = "digest") #' proxy("http://97.77.104.22:3128", "foo", "bar", auth = "ntlm") #' #' # with proxy (look at request/outgoing headers) #' (res <- HttpClient$new( #' url = "http://www.google.com", #' proxies = proxy("http://97.77.104.22:3128") #' )) #' res$proxies #' \dontrun{res$get(verbose = TRUE)} #' #' # vs. without proxy (look at request/outgoing headers) #' (res2 <- HttpClient$new(url = "http://www.google.com")) #' res2$get(verbose = TRUE) #' #' #' # Use authentication #' (res <- HttpClient$new( #' url = "http://google.com", #' proxies = proxy("http://97.77.104.22:3128", user = "foo", pwd = "bar") #' )) #' #' # another example #' (res <- HttpClient$new( #' url = "http://ip.tyk.nu/", #' proxies = proxy("http://200.29.191.149:3128") #' )) #' \dontrun{res$get()$parse("UTF-8")} NULL #' @export #' @rdname proxies proxy <- function(url, user = NULL, pwd = NULL, auth = "basic") { url <- proxy_url(url) structure(ccp(list( proxy = url$domain, proxyport = url$port, proxyuserpwd = make_up(user, pwd), proxyauth = auth_type(auth) )), class = "proxy") } proxy_url <- function(x) { tmp <- tryCatch(urltools::url_parse(x), error = function(e) e) if (inherits(tmp, "error")) { stop("proxy URL not of correct form, check your URL", call. = FALSE) } port <- tryCatch(as.numeric(tmp$port), warning = function(w) w) if (inherits(port, "warning")) stop("port ", tmp$port, " was not numeric", call. = FALSE) tmp$port <- port as.list(tmp) } make_up <- function(user, pwd) { assert(user, "character") assert(pwd, "character") if (!is.null(user) || !is.null(pwd)) { return(paste0(user, ":", pwd)) } NULL } auth_type <- function(x) { stopifnot(inherits(x, "character")) switch( x, basic = 1, digest = 2, digest_ie = 16, gssnegotiate = 4, ntlm = 8, any = -17, stop("auth not in acceptable set, see ?proxies", call. = FALSE) ) } purl <- function(x) { sprintf("http://%s:%s (auth: %s)", x$proxy, x$proxyport, !is.null(x$proxyuserpwd)) } crul/R/mocking.R0000644000176200001440000000160013110422114013154 0ustar liggesusers#' Mocking HTTP requests #' #' @export #' @param on (logical) turn mocking on with `TRUE` or turn off with `FALSE`. #' By default is `FALSE` #' @details `webmockr` package required for mocking behavior #' @examples \dontrun{ #' # load webmockr #' library(webmockr) #' library(crul) #' #' URL <- "https://httpbin.org" #' #' # turn on mocking #' crul::mock() #' #' # stub a request #' stub_request("get", file.path(URL, "get")) #' webmockr:::webmockr_stub_registry #' #' # create an HTTP client #' (x <- HttpClient$new(url = URL)) #' #' # make a request - matches stub - no real request made #' x$get('get') #' #' # allow net connect #' webmockr::webmockr_allow_net_connect() #' x$get('get', query = list(foo = "bar")) #' webmockr::webmockr_disable_net_connect() #' x$get('get', query = list(foo = "bar")) #' } mock <- function(on = TRUE) { check_for_package("webmockr") crul_opts$mock <- on } crul/R/curl-options.R0000644000176200001440000000170613230425266014210 0ustar liggesusers#' curl options #' #' With the `opts` parameter you can pass in various #' curl options, including user agent string, whether to get verbose #' curl output or not, setting a timeout for requests, and more. See #' [curl::curl_options()] for all the options you can use. #' #' A progress helper will be coming soon. #' #' @name curl-options #' @aliases user-agent verbose timeout #' #' @examples \dontrun{ #' # set curl options on client initialization #' (res <- HttpClient$new( #' url = "https://httpbin.org", #' opts = list( #' verbose = TRUE, #' useragent = "hello world" #' ) #' )) #' res$opts #' res$get('get') #' #' # or set curl options when performing HTTP operation #' (res <- HttpClient$new(url = "https://httpbin.org")) #' res$get('get', verbose = TRUE) #' res$get('get', stuff = "things") #' #' # set a timeout #' (res <- HttpClient$new( #' url = "https://httpbin.org", #' opts = list(timeout_ms = 1) #' )) #' # res$get('get') #' } NULL crul/R/delete-requests.R0000644000176200001440000000071513070473662014671 0ustar liggesusers#' HTTP DELETE requests #' #' @name delete-requests #' @examples #' (x <- HttpClient$new(url = "https://httpbin.org")) #' #' ## a list #' (res1 <- x$delete('delete', body = list(hello = "world"), verbose = TRUE)) #' jsonlite::fromJSON(res1$parse("UTF-8")) #' #' ## a string #' (res2 <- x$delete('delete', body = "hello world", verbose = TRUE)) #' jsonlite::fromJSON(res2$parse("UTF-8")) #' #' ## empty body request #' x$delete('delete', verbose = TRUE) #' NULL crul/R/fetch.R0000644000176200001440000000055313040733452012640 0ustar liggesuserscrul_fetch <- function(x) { if (is.null(x$disk) && is.null(x$stream)) { # memory curl::curl_fetch_memory(x$url$url, handle = x$url$handle) } else if (!is.null(x$disk)) { # disk curl::curl_fetch_disk(x$url$url, x$disk, handle = x$url$handle) } else { # stream curl::curl_fetch_stream(x$url$url, x$stream, handle = x$url$handle) } } crul/R/headers.R0000644000176200001440000000044513040733452013162 0ustar liggesusershead_parse <- function(z) { if (grepl("HTTP\\/", z)) { list(status = z) } else { ff <- regexec("^([^:]*):\\s*(.*)$", z) xx <- regmatches(z, ff)[[1]] as.list(stats::setNames(xx[[3]], tolower(xx[[2]]))) } } headers_parse <- function(x) do.call("c", lapply(x, head_parse)) crul/R/zzz.R0000644000176200001440000000405613164465701012414 0ustar liggesusers`%||%` <- function(x, y) if (is.null(x)) y else x ccp <- function(x) Filter(Negate(is.null), x) assert <- function(x, y) { if (!is.null(x)) { if (!class(x) %in% y) { stop(deparse(substitute(x)), " must be of class ", paste0(y, collapse = ", "), call. = FALSE) } } } prep_opts <- function(method, url, self, opts, ...) { if (method != "post") { opts$opts$customrequest <- toupper(method) } if (!is.null(opts$type)) { if (nchar(opts$type[[1]]) == 0) { opts$type <- NULL } } rr <- list( url = url, method = method, options = ccp(as.list(c(opts$opts, cainfo = find_cert_bundle()))), headers = as.list(c(opts$type, def_head())), fields = opts$fields ) rr$headers <- norm_headers(rr$headers, self$headers) rr$options <- utils::modifyList( rr$options, c(self$opts, self$proxies, self$auth, ...) ) rr$options <- curl_opts_fil(rr$options) return(rr) } norm_headers <- function(x, y) { if (length(names(y)) > 0) { x <- x[!names(x) %in% names(y)] x <- c(x, y) } return(x) } check_for_package <- function(x) { if (!requireNamespace(x, quietly = TRUE)) { stop(sprintf("Please install '%s'", x), call. = FALSE) } else { invisible(TRUE) } } def_head <- function() { list( `User-Agent` = make_ua(), `Accept-Encoding` = 'gzip, deflate', `Accept` = 'application/json, text/xml, application/xml, */*' ) } # drop any options that are not in the set of # valid curl options curl_opts_fil <- function(z) { valco <- names(curl::curl_options()) z[names(z) %in% valco] } # drop named things drop_name <- function(x, y) { x[!names(x) %in% y] } # adapted from https://github.com/hadley/httr find_cert_bundle <- function() { if (.Platform$OS.type != "windows") return() env <- Sys.getenv("CURL_CA_BUNDLE") if (!identical(env, "")) return(env) bundled <- file.path(R.home("etc"), "curl-ca-bundle.crt") if (file.exists(bundled)) return(bundled) # Fall back to certificate bundle in openssl system.file("cacert.pem", package = "openssl") } crul/R/response.R0000644000176200001440000001224613106761536013416 0ustar liggesusers#' Base response object #' #' @export #' @param url (character) A url, required #' @param opts (list) curl options #' @param handle A handle #' @param method (character) HTTP method #' @param status_code (integer) status code #' @param request_headers (list) request headers, named list #' @param response_headers (list) response headers, named list #' @param modified (character) modified date #' @param times (vector) named vector #' @param content (raw) raw binary content response #' @param request request object, with all details #' @details #' **Methods** #' \describe{ #' \item{`parse()`}{ #' Parse the raw response content to text #' } #' \item{`success()`}{ #' Was status code less than or equal to 201. #' returns boolean #' } #' \item{`status_http()`}{ #' Get HTTP status code, message, and explanation #' } #' \item{`raise_for_status()`}{ #' Check HTTP status and stop with appropriate #' HTTP error code and message if >= 300. #' - If you have `fauxpas` installed we use that, #' otherwise use \pkg{httpcode} #' } #' } #' @format NULL #' @usage NULL #' @examples #' x <- HttpResponse$new(method = "get", url = "https://httpbin.org") #' x$url #' x$method #' #' x <- HttpClient$new(url = 'https://httpbin.org') #' (res <- x$get('get')) #' res$request_headers #' res$response_headers #' res$parse() #' res$status_code #' res$status_http() #' res$status_http()$status_code #' res$status_http()$message #' res$status_http()$explanation #' res$success() #' #' x <- HttpClient$new(url = 'https://httpbin.org/status/404') #' (res <- x$get()) #' \dontrun{res$raise_for_status()} #' #' x <- HttpClient$new(url = 'https://httpbin.org/status/414') #' (res <- x$get()) #' \dontrun{res$raise_for_status()} HttpResponse <- R6::R6Class( 'HttpResponse', public = list( method = NULL, url = NULL, opts = NULL, handle = NULL, status_code = NULL, request_headers = NULL, response_headers = NULL, modified = NULL, times = NULL, content = NULL, request = NULL, print = function(x, ...) { cat(" ", sep = "\n") cat(paste0(" url: ", self$url), sep = "\n") cat(" request_headers: ", sep = "\n") if (length(self$request_headers)) { for (i in seq_along(self$request_headers)) { cat(sprintf(" %s: %s", names(self$request_headers)[i], self$request_headers[[i]]), sep = "\n") } } cat(" response_headers: ", sep = "\n") if (length(self$response_headers)) { for (i in seq_along(self$response_headers)) { cat(sprintf(" %s: %s", names(self$response_headers)[i], self$response_headers[[i]]), sep = "\n") } } params <- parse_params(self$url) if (!is.null(params)) { cat(" params: ", sep = "\n") for (i in seq_along(params)) { cat(paste0(" ", sub("=", ": ", params[[i]], "=")), sep = "\n") } } if (!is.null(self$status_code)) cat(paste0(" status: ", self$status_code), sep = "\n") invisible(self) }, initialize = function(method, url, opts, handle, status_code, request_headers, response_headers, modified, times, content, request) { if (!missing(method)) self$method <- method self$url <- url if (!missing(opts)) self$opts <- opts if (!missing(handle)) self$handle <- handle if (!missing(status_code)) self$status_code <- as.numeric(status_code) if (!missing(request_headers)) self$request_headers <- request_headers if (!missing(response_headers)) self$response_headers <- response_headers if (!missing(modified)) self$modified <- modified if (!missing(times)) self$times <- times if (!missing(content)) self$content <- content if (!missing(request)) self$request <- request }, parse = function(encoding = NULL) { # readBin(self$content, character()) iconv(readBin(self$content, character()), from = guess_encoding(encoding), to = "UTF-8") }, success = function() { self$status_code <= 201 }, status_http = function(verbose = FALSE) { httpcode::http_code(code = self$status_code, verbose = verbose) }, raise_for_status = function() { if (self$status_code >= 300) { if (!requireNamespace("fauxpas", quietly = TRUE)) { x <- httpcode::http_code(code = self$status_code) stop(sprintf("%s (HTTP %s)", x$message, x$status_code), call. = FALSE) } else { fauxpas::http(self, behavior = "stop") } } } ) ) guess_encoding <- function(encoding = NULL) { if (!is.null(encoding)) { return(check_encoding(encoding)) } else { message("No encoding supplied: defaulting to UTF-8.") return("UTF-8") } } check_encoding <- function(x) { if ((tolower(x) %in% tolower(iconvlist()))) return(x) message("Invalid encoding ", x, ": defaulting to UTF-8.") "UTF-8" } parse_params <- function(x) { x <- urltools::parameters(x) if (is.na(x)) { NULL } else { strsplit(x, "&")[[1]] } } crul/vignettes/0000755000176200001440000000000013231433524013227 5ustar liggesuserscrul/vignettes/async.Rmd0000644000176200001440000001762213230436233015017 0ustar liggesusers async with crul =============== Asynchronous requests with `crul`. There are two interfaces to asynchronous requests in `crul`: 1. Simple async: any number of URLs, all treated with the same curl options, headers, etc., and only one HTTP method type at a time. 2. Varied request async: build any type of request and execute all asynchronously. The first option takes less thinking, less work, and is good solution when you just want to hit a bunch of URLs asynchronously. The second option is ideal when you want to set curl options/headers on each request and/or want to do different types of HTTP methods on each request. One thing to think about before using async is whether the data provider is okay with it. It's possible that a data provider's service may be brought down if you do too many async requests. ```r library("crul") ``` ## simple async Build request object with 1 or more URLs ```r (cc <- Async$new( urls = c( 'https://httpbin.org/get?a=5', 'https://httpbin.org/get?a=5&b=6', 'https://httpbin.org/ip' ) )) #> #> urls: #> https://httpbin.org/get?a=5 #> https://httpbin.org/get?a=5&b=6 #> https://httpbin.org/ip ``` Make request with any HTTP method ```r (res <- cc$get()) #> [[1]] #> #> url: https://httpbin.org/get?a=5 #> request_headers: #> response_headers: #> status: HTTP/1.1 200 OK #> connection: keep-alive #> server: meinheld/0.6.1 #> date: Fri, 19 Jan 2018 18:44:29 GMT #> content-type: application/json #> access-control-allow-origin: * #> access-control-allow-credentials: true #> x-powered-by: Flask #> x-processed-time: 0.000792026519775 #> content-length: 346 #> via: 1.1 vegur #> params: #> a: 5 #> status: 200 #> #> [[2]] #> #> url: https://httpbin.org/get?a=5&b=6 #> request_headers: #> response_headers: #> status: HTTP/1.1 200 OK #> connection: keep-alive #> server: meinheld/0.6.1 #> date: Fri, 19 Jan 2018 18:44:29 GMT #> content-type: application/json #> access-control-allow-origin: * #> access-control-allow-credentials: true #> x-powered-by: Flask #> x-processed-time: 0.00130796432495 #> content-length: 365 #> via: 1.1 vegur #> params: #> a: 5 #> b: 6 #> status: 200 #> #> [[3]] #> #> url: https://httpbin.org/ip #> request_headers: #> response_headers: #> status: HTTP/1.1 200 OK #> connection: keep-alive #> server: meinheld/0.6.1 #> date: Fri, 19 Jan 2018 18:44:28 GMT #> content-type: application/json #> access-control-allow-origin: * #> access-control-allow-credentials: true #> x-powered-by: Flask #> x-processed-time: 0.000822067260742 #> content-length: 32 #> via: 1.1 vegur #> status: 200 ``` You get back a list matching length of the number of input URLs Access object variables and methods just as with `HttpClient` results, here just one at a time. ```r res[[1]]$url #> [1] "https://httpbin.org/get?a=5" res[[1]]$success() #> [1] TRUE res[[1]]$parse("UTF-8") #> [1] "{\n \"args\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5\"\n}\n" ``` Or apply access/method calls across many results, e.g., parse all results ```r lapply(res, function(z) z$parse("UTF-8")) #> [[1]] #> [1] "{\n \"args\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5\"\n}\n" #> #> [[2]] #> [1] "{\n \"args\": {\n \"a\": \"5\", \n \"b\": \"6\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5&b=6\"\n}\n" #> #> [[3]] #> [1] "{\n \"origin\": \"50.22.155.214\"\n}\n" ``` ## varied request async ```r req1 <- HttpRequest$new( url = "https://httpbin.org/get?a=5", opts = list( verbose = TRUE ) ) req1$get() #> get #> url: https://httpbin.org/get?a=5 #> curl options: #> verbose: TRUE #> proxies: #> auth: #> headers: req2 <- HttpRequest$new( url = "https://httpbin.org/post?a=5&b=6" ) req2$post(body = list(a = 5)) #> post #> url: https://httpbin.org/post?a=5&b=6 #> curl options: #> proxies: #> auth: #> headers: (res <- AsyncVaried$new(req1, req2)) #> #> requests: #> get: https://httpbin.org/get?a=5 #> post: https://httpbin.org/post?a=5&b=6 ``` Make requests asynchronously ```r res$request() ``` Parse all results ```r res$parse() #> [1] "{\n \"args\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get?a=5\"\n}\n" #> [2] "{\n \"args\": {\n \"a\": \"5\", \n \"b\": \"6\"\n }, \n \"data\": \"\", \n \"files\": {}, \n \"form\": {\n \"a\": \"5\"\n }, \n \"headers\": {\n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Content-Length\": \"137\", \n \"Content-Type\": \"multipart/form-data; boundary=------------------------14f323a90518346b\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"json\": null, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/post?a=5&b=6\"\n}\n" ``` ```r lapply(res$parse(), jsonlite::prettify) #> [[1]] #> { #> "args": { #> "a": "5" #> }, #> "headers": { #> "Accept": "application/json, text/xml, application/xml, */*", #> "Accept-Encoding": "gzip, deflate", #> "Connection": "close", #> "Host": "httpbin.org", #> "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> }, #> "origin": "50.22.155.214", #> "url": "https://httpbin.org/get?a=5" #> } #> #> #> [[2]] #> { #> "args": { #> "a": "5", #> "b": "6" #> }, #> "data": "", #> "files": { #> #> }, #> "form": { #> "a": "5" #> }, #> "headers": { #> "Accept": "application/json, text/xml, application/xml, */*", #> "Accept-Encoding": "gzip, deflate", #> "Connection": "close", #> "Content-Length": "137", #> "Content-Type": "multipart/form-data; boundary=------------------------14f323a90518346b", #> "Host": "httpbin.org", #> "User-Agent": "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> }, #> "json": null, #> "origin": "50.22.155.214", #> "url": "https://httpbin.org/post?a=5&b=6" #> } #> ``` Status codes ```r res$status_code() #> [1] 200 200 ``` crul/vignettes/crul_vignette.Rmd0000644000176200001440000001734413230436233016555 0ustar liggesusers crul introduction ================= `crul` is an HTTP client for R. ## Install Stable CRAN version ```r install.packages("crul") ``` Dev version ```r devtools::install_github("ropensci/crul") ``` ```r library("crul") ``` ## the client `HttpClient` is where to start ```r (x <- HttpClient$new( url = "https://httpbin.org", opts = list( timeout = 1 ), headers = list( a = "hello world" ) )) #> #> url: https://httpbin.org #> curl options: #> timeout: 1 #> proxies: #> auth: #> headers: #> a: hello world ``` Makes a R6 class, that has all the bits and bobs you'd expect for doing HTTP requests. When it prints, it gives any defaults you've set. As you update the object you can see what's been set ```r x$opts #> $timeout #> [1] 1 ``` ```r x$headers #> $a #> [1] "hello world" ``` ## do some http The client object created above has http methods that you can call, and pass paths to, as well as query parameters, body values, and any other curl options. Here, we'll do a __GET__ request on the route `/get` on our base url `https://httpbin.org` (the full url is then `https://httpbin.org/get`) ```r res <- x$get("get") ``` The response from a http request is another R6 class `HttpResponse`, which has slots for the outputs of the request, and some functions to deal with the response: Status code ```r res$status_code #> [1] 200 ``` The content ```r res$content #> [1] 7b 0a 20 20 22 61 72 67 73 22 3a 20 7b 7d 2c 20 0a 20 20 22 68 65 61 #> [24] 64 65 72 73 22 3a 20 7b 0a 20 20 20 20 22 41 22 3a 20 22 68 65 6c 6c #> [47] 6f 20 77 6f 72 6c 64 22 2c 20 0a 20 20 20 20 22 41 63 63 65 70 74 22 #> [70] 3a 20 22 61 70 70 6c 69 63 61 74 69 6f 6e 2f 6a 73 6f 6e 2c 20 74 65 #> [93] 78 74 2f 78 6d 6c 2c 20 61 70 70 6c 69 63 61 74 69 6f 6e 2f 78 6d 6c #> [116] 2c 20 2a 2f 2a 22 2c 20 0a 20 20 20 20 22 41 63 63 65 70 74 2d 45 6e #> [139] 63 6f 64 69 6e 67 22 3a 20 22 67 7a 69 70 2c 20 64 65 66 6c 61 74 65 #> [162] 22 2c 20 0a 20 20 20 20 22 43 6f 6e 6e 65 63 74 69 6f 6e 22 3a 20 22 #> [185] 63 6c 6f 73 65 22 2c 20 0a 20 20 20 20 22 48 6f 73 74 22 3a 20 22 68 #> [208] 74 74 70 62 69 6e 2e 6f 72 67 22 2c 20 0a 20 20 20 20 22 55 73 65 72 #> [231] 2d 41 67 65 6e 74 22 3a 20 22 6c 69 62 63 75 72 6c 2f 37 2e 35 34 2e #> [254] 30 20 72 2d 63 75 72 6c 2f 33 2e 31 20 63 72 75 6c 2f 30 2e 35 2e 30 #> [277] 22 0a 20 20 7d 2c 20 0a 20 20 22 6f 72 69 67 69 6e 22 3a 20 22 35 30 #> [300] 2e 32 32 2e 31 35 35 2e 32 31 34 22 2c 20 0a 20 20 22 75 72 6c 22 3a #> [323] 20 22 68 74 74 70 73 3a 2f 2f 68 74 74 70 62 69 6e 2e 6f 72 67 2f 67 #> [346] 65 74 22 0a 7d 0a ``` HTTP method ```r res$method #> [1] "get" ``` Request headers ```r res$request_headers #> $`User-Agent` #> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> #> $`Accept-Encoding` #> [1] "gzip, deflate" #> #> $Accept #> [1] "application/json, text/xml, application/xml, */*" #> #> $a #> [1] "hello world" ``` Response headers ```r res$response_headers #> $status #> [1] "HTTP/1.1 200 OK" #> #> $connection #> [1] "keep-alive" #> #> $server #> [1] "meinheld/0.6.1" #> #> $date #> [1] "Fri, 19 Jan 2018 18:44:35 GMT" #> #> $`content-type` #> [1] "application/json" #> #> $`access-control-allow-origin` #> [1] "*" #> #> $`access-control-allow-credentials` #> [1] "true" #> #> $`x-powered-by` #> [1] "Flask" #> #> $`x-processed-time` #> [1] "0.00126600265503" #> #> $`content-length` #> [1] "351" #> #> $via #> [1] "1.1 vegur" ``` And you can parse the content with a provided function: ```r res$parse() #> [1] "{\n \"args\": {}, \n \"headers\": {\n \"A\": \"hello world\", \n \"Accept\": \"application/json, text/xml, application/xml, */*\", \n \"Accept-Encoding\": \"gzip, deflate\", \n \"Connection\": \"close\", \n \"Host\": \"httpbin.org\", \n \"User-Agent\": \"libcurl/7.54.0 r-curl/3.1 crul/0.5.0\"\n }, \n \"origin\": \"50.22.155.214\", \n \"url\": \"https://httpbin.org/get\"\n}\n" jsonlite::fromJSON(res$parse()) #> $args #> named list() #> #> $headers #> $headers$A #> [1] "hello world" #> #> $headers$Accept #> [1] "application/json, text/xml, application/xml, */*" #> #> $headers$`Accept-Encoding` #> [1] "gzip, deflate" #> #> $headers$Connection #> [1] "close" #> #> $headers$Host #> [1] "httpbin.org" #> #> $headers$`User-Agent` #> [1] "libcurl/7.54.0 r-curl/3.1 crul/0.5.0" #> #> #> $origin #> [1] "50.22.155.214" #> #> $url #> [1] "https://httpbin.org/get" ``` With the `HttpClient` object, which holds any configuration stuff we set, we can make other HTTP verb requests. For example, a `HEAD` request: ```r x$post( path = "post", body = list(hello = "world") ) ``` ## write to disk ```r x <- HttpClient$new(url = "https://httpbin.org") f <- tempfile() res <- x$get(disk = f) # when using write to disk, content is a path res$content #> [1] "/var/folders/fc/n7g_vrvn0sx_st0p8lxb3ts40000gn/T//Rtmp2d65n7/file58e3155bfa5b" ``` Read lines ```r readLines(res$content, n = 10) #> [1] "" #> [2] "" #> [3] "" #> [4] " " #> [5] " " #> [6] " httpbin(1): HTTP Client Testing Service" #> [7] "