├── LICENSE ├── tests ├── test-all.R └── testthat │ ├── test-as_df.R │ ├── test-http_client.R │ ├── test-api_error_handler.R │ ├── test-api_write.R │ ├── test-print.req.R │ ├── test-api_body.R │ ├── test-as.url.R │ ├── test-config-fxns.R │ ├── test-http.R │ ├── test-api.R │ ├── test-api_query.R │ ├── test-api_headers.R │ ├── test-as.req.R │ ├── test-api_template.R │ ├── test-internal_fxns.R │ ├── test-api_path.R │ ├── test-request_iterator.R │ └── test-authentication.R ├── .gitignore ├── NEWS.md ├── R ├── pipe.R ├── as.url.R ├── api_template.R ├── config.R ├── peep.R ├── as_df.R ├── api_write.R ├── as.req.R ├── api_path.R ├── errors.R ├── headers.R ├── api.R ├── query.R ├── request-package.R ├── body.R ├── caching.R ├── print-req.R ├── pipe_helpers.R ├── http.R ├── zzz.R ├── authentication.R └── RequestIterator.R ├── .Rbuildignore ├── man ├── pipe.Rd ├── as_df.Rd ├── api_write.Rd ├── api_headers.Rd ├── peep.Rd ├── api_config.Rd ├── api_template.Rd ├── api_cache.Rd ├── api_path.Rd ├── api_error_handler.Rd ├── api.Rd ├── api_query.Rd ├── http.Rd ├── request-package.Rd ├── api_body.Rd └── auth.Rd ├── cran-comments.md ├── appveyor.yml ├── .travis.yml ├── inst └── ignore │ ├── raw.R │ ├── api_retry.R │ ├── rate_limit.R │ ├── helpers.R │ ├── get.R │ ├── paging.R │ ├── brainstorming.R │ └── RequestIterator_withpaging.R ├── Makefile ├── NAMESPACE ├── DESCRIPTION ├── .github └── CODE_OF_CONDUCT.md ├── README.Rmd └── README.md /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2020 2 | COPYRIGHT HOLDER: Scott Chamberlain 3 | -------------------------------------------------------------------------------- /tests/test-all.R: -------------------------------------------------------------------------------- 1 | library("testthat") 2 | test_check("request") 3 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .DS_Store 5 | README.html 6 | .httr-oauth 7 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | request 0.1.0 2 | ============= 3 | 4 | NEW FEATURES 5 | 6 | * Released to CRAN. 7 | -------------------------------------------------------------------------------- /R/pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' @name %>% 4 | #' @rdname pipe 5 | #' @keywords internal 6 | #' @export 7 | #' @usage lhs \%>\% rhs 8 | NULL 9 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | README.Rmd 4 | README.html 5 | .travis.yml 6 | appveyor.yml 7 | ^\.httr-oauth$ 8 | NEWS.md 9 | cran-comments.md 10 | .github 11 | ^Makefile$ 12 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/pipe.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | Pipe operator 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | I have read and agree to the the CRAN policies at 2 | http://cran.r-project.org/web/packages/policies.html 3 | 4 | R CMD CHECK passed on my local OS X install with R 3.2.3 and 5 | R development version, Ubuntu running on Travis-CI, and Windows 6 | R 3.2.2 and devel on Win-Builder. 7 | 8 | This is a new submission. 9 | 10 | Thanks! 11 | Scott Chamberlain 12 | -------------------------------------------------------------------------------- /tests/testthat/test-as_df.R: -------------------------------------------------------------------------------- 1 | context("as_df") 2 | 3 | test_that("as_df works", { 4 | mtlist <- apply(iris, 1, as.list) 5 | aa <- as_df(mtlist) 6 | 7 | expect_is(aa, "data.frame") 8 | expect_named(iris, c('Sepal.Length','Sepal.Width','Petal.Length','Petal.Width','Species')) 9 | expect_named(aa, c('Sepal.Length','Sepal.Width','Petal.Length','Petal.Width','Species')) 10 | 11 | ## FIXME - should be identical 12 | # expect_identical(aa, iris) 13 | }) 14 | -------------------------------------------------------------------------------- /appveyor.yml: -------------------------------------------------------------------------------- 1 | init: 2 | ps: | 3 | $ErrorActionPreference = "Stop" 4 | Invoke-WebRequest http://raw.github.com/krlmlr/r-appveyor/master/scripts/appveyor-tool.ps1 -OutFile "..\appveyor-tool.ps1" 5 | Import-Module '..\appveyor-tool.ps1' 6 | 7 | install: 8 | ps: Bootstrap 9 | 10 | build_script: 11 | - travis-tool.sh install_deps 12 | 13 | test_script: 14 | - travis-tool.sh run_tests 15 | 16 | on_failure: 17 | - travis-tool.sh dump_logs 18 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: r 2 | cache: packages 3 | os: linux 4 | dist: xenial 5 | 6 | r_packages: 7 | - covr 8 | 9 | jobs: 10 | include: 11 | - os: linux 12 | r: oldrel 13 | - os: linux 14 | r: release 15 | env: R_CODECOV=true 16 | - os: linux 17 | r: devel 18 | 19 | after_success: 20 | - if [[ "${R_CODECOV}" ]]; then R -e 'covr::codecov()'; fi 21 | 22 | notifications: 23 | email: 24 | on_success: change 25 | on_failure: change 26 | -------------------------------------------------------------------------------- /R/as.url.R: -------------------------------------------------------------------------------- 1 | as.rurl <- function(x) { 2 | UseMethod("as.rurl") 3 | } 4 | 5 | as.rurl.rurl <- function(x) x 6 | 7 | as.rurl.character <- function(x) { 8 | if (is_url(x)) { 9 | x <- add_scheme(x) 10 | } else if ( is_port(x) ) { 11 | x <- paste0("http://localhost:", sub("^:", "", x)) 12 | } else { 13 | x 14 | } 15 | if (!has_scheme(x)) { 16 | x <- add_scheme(x) 17 | } 18 | structure(x, class = "rurl") 19 | } 20 | 21 | as.rurl.numeric <- function(x) { 22 | as.rurl(as.character(x)) 23 | } 24 | -------------------------------------------------------------------------------- /inst/ignore/raw.R: -------------------------------------------------------------------------------- 1 | #' get raw data 2 | #' 3 | #' @param .obj Data 4 | #' @param .data A request object 5 | #' @param .dots xxx 6 | #' @param parse (logical) To parse or not 7 | #' @param ... further args 8 | #' 9 | #' @name raw 10 | NULL 11 | 12 | #' @export 13 | #' @rdname raw 14 | raw <- function(.obj = list(), ...){ 15 | raw_(.obj, .dots = lazyeval::lazy_dots(...), parse = TRUE) 16 | } 17 | 18 | #' @export 19 | #' @rdname raw 20 | raw_ <- function(.data = list(), ..., .dots, parse = TRUE){ 21 | dots <- lazyeval::all_dots(.dots, ...) 22 | Get(.data, dots) 23 | } 24 | -------------------------------------------------------------------------------- /tests/testthat/test-http_client.R: -------------------------------------------------------------------------------- 1 | context("http_client") 2 | 3 | test_that("http_client works", { 4 | skip_on_cran() 5 | 6 | aa <- api("http://api.plos.org/search") %>% 7 | api_query(q = ecology, wt = json, fl = 'id,journal') %>% 8 | http_client() 9 | 10 | expect_is(aa, "RequestIterator") 11 | expect_is(aa$body(), "response") 12 | expect_is(aa$count(), "integer") 13 | expect_is(aa$parse(), "list") 14 | }) 15 | 16 | test_that("http_client fails well", { 17 | skip_on_cran() 18 | 19 | expect_error(http_client(), "argument \"req\" is missing") 20 | }) 21 | -------------------------------------------------------------------------------- /man/as_df.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/as_df.R 3 | \name{as_df} 4 | \alias{as_df} 5 | \title{Attempt to convert list to a data.frame} 6 | \usage{ 7 | as_df(x, clean = TRUE) 8 | } 9 | \arguments{ 10 | \item{x}{input, a list} 11 | 12 | \item{clean}{(logical) clean 0 length elements. Default: \code{TRUE}} 13 | } 14 | \description{ 15 | Attempt to convert list to a data.frame 16 | } 17 | \examples{ 18 | mtlist <- apply(mtcars, 1, as.list) 19 | as_df(mtlist) 20 | 21 | mtlist <- apply(mtcars, 1, as.list) 22 | mtlist[[1]]$mpg <- list() 23 | as_df(mtlist) 24 | } 25 | -------------------------------------------------------------------------------- /tests/testthat/test-api_error_handler.R: -------------------------------------------------------------------------------- 1 | context("api_error_handler") 2 | 3 | test_that("api_error_handler works", { 4 | skip_on_cran() 5 | 6 | expect_error( 7 | api('http://httpbin.org/status/503') %>% api_error_handler(stop_for_status), 8 | class = "http_error" 9 | ) 10 | 11 | expect_error( 12 | api('http://httpbin.org/status/404') %>% api_error_handler(stop_for_status), 13 | class = "http_error" 14 | ) 15 | 16 | expect_error( 17 | api("http://httpbin.org/status/501") %>% api_error_handler(stop_for_status), 18 | class = "http_error" 19 | ) 20 | 21 | expect_error(api_error_handler(), "argument \".data\" is missing") 22 | }) 23 | -------------------------------------------------------------------------------- /R/api_template.R: -------------------------------------------------------------------------------- 1 | #' API path template 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param template Template to contstruct API route 6 | #' @param data Data to pass to the template parameter 7 | #' @family dsl 8 | #' @examples \dontrun{ 9 | #' repo_info <- list(username = 'craigcitro', repo = 'r-travis') 10 | #' api('https://api.github.com/') %>% 11 | #' api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) 12 | #' } 13 | api_template <- function(.data, template, data) { 14 | pipe_autoexec(toggle = TRUE) 15 | .data <- as.req(.data) 16 | temp <- whisker::whisker.render(template, data) 17 | modifyList(.data, list(template = temp)) 18 | } 19 | -------------------------------------------------------------------------------- /R/config.R: -------------------------------------------------------------------------------- 1 | #' Curl settings 2 | #' 3 | #' @export 4 | #' @family dsl 5 | #' @param .data Result of a call to \code{api} 6 | #' @param ... Comma separated list of unquoted variable names 7 | #' @examples \dontrun{ 8 | #' # Config handler 9 | #' api('http://api.crossref.org/works') %>% 10 | #' api_config(verbose(), progress()) %>% 11 | #' peep() 12 | #' 13 | #' xx <- api('http://api.crossref.org') %>% 14 | #' api_path(works, 10.3897/zookeys.515.9459) %>% 15 | #' api_config(verbose()) 16 | #' } 17 | api_config <- function(.data, ...) { 18 | pipe_autoexec(toggle = TRUE) 19 | .data <- as.req(.data) 20 | tmp <- list(...) 21 | tmp <- if (length(tmp) == 1) tmp[[1]] else do.call('c', tmp) 22 | .data$config <- combconfig(list(.data$config, tmp)) 23 | return(.data) 24 | } 25 | -------------------------------------------------------------------------------- /R/peep.R: -------------------------------------------------------------------------------- 1 | #' Peek at a query 2 | #' 3 | #' @export 4 | #' @param .data (list) input, using higher level interface 5 | #' @examples \dontrun{ 6 | #' api('https://api.github.com/') %>% peep 7 | #' api('https://api.github.com/') %>% 8 | #' api_path(repos, ropensci, rgbif, issues) %>% 9 | #' peep 10 | #' 11 | #' repo_info <- list(username = 'craigcitro', repo = 'r-travis') 12 | #' api('https://api.github.com/') %>% 13 | #' api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) %>% 14 | #' peep 15 | #' 16 | #' api("http://api.plos.org/search") %>% 17 | #' api_query(q = ecology, wt = json, fl = id, fl = journal) %>% 18 | #' peep 19 | #' } 20 | peep <- function(.data) { 21 | pipe_autoexec(toggle = FALSE) 22 | structure(.data, class = "req") 23 | } 24 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | PACKAGE := $(shell grep '^Package:' DESCRIPTION | sed -E 's/^Package:[[:space:]]+//') 2 | RSCRIPT = Rscript --no-init-file 3 | 4 | install: doc build 5 | R CMD INSTALL . && rm *.tar.gz 6 | 7 | build: 8 | R CMD build . 9 | 10 | doc: 11 | ${RSCRIPT} -e "devtools::document()" 12 | 13 | eg: 14 | ${RSCRIPT} -e "devtools::run_examples(run = TRUE)" 15 | 16 | check: build 17 | _R_CHECK_CRAN_INCOMING_=FALSE R CMD CHECK --as-cran --no-manual `ls -1tr ${PACKAGE}*gz | tail -n1` 18 | @rm -f `ls -1tr ${PACKAGE}*gz | tail -n1` 19 | @rm -rf ${PACKAGE}.Rcheck 20 | 21 | test: 22 | ${RSCRIPT} -e "devtools::test()" 23 | 24 | check_windows: 25 | ${RSCRIPT} -e "devtools::check_win_devel(); devtools::check_win_release()" 26 | 27 | readme: 28 | ${RSCRIPT} -e "knitr::knit('README.Rmd')" 29 | -------------------------------------------------------------------------------- /man/api_write.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/api_write.R 3 | \name{api_write} 4 | \alias{api_write} 5 | \title{Write helper} 6 | \usage{ 7 | api_write(.data, file, overwrite = FALSE, ...) 8 | } 9 | \arguments{ 10 | \item{.data}{Result of a call to \code{api}} 11 | 12 | \item{file}{(character) Full file path to write to} 13 | 14 | \item{overwrite}{(logical) Will only overwrite existing path if \code{TRUE}} 15 | 16 | \item{...}{ignored for now} 17 | } 18 | \description{ 19 | Write helper 20 | } 21 | \examples{ 22 | \dontrun{ 23 | ## write to disk 24 | ff <- tempfile(fileext = ".json") 25 | api('https://api.github.com/') \%>\% 26 | api_path(repos, ropensci, rgbif, issues) \%>\% 27 | api_write(ff) 28 | jsonlite::fromJSON(ff) 29 | } 30 | } 31 | -------------------------------------------------------------------------------- /tests/testthat/test-api_write.R: -------------------------------------------------------------------------------- 1 | context("api_write") 2 | 3 | test_that("api_write works", { 4 | skip_on_cran() 5 | 6 | expect_is(api_write(api("http://api.plos.org/search"), tempfile()), "req") 7 | 8 | aa <- api("http://httpbin.org/get") %>% 9 | api_write(tempfile()) %>% 10 | peep 11 | 12 | bb <- api("http://httpbin.org/get") %>% 13 | api_write(tempfile(), overwrite = TRUE) %>% 14 | peep 15 | 16 | expect_is(aa, "req") 17 | expect_is(bb, "req") 18 | 19 | expect_is(aa$url, "rurl") 20 | expect_is(bb$config$output$path, "character") 21 | 22 | expect_is(aa %>% http, "character") 23 | expect_is(bb %>% http, "character") 24 | }) 25 | 26 | test_that("api_write fails well", { 27 | skip_on_cran() 28 | 29 | expect_error(api_write(), "argument \".data\" is missing") 30 | }) 31 | -------------------------------------------------------------------------------- /man/api_headers.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/headers.R 3 | \name{api_headers} 4 | \alias{api_headers} 5 | \alias{api_headers_} 6 | \title{Headers} 7 | \usage{ 8 | api_headers(.data, ..., .dots) 9 | 10 | api_headers_(.data, ..., .dots) 11 | } 12 | \arguments{ 13 | \item{.data}{Result of a call to \code{api}} 14 | 15 | \item{...}{Key value pairs of headers} 16 | 17 | \item{.dots}{Used to work around non-standard evaluation} 18 | } 19 | \description{ 20 | Headers 21 | } 22 | \examples{ 23 | \dontrun{ 24 | api('https://api.github.com/') \%>\% 25 | api_config(verbose()) \%>\% 26 | api_headers(`X-FARGO-SEASON` = 3) \%>\% 27 | peep 28 | 29 | api('http://httpbin.org/headers') \%>\% 30 | api_config(verbose()) \%>\% 31 | api_headers(`X-FARGO-SEASON` = 3, `X-NARCOS-SEASON` = 5) 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /man/peep.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/peep.R 3 | \name{peep} 4 | \alias{peep} 5 | \title{Peek at a query} 6 | \usage{ 7 | peep(.data) 8 | } 9 | \arguments{ 10 | \item{.data}{(list) input, using higher level interface} 11 | } 12 | \description{ 13 | Peek at a query 14 | } 15 | \examples{ 16 | \dontrun{ 17 | api('https://api.github.com/') \%>\% peep 18 | api('https://api.github.com/') \%>\% 19 | api_path(repos, ropensci, rgbif, issues) \%>\% 20 | peep 21 | 22 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 23 | api('https://api.github.com/') \%>\% 24 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) \%>\% 25 | peep 26 | 27 | api("http://api.plos.org/search") \%>\% 28 | api_query(q = ecology, wt = json, fl = id, fl = journal) \%>\% 29 | peep 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /R/as_df.R: -------------------------------------------------------------------------------- 1 | #' Attempt to convert list to a data.frame 2 | #' 3 | #' @export 4 | #' @param x input, a list 5 | #' @param clean (logical) clean 0 length elements. Default: \code{TRUE} 6 | #' @examples 7 | #' mtlist <- apply(mtcars, 1, as.list) 8 | #' as_df(mtlist) 9 | #' 10 | #' mtlist <- apply(mtcars, 1, as.list) 11 | #' mtlist[[1]]$mpg <- list() 12 | #' as_df(mtlist) 13 | as_df <- function(x, clean = TRUE) { 14 | if (!requireNamespace("data.table")) { 15 | stop("please install data.table", call. = FALSE) 16 | } 17 | 18 | if (clean) { 19 | # top level 20 | len1 <- vapply(x, length, 1) 21 | x[len1 == 0] <- NULL 22 | 23 | # lower levels 24 | x <- lapply(x, function(z) { 25 | len2 <- vapply(z, length, 1) 26 | z[len2 == 0] <- NULL 27 | z 28 | }) 29 | } 30 | 31 | (xxx <- data.table::setDF(data.table::rbindlist(x, fill = TRUE, use.names = TRUE))) 32 | } 33 | -------------------------------------------------------------------------------- /tests/testthat/test-print.req.R: -------------------------------------------------------------------------------- 1 | context("print.req") 2 | 3 | test_that("print.req - character input", { 4 | expect_output(print(as.req("9200")), "") 5 | expect_output(print(as.req("9200")), "url: ") 6 | expect_output(print(as.req("9200")), "paths: ") 7 | expect_output(print(as.req("9200")), "query: ") 8 | expect_output(print(as.req("9200")), "body: ") 9 | expect_output(print(as.req("9200")), "paging: ") 10 | expect_output(print(as.req("9200")), "headers: ") 11 | expect_output(print(as.req("9200")), "rate limit: ") 12 | expect_output(print(as.req("9200")), "error handler: ") 13 | expect_output(print(as.req("9200")), "config: ") 14 | 15 | expect_output(print(api_config(api("http://httpbin.org/get"), verbose())), "verbose: TRUE") 16 | }) 17 | 18 | test_that("print.req fails well", { 19 | expect_error(capture_output(print.req()), "argument \"x\" is missing") 20 | }) 21 | -------------------------------------------------------------------------------- /R/api_write.R: -------------------------------------------------------------------------------- 1 | #' Write helper 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param file (character) Full file path to write to 6 | #' @param overwrite (logical) Will only overwrite existing path if \code{TRUE} 7 | #' @param ... ignored for now 8 | #' @examples \dontrun{ 9 | #' ## write to disk 10 | #' ff <- tempfile(fileext = ".json") 11 | #' api('https://api.github.com/') %>% 12 | #' api_path(repos, ropensci, rgbif, issues) %>% 13 | #' api_write(ff) 14 | #' jsonlite::fromJSON(ff) 15 | #' } 16 | api_write <- function(.data, file, overwrite = FALSE, ...){ 17 | pipe_autoexec(toggle = TRUE) 18 | .data <- as.req(.data) 19 | # modifyList(.data, list( 20 | # write = write_disk(path = file, overwrite = overwrite)) 21 | # ) 22 | tmp <- write_disk(path = file, overwrite = overwrite) 23 | .data$config <- combconfig(list(.data$config, tmp)) 24 | return(.data) 25 | } 26 | -------------------------------------------------------------------------------- /R/as.req.R: -------------------------------------------------------------------------------- 1 | # as request functions and print method for request S3 class 2 | as.req <- function(x) { 3 | UseMethod("as.req") 4 | } 5 | 6 | as.req.default <- function(x) { 7 | stop("no as.req method for ", class(x), call. = FALSE) 8 | } 9 | 10 | as.req.req <- function(x) { 11 | if (!"cache" %in% names(x)) x$cache <- FALSE 12 | x 13 | } 14 | 15 | as.req.endpoint <- function(x){ 16 | x <- req(x$url) 17 | if (!"cache" %in% names(x)) x$cache <- FALSE 18 | x 19 | } 20 | 21 | as.req.rurl <- function(x){ 22 | x <- req(x[[1]]) 23 | if (!"cache" %in% names(x)) x$cache <- FALSE 24 | x 25 | } 26 | 27 | as.req.character <- function(x){ 28 | if (is_url(tryCatch(as.rurl(x), error = function(e) e))) { 29 | x <- req(x) 30 | if (!"cache" %in% names(x)) x$cache <- FALSE 31 | x 32 | } else { 33 | stop("error ...") 34 | } 35 | } 36 | 37 | req <- function(x){ 38 | structure(list(url = as.rurl(x)), class = "req") 39 | } 40 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,endpoint) 4 | S3method(print,req) 5 | export("%>%") 6 | export(api) 7 | export(api_body) 8 | export(api_body_) 9 | export(api_cache) 10 | export(api_config) 11 | export(api_error_handler) 12 | export(api_headers) 13 | export(api_headers_) 14 | export(api_oauth1) 15 | export(api_oauth2) 16 | export(api_path) 17 | export(api_path_) 18 | export(api_query) 19 | export(api_query_) 20 | export(api_simple_auth) 21 | export(api_template) 22 | export(api_write) 23 | export(as_df) 24 | export(http) 25 | export(http_client) 26 | export(peep) 27 | import(httr) 28 | importFrom(R6,R6Class) 29 | importFrom(lazyeval,all_dots) 30 | importFrom(lazyeval,lazy_dots) 31 | importFrom(magrittr,"%>%") 32 | importFrom(methods,is) 33 | importFrom(stats,setNames) 34 | importFrom(utils,head) 35 | importFrom(utils,modifyList) 36 | importFrom(utils,packageVersion) 37 | importFrom(whisker,whisker.render) 38 | -------------------------------------------------------------------------------- /inst/ignore/api_retry.R: -------------------------------------------------------------------------------- 1 | #' Retry on failed request N times 2 | #' 3 | #' FIXME: still need to implement doing this in the request 4 | #' 5 | #' @export 6 | #' @param .data Result of a call to \code{api} 7 | #' @param n Number of times to repeat the request 8 | #' @param time Number of seconds to delay between repeated calls 9 | #' 10 | #' @details This doesn't use the retry option within curl itself, 11 | #' as it's not available via the \code{curl} R client. Instead, we 12 | #' retry X times you specify, if the previous call failed. 13 | #' 14 | #' @examples \dontrun{ 15 | #' api('http://httpbin.org/status/500') %>% 16 | #' api_path(repos, asdfasdf) %>% 17 | #' api_retry(n = 5) %>% 18 | #' peep 19 | #' 20 | #' api('http://127.0.0.1:8080') %>% 21 | #' api_retry(n = 5, time = 2) %>% 22 | #' http 23 | #' } 24 | api_retry <- function(.data, n, time = 1) { 25 | .data <- as.req(.data) 26 | modifyList(.data, list(retry = list(n = n, time = time))) 27 | } 28 | -------------------------------------------------------------------------------- /man/api_config.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/config.R 3 | \name{api_config} 4 | \alias{api_config} 5 | \title{Curl settings} 6 | \usage{ 7 | api_config(.data, ...) 8 | } 9 | \arguments{ 10 | \item{.data}{Result of a call to \code{api}} 11 | 12 | \item{...}{Comma separated list of unquoted variable names} 13 | } 14 | \description{ 15 | Curl settings 16 | } 17 | \examples{ 18 | \dontrun{ 19 | # Config handler 20 | api('http://api.crossref.org/works') \%>\% 21 | api_config(verbose(), progress()) \%>\% 22 | peep() 23 | 24 | xx <- api('http://api.crossref.org') \%>\% 25 | api_path(works, 10.3897/zookeys.515.9459) \%>\% 26 | api_config(verbose()) 27 | } 28 | } 29 | \seealso{ 30 | Other dsl: 31 | \code{\link{api_body}()}, 32 | \code{\link{api_error_handler}()}, 33 | \code{\link{api_path}()}, 34 | \code{\link{api_query}()}, 35 | \code{\link{api_template}()}, 36 | \code{\link{api}()}, 37 | \code{\link{auth}} 38 | } 39 | \concept{dsl} 40 | -------------------------------------------------------------------------------- /tests/testthat/test-api_body.R: -------------------------------------------------------------------------------- 1 | context("api_body") 2 | 3 | test_that("api_body works", { 4 | skip_on_cran() 5 | 6 | expect_is(api_body(api("http://api.plos.org/search"), a = 5), "req") 7 | 8 | aa <- api("https://httpbin.org/post") %>% 9 | api_body(a = 5, b = "Adfafasd") %>% 10 | peep 11 | 12 | bb <- api("https://httpbin.org/post") %>% 13 | api_body(a = 5, b = "Adfafasd") %>% 14 | peep 15 | 16 | cc <- api("https://httpbin.org/post") %>% 17 | api_body_(wt = "json", fl = 'id', fl = 'journal') %>% 18 | peep 19 | 20 | expect_is(aa, "req") 21 | expect_is(bb, "req") 22 | expect_is(cc, "req") 23 | 24 | expect_is(aa$url, "rurl") 25 | expect_is(bb$body, "list") 26 | 27 | expect_is(aa %>% http("POST"), "list") 28 | expect_is(bb %>% http("POST"), "list") 29 | expect_is(cc %>% http("POST"), "list") 30 | }) 31 | 32 | test_that("api_body fails well", { 33 | skip_on_cran() 34 | 35 | expect_error(api_body(), "argument \".data\" is missing") 36 | }) 37 | -------------------------------------------------------------------------------- /R/api_path.R: -------------------------------------------------------------------------------- 1 | #' API paths 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param ... Comma separated list of unquoted variable names 6 | #' @param .dots Used to work around non-standard evaluation 7 | #' @family dsl 8 | #' @examples \dontrun{ 9 | #' # set paths 10 | #' ## NSE 11 | #' api('https://api.github.com/') %>% 12 | #' api_path(repos, ropensci, rgbif, issues) 13 | #' ## SE 14 | #' api('https://api.github.com/') %>% 15 | #' api_path_('repos', 'ropensci', 'rgbif', 'issues') 16 | #' } 17 | api_path <- function(.data, ..., .dots) { 18 | api_path_(.data, .dots = lazyeval::lazy_dots(...)) 19 | } 20 | 21 | #' @export 22 | #' @rdname api_path 23 | api_path_ <- function(.data, ..., .dots) { 24 | pipe_autoexec(toggle = TRUE) 25 | tmp <- lazyeval::all_dots(.dots, ...) 26 | .data <- as.req(.data) 27 | modifyList(.data, list(paths = getpaths(tmp))) 28 | } 29 | 30 | getpaths <- function(x) { 31 | unname(sapply(x, function(z) as.character(z$expr))) 32 | } 33 | -------------------------------------------------------------------------------- /man/api_template.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/api_template.R 3 | \name{api_template} 4 | \alias{api_template} 5 | \title{API path template} 6 | \usage{ 7 | api_template(.data, template, data) 8 | } 9 | \arguments{ 10 | \item{.data}{Result of a call to \code{api}} 11 | 12 | \item{template}{Template to contstruct API route} 13 | 14 | \item{data}{Data to pass to the template parameter} 15 | } 16 | \description{ 17 | API path template 18 | } 19 | \examples{ 20 | \dontrun{ 21 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 22 | api('https://api.github.com/') \%>\% 23 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) 24 | } 25 | } 26 | \seealso{ 27 | Other dsl: 28 | \code{\link{api_body}()}, 29 | \code{\link{api_config}()}, 30 | \code{\link{api_error_handler}()}, 31 | \code{\link{api_path}()}, 32 | \code{\link{api_query}()}, 33 | \code{\link{api}()}, 34 | \code{\link{auth}} 35 | } 36 | \concept{dsl} 37 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: request 2 | Title: High Level 'HTTP' Client 3 | Description: High level and easy 'HTTP' client for 'R' that makes assumptions 4 | that should work in most cases. Provides functions for building 'HTTP' 5 | queries, including query parameters, body requests, headers, authentication, 6 | and more. 7 | Version: 0.1.6.91 8 | Authors@R: person("Scott", "Chamberlain", role = c("aut", "cre"), 9 | email = "myrmecocystus@gmail.com") 10 | License: MIT + file LICENSE 11 | URL: https://github.com/sckott/request 12 | BugReports: https://github.com/sckott/request/issues 13 | Encoding: UTF-8 14 | Depends: 15 | httr (>= 1.2.0) 16 | Imports: 17 | methods, 18 | stats, 19 | utils, 20 | curl (>= 2.2), 21 | jsonlite (>= 1.1), 22 | magrittr (>= 1.5), 23 | lazyeval (>= 0.2.0), 24 | whisker (>= 0.3-2), 25 | R6 (>= 2.2.0), 26 | tibble (>= 1.2), 27 | digest, 28 | rappdirs 29 | Suggests: 30 | testthat, 31 | data.table 32 | RoxygenNote: 7.1.0 33 | -------------------------------------------------------------------------------- /tests/testthat/test-as.url.R: -------------------------------------------------------------------------------- 1 | context("as.rurl") 2 | 3 | test_that("as.rurl works", { 4 | aa <- as.rurl(5000) 5 | bb <- as.rurl("5000") 6 | cc <- as.rurl(':9200') 7 | dd <- as.rurl('9200') 8 | ee <- as.rurl('9200/stuff') 9 | ff <- as.rurl('api.crossreg.org') 10 | 11 | expect_is(aa, "rurl") 12 | expect_is(bb, "rurl") 13 | expect_is(cc, "rurl") 14 | expect_is(dd, "rurl") 15 | expect_is(ee, "rurl") 16 | expect_is(ff, "rurl") 17 | 18 | expect_true(grepl("localhost", aa)) 19 | expect_true(grepl("localhost", bb)) 20 | expect_true(grepl("localhost", cc)) 21 | expect_true(grepl("localhost", dd)) 22 | expect_true(grepl("localhost", ee)) 23 | 24 | expect_true(grepl("http", ff)) 25 | 26 | expect_true(grepl("5000", aa)) 27 | expect_true(grepl("5000", bb)) 28 | expect_true(grepl("9200", cc)) 29 | expect_true(grepl("9200", dd)) 30 | expect_true(grepl("9200", ee)) 31 | }) 32 | 33 | test_that("as.url fails well", { 34 | expect_error(as.rurl(), "no applicable method") 35 | }) 36 | -------------------------------------------------------------------------------- /man/api_cache.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/caching.R 3 | \name{api_cache} 4 | \alias{api_cache} 5 | \title{Caching helper} 6 | \usage{ 7 | api_cache(.data, dir = NULL, ...) 8 | } 9 | \arguments{ 10 | \item{.data}{Result of a call to \code{api}} 11 | 12 | \item{dir}{(character) Directory to cache in. Uses 13 | \code{rappdirs::user_cache_dir()} by default} 14 | 15 | \item{...}{ignored} 16 | } 17 | \description{ 18 | Caching helper 19 | } 20 | \examples{ 21 | \dontrun{ 22 | # cache 23 | ## first call is slower 24 | api('http://localhost:5000') \%>\% 25 | api_path(get) \%>\% 26 | api_query(foo = "bar") \%>\% 27 | api_cache() 28 | 29 | ## second call is faster, pulling from cache 30 | api('http://localhost:5000') \%>\% 31 | api_path(get) \%>\% 32 | api_query(foo = "bar") \%>\% 33 | api_cache() 34 | 35 | # other egs 36 | x <- api('api.crossref.org') \%>\% 37 | api_path(works) \%>\% 38 | api_query(rows = 1000) \%>\% 39 | api_cache() 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /R/errors.R: -------------------------------------------------------------------------------- 1 | #' Error handler 2 | #' 3 | #' @export 4 | #' @family dsl 5 | #' @param .data Result of a call to \code{api} 6 | #' @param fun A function, either defined in the session, or a function available in loaded 7 | #' or name-spaced packges 8 | #' @examples \dontrun{ 9 | #' # Use functions from httr 10 | #' api('http://httpbin.org/status/503') %>% 11 | #' api_error_handler(stop_for_status) 12 | #' 13 | #' api('http://httpbin.org/status/404') %>% 14 | #' api_error_handler(warn_for_status) 15 | #' 16 | #' # Custom error handling functions 17 | #' my_stop <- function(x) { 18 | #' if (x$status > 200) { 19 | #' warning("nope, try again", call. = FALSE) 20 | #' } 21 | #' } 22 | #' api("http://httpbin.org/status/404") %>% 23 | #' api_error_handler(my_stop) 24 | #' } 25 | api_error_handler <- function(.data, fun) { 26 | pipe_autoexec(toggle = TRUE) 27 | .data <- as.req(.data) 28 | fn_name <- deparse(substitute(fun)) 29 | tmp <- setNames(list(fun), fn_name) 30 | modifyList(.data, list(error = tmp)) 31 | } 32 | -------------------------------------------------------------------------------- /tests/testthat/test-config-fxns.R: -------------------------------------------------------------------------------- 1 | context("config fxns") 2 | 3 | test_that("all config fxns work as expected", { 4 | skip_on_cran() 5 | 6 | aa <- api("localhost:9000/get") %>% 7 | api_headers(a = 5) %>% 8 | api_simple_auth(user = "adf", pwd = "af") %>% 9 | api_config(verbose()) %>% 10 | api_write(tempfile()) %>% 11 | peep 12 | 13 | expect_is(aa, "req") 14 | expect_is(aa$url, "rurl") 15 | expect_is(aa$config, "request") 16 | expect_named(aa$config$headers, "a") 17 | expect_equal(aa$config$options$userpwd, "adf:af") 18 | expect_true(aa$config$options$verbose) 19 | expect_is(aa$config$output$path, "character") 20 | 21 | # bb <- api("localhost:9000/get") %>% 22 | # api_config(verbose()) %>% 23 | # api_simple_auth(user = "adf", pwd = "af") %>% 24 | # api_headers(a = 5) %>% 25 | # api_write(tempfile()) %>% 26 | # peep 27 | }) 28 | 29 | test_that("config fxn combinations fail well", { 30 | skip_on_cran() 31 | 32 | expect_error(api_query(), "argument \".data\" is missing") 33 | }) 34 | -------------------------------------------------------------------------------- /man/api_path.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/api_path.R 3 | \name{api_path} 4 | \alias{api_path} 5 | \alias{api_path_} 6 | \title{API paths} 7 | \usage{ 8 | api_path(.data, ..., .dots) 9 | 10 | api_path_(.data, ..., .dots) 11 | } 12 | \arguments{ 13 | \item{.data}{Result of a call to \code{api}} 14 | 15 | \item{...}{Comma separated list of unquoted variable names} 16 | 17 | \item{.dots}{Used to work around non-standard evaluation} 18 | } 19 | \description{ 20 | API paths 21 | } 22 | \examples{ 23 | \dontrun{ 24 | # set paths 25 | ## NSE 26 | api('https://api.github.com/') \%>\% 27 | api_path(repos, ropensci, rgbif, issues) 28 | ## SE 29 | api('https://api.github.com/') \%>\% 30 | api_path_('repos', 'ropensci', 'rgbif', 'issues') 31 | } 32 | } 33 | \seealso{ 34 | Other dsl: 35 | \code{\link{api_body}()}, 36 | \code{\link{api_config}()}, 37 | \code{\link{api_error_handler}()}, 38 | \code{\link{api_query}()}, 39 | \code{\link{api_template}()}, 40 | \code{\link{api}()}, 41 | \code{\link{auth}} 42 | } 43 | \concept{dsl} 44 | -------------------------------------------------------------------------------- /tests/testthat/test-http.R: -------------------------------------------------------------------------------- 1 | context("http") 2 | 3 | test_that("http works", { 4 | skip_on_cran() 5 | 6 | aa1 <- api("http://api.plos.org/search") %>% 7 | api_query(q = ecology, wt = json, fl = 'id,journal') 8 | 9 | aa2 <- api("http://api.plos.org/search") %>% 10 | api_query(q = ecology, wt = json, fl = 'id,journal') %>% 11 | peep() 12 | 13 | expect_is(aa1, "list") 14 | expect_is(aa2, "req") 15 | expect_identical(aa1, aa2 %>% http) 16 | 17 | expect_identical(http(api_oauth2(api("https://api.github.com"), token = Sys.getenv("GITHUB_PAT"))), 18 | api("https://api.github.com") %>% api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% http 19 | ) 20 | 21 | x <- api("http://httpbin.org/post") %>% 22 | api_body(x = "A simple text string") %>% 23 | http("POST") 24 | expect_is(x, "list") 25 | }) 26 | 27 | test_that("http fails well", { 28 | skip_on_cran() 29 | 30 | expect_error(http(), "argument \"req\" is missing") 31 | expect_error(http(api("https://api.github.com"), method = "FART"), 32 | "method must be one of GET, POST, or PUT") 33 | }) 34 | -------------------------------------------------------------------------------- /R/headers.R: -------------------------------------------------------------------------------- 1 | #' Headers 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param ... Key value pairs of headers 6 | #' @param .dots Used to work around non-standard evaluation 7 | #' @examples \dontrun{ 8 | #' api('https://api.github.com/') %>% 9 | #' api_config(verbose()) %>% 10 | #' api_headers(`X-FARGO-SEASON` = 3) %>% 11 | #' peep 12 | #' 13 | #' api('http://httpbin.org/headers') %>% 14 | #' api_config(verbose()) %>% 15 | #' api_headers(`X-FARGO-SEASON` = 3, `X-NARCOS-SEASON` = 5) 16 | #' } 17 | api_headers <- function(.data, ..., .dots) { 18 | api_headers_(.data, .dots = lazyeval::lazy_dots(...)) 19 | } 20 | 21 | #' @export 22 | #' @rdname api_headers 23 | api_headers_ <- function(.data, ..., .dots) { 24 | pipe_autoexec(toggle = TRUE) 25 | tmp <- lazyeval::all_dots(.dots, ...) 26 | .data <- as.req(.data) 27 | tmp <- getheads(tmp) 28 | .data$config <- combconfig(list(.data$config, tmp)) 29 | return(.data) 30 | } 31 | 32 | getheads <- function(x) { 33 | tmp <- as.list(sapply(x, function(z) as.character(z$expr))) 34 | do.call(add_headers, tmp) 35 | } 36 | -------------------------------------------------------------------------------- /tests/testthat/test-api.R: -------------------------------------------------------------------------------- 1 | context("api") 2 | 3 | test_that("api works", { 4 | skip_on_cran() 5 | 6 | aa <- "https://api.github.com/" %>% api() %>% api_oauth2(token = Sys.getenv("GITHUB_PAT")) 7 | bb <- api("https://api.github.com/") 8 | bb_get <- bb %>% api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% http() 9 | cc <- api("https://api.github.com/") %>% 10 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 11 | api_config(verbose()) %>% 12 | peep() 13 | 14 | expect_is(aa, "list") 15 | expect_is(bb, "endpoint") 16 | expect_is(bb_get, "list") 17 | 18 | expect_equal(cc$url[1], "https://api.github.com/") 19 | expect_is(cc$config, "request") 20 | expect_is(cc$config$options, "list") 21 | expect_true(cc$config$options$verbose) 22 | }) 23 | 24 | test_that("print.endpoint works", { 25 | bb <- api("https://api.github.com/") 26 | 27 | expect_output(print(bb), "URL: ") 28 | }) 29 | 30 | test_that("api fails well", { 31 | skip_on_cran() 32 | 33 | expect_error(api(), "argument \"x\" is missing") 34 | expect_error(api(NULL), "no applicable method") 35 | expect_error(5 %>% api()) 36 | }) 37 | -------------------------------------------------------------------------------- /R/api.R: -------------------------------------------------------------------------------- 1 | #' API base url and endpoint setup 2 | #' 3 | #' @export 4 | #' @param x A URL 5 | #' @family dsl 6 | #' @examples \dontrun{ 7 | #' # Set base url 8 | #' ## works with full or partial URLs 9 | #' api('https://api.github.com/') 10 | #' api('http://api.gbif.org/v1') 11 | #' api('api.gbif.org/v1') 12 | #' 13 | #' ## works with ports, full or partial 14 | #' api('http://localhost:9200') 15 | #' api('localhost:9200') 16 | #' api(':9200') 17 | #' api('9200') 18 | #' api('9200/stuff') 19 | #' 20 | #' # set paths 21 | #' ## NSE 22 | #' api('https://api.github.com/') %>% 23 | #' api_path(repos, ropensci, rgbif, issues) 24 | #' ## SE 25 | #' api('https://api.github.com/') %>% 26 | #' api_path_('repos', 'ropensci', 'rgbif', 'issues') 27 | #' 28 | #' # template 29 | #' repo_info <- list(username = 'craigcitro', repo = 'r-travis') 30 | #' api('https://api.github.com/') %>% 31 | #' api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) 32 | #' } 33 | api <- function(x) { 34 | pipe_autoexec(toggle = TRUE) 35 | structure(list(url = as.rurl(x)), class = "endpoint") 36 | } 37 | 38 | #' @export 39 | print.endpoint <- function(x, ...) { 40 | cat(sprintf("URL: %s", x$url)) 41 | } 42 | -------------------------------------------------------------------------------- /tests/testthat/test-api_query.R: -------------------------------------------------------------------------------- 1 | context("api_query") 2 | 3 | test_that("api_query works", { 4 | skip_on_cran() 5 | 6 | expect_is(api_query(api("http://api.plos.org/search")), "req") 7 | 8 | aa <- api("http://api.plos.org/search") %>% 9 | api_query(q = ecology, wt = json, fl = 'id,journal') %>% 10 | peep 11 | 12 | bb <- api("http://api.plos.org/search") %>% 13 | api_query(q = ecology, wt = json, fl = id, fl = journal) %>% 14 | peep 15 | 16 | cc <- api("http://api.plos.org/search") %>% 17 | api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') %>% 18 | peep 19 | 20 | expect_is(aa, "req") 21 | expect_is(bb, "req") 22 | expect_is(cc, "req") 23 | 24 | expect_is(aa$url, "rurl") 25 | expect_is(bb$query, "list") 26 | 27 | expect_is(aa %>% http, "list") 28 | expect_is(bb %>% http, "list") 29 | expect_is(cc %>% http, "list") 30 | 31 | expect_identical(cc %>% http, 32 | api("http://api.plos.org/search") %>% 33 | api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') 34 | ) 35 | }) 36 | 37 | test_that("api_query fails well", { 38 | skip_on_cran() 39 | 40 | expect_error(api_query(), "argument \".data\" is missing") 41 | }) 42 | -------------------------------------------------------------------------------- /tests/testthat/test-api_headers.R: -------------------------------------------------------------------------------- 1 | context("api_headers") 2 | 3 | test_that("api_headers works", { 4 | skip_on_cran() 5 | 6 | x <- api('https://api.github.com/') %>% 7 | api_headers(`X-FARGO-SEASON` = 3) %>% 8 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 9 | peep 10 | 11 | y <- api('https://api.github.com/') %>% 12 | api_headers(`X-FARGO-SEASON` = three, `Accept Token` = yellow) %>% 13 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 14 | peep 15 | 16 | yy <- api('https://api.github.com/') %>% 17 | api_headers_(`X-FARGO-SEASON` = "three", `Accept Token` = "yellow") %>% 18 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 19 | peep 20 | 21 | expect_is(x, "req") 22 | expect_is(y, "req") 23 | 24 | expect_is(x$url, "rurl") 25 | expect_is(y$url, "rurl") 26 | 27 | expect_is(x$config, "request") 28 | expect_named(x$config$headers, c("X-FARGO-SEASON", "Authorization")) 29 | 30 | expect_is(y$config, "request") 31 | expect_named(y$config$headers, c("X-FARGO-SEASON", "Accept Token", "Authorization")) 32 | 33 | expect_identical(y, yy) 34 | }) 35 | 36 | test_that("api_headers fails well", { 37 | skip_on_cran() 38 | 39 | expect_error(api_headers(), "argument \".data\" is missing") 40 | }) 41 | -------------------------------------------------------------------------------- /man/api_error_handler.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/errors.R 3 | \name{api_error_handler} 4 | \alias{api_error_handler} 5 | \title{Error handler} 6 | \usage{ 7 | api_error_handler(.data, fun) 8 | } 9 | \arguments{ 10 | \item{.data}{Result of a call to \code{api}} 11 | 12 | \item{fun}{A function, either defined in the session, or a function available in loaded 13 | or name-spaced packges} 14 | } 15 | \description{ 16 | Error handler 17 | } 18 | \examples{ 19 | \dontrun{ 20 | # Use functions from httr 21 | api('http://httpbin.org/status/503') \%>\% 22 | api_error_handler(stop_for_status) 23 | 24 | api('http://httpbin.org/status/404') \%>\% 25 | api_error_handler(warn_for_status) 26 | 27 | # Custom error handling functions 28 | my_stop <- function(x) { 29 | if (x$status > 200) { 30 | warning("nope, try again", call. = FALSE) 31 | } 32 | } 33 | api("http://httpbin.org/status/404") \%>\% 34 | api_error_handler(my_stop) 35 | } 36 | } 37 | \seealso{ 38 | Other dsl: 39 | \code{\link{api_body}()}, 40 | \code{\link{api_config}()}, 41 | \code{\link{api_path}()}, 42 | \code{\link{api_query}()}, 43 | \code{\link{api_template}()}, 44 | \code{\link{api}()}, 45 | \code{\link{auth}} 46 | } 47 | \concept{dsl} 48 | -------------------------------------------------------------------------------- /tests/testthat/test-as.req.R: -------------------------------------------------------------------------------- 1 | context("as.req") 2 | 3 | test_that("as.req - character input", { 4 | expect_is(as.req("9200"), "req") 5 | expect_is(as.req("9200")$url, "rurl") 6 | expect_is(as.req("9200")$url[[1]], "character") 7 | expect_match(as.req("9200")$url[[1]], "http") 8 | 9 | expect_is(as.req("http://api.gbif.org"), "req") 10 | expect_is(as.req("http://api.gbif.org")$url, "rurl") 11 | expect_is(as.req("http://api.gbif.org")$url[[1]], "character") 12 | }) 13 | 14 | test_that("as.req - endpoint input", { 15 | expect_is(as.req(api("api.gbif.org")), "req") 16 | expect_is(as.req(api("9200")), "req") 17 | }) 18 | 19 | test_that("as.req - req (aka: self) input", { 20 | expect_is(as.req(as.req("api.gbif.org")), "req") 21 | expect_is(as.req(as.req("9200")), "req") 22 | }) 23 | 24 | test_that("as.req - url input", { 25 | expect_is(as.rurl("9200"), "rurl") 26 | expect_is(as.req(as.rurl("9200")), "req") 27 | expect_is(as.req(as.rurl("9200"))$url, "rurl") 28 | }) 29 | 30 | test_that("as.req fails well", { 31 | skip_on_cran() 32 | 33 | expect_error(as.req(), "argument \"x\" is missing") 34 | expect_error(as.req(4), "no as.req method for numeric") 35 | expect_error(as.req(mtcars), "no as.req method for data.frame") 36 | expect_error(as.req(matrix(1:4)), "no as.req method for matrix") 37 | }) 38 | -------------------------------------------------------------------------------- /tests/testthat/test-api_template.R: -------------------------------------------------------------------------------- 1 | context("api_template") 2 | 3 | test_that("api_template works", { 4 | skip_on_cran() 5 | 6 | expect_is(api_template(api('https://api.github.com'), "", ""), "req") 7 | 8 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 9 | 10 | aa <- api('https://api.github.com') %>% 11 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) %>% 12 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 13 | peep 14 | 15 | bb <- api("http://api.gbif.org/v1") %>% 16 | api_template("occurrence/{{id}}/verbatim", list(id = 1056251124)) %>% 17 | peep 18 | 19 | expect_is(aa, "req") 20 | expect_is(bb, "req") 21 | 22 | expect_is(aa$url, "rurl") 23 | expect_is(aa$template, "character") 24 | expect_match(aa$template, "craigcitro") 25 | expect_equal(length(aa$template), 1) 26 | expect_is(aa %>% http, "tbl_df") 27 | 28 | expect_is(bb$template, "character") 29 | expect_equal(length(bb$template), 1) 30 | expect_is(bb$template, "character") 31 | }) 32 | 33 | test_that("api_template fails well", { 34 | skip_on_cran() 35 | 36 | expect_error(api_template(), 37 | "argument \".data\" is missing") 38 | expect_error(api_template(api('https://api.github.com')), 39 | "argument \"template\" is missing, with no default") 40 | }) 41 | -------------------------------------------------------------------------------- /R/query.R: -------------------------------------------------------------------------------- 1 | #' Query construction 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param ... Comma separated list of unquoted variable names 6 | #' @param .dots Used to work around non-standard evaluation 7 | #' @family dsl 8 | #' @examples \dontrun{ 9 | #' ## NSE 10 | #' api("http://api.plos.org/search") %>% 11 | #' api_query(q = ecology, wt = json, fl = 'id,journal') %>% 12 | #' peep 13 | #' 14 | #' api("http://api.plos.org/search") %>% 15 | #' api_query(q = ecology, wt = json, fl = id, fl = journal) %>% 16 | #' peep 17 | #' 18 | #' ## SE 19 | #' api("http://api.plos.org/search") %>% 20 | #' api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') %>% 21 | #' peep 22 | #' 23 | #' ## NSE 24 | #' api("http://api.plos.org/search") %>% 25 | #' api_query(q = ecology, wt = json, fl = 'id,journal') 26 | #' ## SE 27 | #' api("http://api.plos.org/search") %>% 28 | #' api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') 29 | #' } 30 | api_query <- function(.data, ...){ 31 | api_query_(.data, .dots = lazyeval::lazy_dots(...)) 32 | } 33 | 34 | #' @export 35 | #' @rdname api_query 36 | api_query_ <- function(.data, ..., .dots){ 37 | pipe_autoexec(toggle = TRUE) 38 | dots <- lazyeval::all_dots(.dots, ...) 39 | args <- sapply(dots, "[[", "expr") 40 | .data <- as.req(.data) 41 | modifyList(.data, list(query = args)) 42 | } 43 | -------------------------------------------------------------------------------- /man/api.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/api.R 3 | \name{api} 4 | \alias{api} 5 | \title{API base url and endpoint setup} 6 | \usage{ 7 | api(x) 8 | } 9 | \arguments{ 10 | \item{x}{A URL} 11 | } 12 | \description{ 13 | API base url and endpoint setup 14 | } 15 | \examples{ 16 | \dontrun{ 17 | # Set base url 18 | ## works with full or partial URLs 19 | api('https://api.github.com/') 20 | api('http://api.gbif.org/v1') 21 | api('api.gbif.org/v1') 22 | 23 | ## works with ports, full or partial 24 | api('http://localhost:9200') 25 | api('localhost:9200') 26 | api(':9200') 27 | api('9200') 28 | api('9200/stuff') 29 | 30 | # set paths 31 | ## NSE 32 | api('https://api.github.com/') \%>\% 33 | api_path(repos, ropensci, rgbif, issues) 34 | ## SE 35 | api('https://api.github.com/') \%>\% 36 | api_path_('repos', 'ropensci', 'rgbif', 'issues') 37 | 38 | # template 39 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 40 | api('https://api.github.com/') \%>\% 41 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) 42 | } 43 | } 44 | \seealso{ 45 | Other dsl: 46 | \code{\link{api_body}()}, 47 | \code{\link{api_config}()}, 48 | \code{\link{api_error_handler}()}, 49 | \code{\link{api_path}()}, 50 | \code{\link{api_query}()}, 51 | \code{\link{api_template}()}, 52 | \code{\link{auth}} 53 | } 54 | \concept{dsl} 55 | -------------------------------------------------------------------------------- /tests/testthat/test-internal_fxns.R: -------------------------------------------------------------------------------- 1 | context("internal fxns") 2 | 3 | test_that("pluck", { 4 | mtcarsl <- apply(mtcars, 1, as.list) 5 | expect_is(pluck(mtcarsl, "mpg"), "list") 6 | expect_is(pluck(mtcarsl, "mpg", 1), "numeric") 7 | }) 8 | 9 | test_that("dr_op", { 10 | lst <- list(a = 5, b = 6) 11 | expect_is(dr_op(lst, "a"), "list") 12 | expect_named(dr_op(lst, "a"), "b") 13 | }) 14 | 15 | test_that("is_url", { 16 | expect_true(is_url("http://google.com")) 17 | expect_false(is_url("google.com")) 18 | expect_true(is_url("http://localhost")) 19 | expect_true(is_url("localhost:9000")) 20 | expect_false(is_url("9000")) 21 | }) 22 | 23 | test_that("is_port", { 24 | expect_true(is_port("9000")) 25 | expect_false(is_port("900")) 26 | expect_true(is_port(":8000")) 27 | expect_true(is_port("/9000")) 28 | expect_false(is_port("/900")) 29 | }) 30 | 31 | test_that("each_link", { 32 | str <- '; rel="next", ; rel="last"' 33 | strs <- strtrim(strsplit(str, ",")[[1]]) 34 | aa <- lapply(strs, each_link) 35 | 36 | expect_is(aa, "list") 37 | expect_named(aa[[1]], c('name', 'url')) 38 | expect_is(aa[[1]]$name, "character") 39 | expect_is(aa[[1]]$url, "character") 40 | expect_equal(aa[[1]]$name, "next") 41 | expect_match(aa[[1]]$url, "https") 42 | }) 43 | -------------------------------------------------------------------------------- /tests/testthat/test-api_path.R: -------------------------------------------------------------------------------- 1 | context("api_path") 2 | 3 | test_that("api_path works", { 4 | skip_on_cran() 5 | 6 | expect_is(api_path(api('https://api.github.com'), repos, ropensci, rgbif, issues), "req") 7 | 8 | aa <- api('https://api.github.com') %>% 9 | api_path(repos, ropensci, rgbif, issues) %>% 10 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 11 | peep 12 | 13 | bb <- api("http://httpbin.org") %>% 14 | api_path(get) %>% 15 | peep 16 | 17 | cc <- api("http://api.crossref.org") %>% 18 | api_path(works, '10.1101/045526') %>% 19 | peep 20 | 21 | expect_is(aa, "req") 22 | expect_is(bb, "req") 23 | expect_is(cc, "req") 24 | 25 | expect_is(aa$url, "rurl") 26 | expect_is(bb$paths, "character") 27 | expect_equal(length(bb$paths), 1) 28 | expect_equal(length(cc$paths), 2) 29 | expect_is(cc$paths, "character") 30 | 31 | expect_is(aa %>% http, "tbl_df") 32 | expect_is(bb %>% http, "list") 33 | expect_is(cc %>% http, "list") 34 | 35 | # NSE and SE give same result 36 | ## FIXME - not sure why but this keeps failing on travis, but not locally 37 | # expect_identical(aa %>% http, 38 | # api("https://api.github.com") %>% 39 | # api_path_('repos', 'ropensci', 'rgbif', 'issues') 40 | # ) 41 | }) 42 | 43 | test_that("api_path fails well", { 44 | skip_on_cran() 45 | 46 | expect_error(api_path(), "argument \".data\" is missing") 47 | }) 48 | -------------------------------------------------------------------------------- /.github/CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Code of Conduct 2 | 3 | As contributors and maintainers of this project, we pledge to respect all people who 4 | contribute through reporting issues, posting feature requests, updating documentation, 5 | submitting pull requests or patches, and other activities. 6 | 7 | We are committed to making participation in this project a harassment-free experience for 8 | everyone, regardless of level of experience, gender, gender identity and expression, 9 | sexual orientation, disability, personal appearance, body size, race, ethnicity, age, or religion. 10 | 11 | Examples of unacceptable behavior by participants include the use of sexual language or 12 | imagery, derogatory comments or personal attacks, trolling, public or private harassment, 13 | insults, or other unprofessional conduct. 14 | 15 | Project maintainers have the right and responsibility to remove, edit, or reject comments, 16 | commits, code, wiki edits, issues, and other contributions that are not aligned to this 17 | Code of Conduct. Project maintainers who do not follow the Code of Conduct may be removed 18 | from the project team. 19 | 20 | Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by 21 | opening an issue or contacting one or more of the project maintainers. 22 | 23 | This Code of Conduct is adapted from the Contributor Covenant 24 | (https://contributor-covenant.org), version 1.0.0, available at 25 | https://contributor-covenant.org/version/1/0/0/ 26 | -------------------------------------------------------------------------------- /man/api_query.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/query.R 3 | \name{api_query} 4 | \alias{api_query} 5 | \alias{api_query_} 6 | \title{Query construction} 7 | \usage{ 8 | api_query(.data, ...) 9 | 10 | api_query_(.data, ..., .dots) 11 | } 12 | \arguments{ 13 | \item{.data}{Result of a call to \code{api}} 14 | 15 | \item{...}{Comma separated list of unquoted variable names} 16 | 17 | \item{.dots}{Used to work around non-standard evaluation} 18 | } 19 | \description{ 20 | Query construction 21 | } 22 | \examples{ 23 | \dontrun{ 24 | ## NSE 25 | api("http://api.plos.org/search") \%>\% 26 | api_query(q = ecology, wt = json, fl = 'id,journal') \%>\% 27 | peep 28 | 29 | api("http://api.plos.org/search") \%>\% 30 | api_query(q = ecology, wt = json, fl = id, fl = journal) \%>\% 31 | peep 32 | 33 | ## SE 34 | api("http://api.plos.org/search") \%>\% 35 | api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') \%>\% 36 | peep 37 | 38 | ## NSE 39 | api("http://api.plos.org/search") \%>\% 40 | api_query(q = ecology, wt = json, fl = 'id,journal') 41 | ## SE 42 | api("http://api.plos.org/search") \%>\% 43 | api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') 44 | } 45 | } 46 | \seealso{ 47 | Other dsl: 48 | \code{\link{api_body}()}, 49 | \code{\link{api_config}()}, 50 | \code{\link{api_error_handler}()}, 51 | \code{\link{api_path}()}, 52 | \code{\link{api_template}()}, 53 | \code{\link{api}()}, 54 | \code{\link{auth}} 55 | } 56 | \concept{dsl} 57 | -------------------------------------------------------------------------------- /man/http.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/http.R 3 | \name{http} 4 | \alias{http} 5 | \alias{http_client} 6 | \title{Make a HTTP request} 7 | \usage{ 8 | http(req, method = "GET") 9 | 10 | http_client(req) 11 | } 12 | \arguments{ 13 | \item{req}{A \code{req} class object} 14 | 15 | \item{method}{(character) Pick which HTTP method to use. Only GET and 16 | POST for now. Default: GET} 17 | } 18 | \description{ 19 | Make a HTTP request 20 | } 21 | \details{ 22 | By default, a GET request is made. Will fix this soon to easily allow 23 | a different HTTP verb. 24 | 25 | The \code{http} function makes the request and gives back the parsed result. 26 | Whereas, the \code{http_client} function makes the request, but gives back 27 | the raw R6 class object, which you can inspect all parts of, modify, etc. 28 | } 29 | \examples{ 30 | \dontrun{ 31 | # high level - http() 32 | api('https://api.github.com/') \%>\% 33 | api_path(repos, ropensci, rgbif, commits) \%>\% 34 | http() 35 | 36 | # low level - http_client() 37 | res <- api('https://api.github.com/') \%>\% 38 | api_path(repos, ropensci, rgbif, commits) \%>\% 39 | http_client() 40 | res$count() 41 | res$body() 42 | res$status() 43 | res$result 44 | res$links 45 | res$parse() 46 | 47 | # Specify HTTP verb 48 | ## POST 49 | api("https://httpbin.org/post") \%>\% 50 | api_body(x = "A simple text string") \%>\% 51 | http("POST") 52 | 53 | ## PUT 54 | api("https://httpbin.org/put") \%>\% 55 | api_body(x = "A simple text string") \%>\% 56 | http("PUT") 57 | } 58 | } 59 | -------------------------------------------------------------------------------- /man/request-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/request-package.R 3 | \docType{package} 4 | \name{request-package} 5 | \alias{request-package} 6 | \alias{request} 7 | \title{request} 8 | \description{ 9 | Easy http 10 | } 11 | \examples{ 12 | \dontrun{ 13 | ## Build API routes 14 | ### Works with full or partial URLs 15 | api('https://api.github.com/') 16 | api('http://api.gbif.org/v1') 17 | api('api.gbif.org/v1') 18 | 19 | ### Works with ports, full or partial 20 | api('http://localhost:9200') 21 | api('localhost:9200') 22 | api(':9200') 23 | api('9200') 24 | 25 | ## The above are not passed through a pipe, so simply define a URL, but don't 26 | ## do a request. To make an http request, you can either pipe a url or 27 | ## partial url to e.g., \code{\link{api}}, or call \code{\link{http}} 28 | 'https://api.github.com/' \%>\% api() 29 | ### Or 30 | api('https://api.github.com/') \%>\% http() 31 | 32 | # Non-standard evaluation (NSE) 33 | api('https://api.github.com/') \%>\% 34 | api_path(repos, ropensci, rgbif, issues) \%>\% 35 | peep 36 | 37 | # Standard evaluation (SE) 38 | api('https://api.github.com/') \%>\% 39 | api_path_('repos', 'ropensci', 'rgbif', 'issues') \%>\% 40 | peep 41 | 42 | ## Templating 43 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 44 | api('https://api.github.com/') \%>\% 45 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) \%>\% 46 | peep 47 | } 48 | } 49 | \author{ 50 | Scott Chamberlain \email{myrmecocystus@gmail.com} 51 | } 52 | \keyword{package} 53 | -------------------------------------------------------------------------------- /inst/ignore/rate_limit.R: -------------------------------------------------------------------------------- 1 | #' Rate limiting 2 | #' 3 | #' FIXME: still need to implement doing this in the request 4 | #' 5 | #' @export 6 | #' 7 | #' @param .data Result of a call to \code{api} 8 | #' @param value (integer) Value of rate limit, number of requests allowed 9 | #' @param period Time period, e.g., 1 min, 60 min, 1 hr, 24 hrs 10 | #' @param on_limit What to do on reaching rate limit. See Details. 11 | #' 12 | #' @details 13 | #' \code{on_limit} options: 14 | #' \itemize{ 15 | #' \item stop - and give error message to use 16 | #' \item warn - and give error message to use 17 | #' \item wait - and give max time to wait 18 | #' } 19 | #' 20 | #' @examples \dontrun{ 21 | #' api('https://api.github.com/') %>% 22 | #' api_path(repos, ropensci, rgbif, issues) %>% 23 | #' rate_limit(value = 5, period = "24 hrs") 24 | #' 25 | #' qr %>% rate_limit(value = 5, period = "24 hrs") 26 | #' qr %>% rate_limit(value = 5000, period = "24 hrs") 27 | #' qr %>% rate_limit(value = 10, period = "5 min") 28 | #' qr %>% rate_limit(value = 10, period = "5 min", on_limit = with_wait(1)) 29 | #' } 30 | rate_limit <- function(.data, value, period, on_limit = with_stop()) { 31 | pipe_autoexec(toggle = TRUE) 32 | .data <- as.req(.data) 33 | modifyList(.data, list( 34 | rate_limit = list(value = value, period = period, on_limit = on_limit)) 35 | ) 36 | } 37 | 38 | with_stop <- function(x = "Rate limit reached") { 39 | list(x = x, fxn = function(x) stop(x, call. = FALSE)) 40 | } 41 | 42 | with_warn <- function(x = "Rate limit reached") { 43 | list(x = x, fxn = function(x) warning(x, call. = FALSE)) 44 | } 45 | 46 | with_wait <- function(x = 3) { 47 | list(x = x, fxn = function(x) Sys.sleep(x)) 48 | } 49 | -------------------------------------------------------------------------------- /R/request-package.R: -------------------------------------------------------------------------------- 1 | #' @title request 2 | #' @description Easy http 3 | #' @importFrom methods is 4 | #' @importFrom stats setNames 5 | #' @importFrom utils head modifyList packageVersion 6 | #' @importFrom R6 R6Class 7 | #' @importFrom whisker whisker.render 8 | #' @importFrom lazyeval lazy_dots all_dots 9 | #' @importFrom magrittr %>% 10 | #' @import httr 11 | #' @name request-package 12 | #' @aliases request 13 | #' @docType package 14 | #' @author Scott Chamberlain \email{myrmecocystus@@gmail.com} 15 | #' @keywords package 16 | #' 17 | #' @examples \dontrun{ 18 | #' ## Build API routes 19 | #' ### Works with full or partial URLs 20 | #' api('https://api.github.com/') 21 | #' api('http://api.gbif.org/v1') 22 | #' api('api.gbif.org/v1') 23 | #' 24 | #' ### Works with ports, full or partial 25 | #' api('http://localhost:9200') 26 | #' api('localhost:9200') 27 | #' api(':9200') 28 | #' api('9200') 29 | #' 30 | #' ## The above are not passed through a pipe, so simply define a URL, but don't 31 | #' ## do a request. To make an http request, you can either pipe a url or 32 | #' ## partial url to e.g., \code{\link{api}}, or call \code{\link{http}} 33 | #' 'https://api.github.com/' %>% api() 34 | #' ### Or 35 | #' api('https://api.github.com/') %>% http() 36 | #' 37 | #' # Non-standard evaluation (NSE) 38 | #' api('https://api.github.com/') %>% 39 | #' api_path(repos, ropensci, rgbif, issues) %>% 40 | #' peep 41 | #' 42 | #' # Standard evaluation (SE) 43 | #' api('https://api.github.com/') %>% 44 | #' api_path_('repos', 'ropensci', 'rgbif', 'issues') %>% 45 | #' peep 46 | #' 47 | #' ## Templating 48 | #' repo_info <- list(username = 'craigcitro', repo = 'r-travis') 49 | #' api('https://api.github.com/') %>% 50 | #' api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) %>% 51 | #' peep 52 | #' } 53 | NULL 54 | -------------------------------------------------------------------------------- /man/api_body.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/body.R 3 | \name{api_body} 4 | \alias{api_body} 5 | \alias{api_body_} 6 | \title{Query construction} 7 | \usage{ 8 | api_body(.data, ..., body_value = NULL) 9 | 10 | api_body_(.data, ..., .dots, body_value = NULL) 11 | } 12 | \arguments{ 13 | \item{.data}{Result of a call to \code{api}} 14 | 15 | \item{...}{Comma separated list of unquoted variable names. These are 16 | combined into a list and passed to whatever http method is used downstream} 17 | 18 | \item{body_value}{one of the following: 19 | \itemize{ 20 | \item FALSE: No body 21 | \item NULL: An empty body 22 | \item "": A length 0 body 23 | \item upload_file("path/"): The contents of a file. The mime type will be 24 | guessed from the extension, or can be supplied explicitly as the second 25 | argument to \code{upload_file()} 26 | \item A character or raw vector: sent as is in body. Use content_type to tell the 27 | server what sort of data you are sending. 28 | }} 29 | 30 | \item{.dots}{Used to work around non-standard evaluation} 31 | } 32 | \description{ 33 | Query construction 34 | } 35 | \examples{ 36 | \dontrun{ 37 | ## NSE 38 | dd <- api("https://httpbin.org/post") 39 | dd \%>\% api_body(body_value = NULL) \%>\% http("POST") 40 | dd \%>\% api_body(body_value = "") \%>\% http("POST") 41 | 42 | ## other named parameters are passed as form values 43 | dd \%>\% api_body(x = hello) \%>\% http("POST") 44 | 45 | # upload a file 46 | file <- "~/some_test.txt" 47 | cat("hello, world", file = file) 48 | dd \%>\% api_body(x = upload_file("~/some_test.txt")) \%>\% http("POST") 49 | 50 | # A named list 51 | dd \%>\% api_body(x = hello, y = stuff) \%>\% http("POST") 52 | 53 | ## SE 54 | dd \%>\% api_body_(x = "hello", y = "stuff") \%>\% http("POST") 55 | } 56 | } 57 | \seealso{ 58 | Other dsl: 59 | \code{\link{api_config}()}, 60 | \code{\link{api_error_handler}()}, 61 | \code{\link{api_path}()}, 62 | \code{\link{api_query}()}, 63 | \code{\link{api_template}()}, 64 | \code{\link{api}()}, 65 | \code{\link{auth}} 66 | } 67 | \concept{dsl} 68 | -------------------------------------------------------------------------------- /R/body.R: -------------------------------------------------------------------------------- 1 | #' Query construction 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param ... Comma separated list of unquoted variable names. These are 6 | #' combined into a list and passed to whatever http method is used downstream 7 | #' @param .dots Used to work around non-standard evaluation 8 | #' @param body_value one of the following: 9 | #' \itemize{ 10 | #' \item FALSE: No body 11 | #' \item NULL: An empty body 12 | #' \item "": A length 0 body 13 | #' \item upload_file("path/"): The contents of a file. The mime type will be 14 | #' guessed from the extension, or can be supplied explicitly as the second 15 | #' argument to \code{upload_file()} 16 | #' \item A character or raw vector: sent as is in body. Use content_type to tell the 17 | #' server what sort of data you are sending. 18 | #' } 19 | #' @family dsl 20 | #' @examples \dontrun{ 21 | #' ## NSE 22 | #' dd <- api("https://httpbin.org/post") 23 | #' dd %>% api_body(body_value = NULL) %>% http("POST") 24 | #' dd %>% api_body(body_value = "") %>% http("POST") 25 | #' 26 | #' ## other named parameters are passed as form values 27 | #' dd %>% api_body(x = hello) %>% http("POST") 28 | #' 29 | #' # upload a file 30 | #' file <- "~/some_test.txt" 31 | #' cat("hello, world", file = file) 32 | #' dd %>% api_body(x = upload_file("~/some_test.txt")) %>% http("POST") 33 | #' 34 | #' # A named list 35 | #' dd %>% api_body(x = hello, y = stuff) %>% http("POST") 36 | #' 37 | #' ## SE 38 | #' dd %>% api_body_(x = "hello", y = "stuff") %>% http("POST") 39 | #' } 40 | api_body <- function(.data, ..., body_value = NULL){ 41 | api_body_(.data, .dots = lazyeval::lazy_dots(...), body_value = body_value) 42 | } 43 | 44 | #' @export 45 | #' @rdname api_body 46 | api_body_ <- function(.data, ..., .dots, body_value = NULL){ 47 | ## FIXME - need to toggle on POST by default here when body passed 48 | pipe_autoexec(toggle = TRUE) 49 | .data <- as.req(.data) 50 | if (is.null(body_value)) { 51 | dots <- lazyeval::all_dots(.dots, ...) 52 | args <- as.character(sapply(dots, "[[", "expr")) 53 | args <- stats::setNames(args, names(dots)) 54 | modifyList(.data, list(body = as.list(args))) 55 | } else { 56 | modifyList(.data, list(body = body_value)) 57 | } 58 | } 59 | -------------------------------------------------------------------------------- /tests/testthat/test-request_iterator.R: -------------------------------------------------------------------------------- 1 | context("RequestIterator") 2 | 3 | test_that("RequestIterator - pre initialization", { 4 | aa <- RequestIterator 5 | bb <- RequestIterator$new() 6 | 7 | expect_is(aa, "R6ClassGenerator") 8 | }) 9 | 10 | test_that("RequestIterator - post initialization", { 11 | skip_on_cran() 12 | 13 | bb <- RequestIterator$new() 14 | 15 | expect_is(bb, "RequestIterator") 16 | expect_is(bb, "R6") 17 | expect_equal(bb$status(), list()) 18 | expect_equal(bb$result, list()) 19 | expect_equal(bb$links, list()) 20 | expect_equal(bb$parse(), list()) 21 | expect_equal(bb$limit_max, NA) 22 | expect_equal(bb$limit, NA) 23 | expect_is(bb$handle_errors, "function") 24 | expect_is(bb$GET, "function") 25 | expect_error(bb$GET(), "argument \".data\" is missing") 26 | expect_is(bb$count, "function") 27 | expect_error(bb$count(), "invalid") 28 | expect_is(bb$body, "function") 29 | expect_equal(bb$body(), list()) 30 | }) 31 | 32 | test_that("RequestIterator - post initialization w/ data", { 33 | skip_on_cran() 34 | 35 | bb <- RequestIterator$new() 36 | cc <- bb$GET(as.req(api("http://httpbin.org/get"))) 37 | 38 | expect_is(cc, "response") 39 | expect_equal(bb$status(), 200) 40 | expect_equal(bb$result, cc) 41 | expect_null(bb$links) 42 | expect_is(bb$parse(), "list") 43 | expect_equal(bb$limit_max, NA) 44 | expect_equal(bb$limit, NA) 45 | expect_is(bb$handle_errors, "function") 46 | expect_is(bb$GET, "function") 47 | expect_error(bb$GET(), "argument \".data\" is missing") 48 | expect_is(bb$count, "function") 49 | expect_equal(bb$count(), 1) 50 | expect_is(bb$body, "function") 51 | expect_is(bb$body(), "response") 52 | }) 53 | 54 | test_that("RequestIterator - try_error tester", { 55 | skip_on_cran() 56 | 57 | my_stop <- function(x) { 58 | if (x$status > 200) { 59 | warning("nope, try again", call. = FALSE) 60 | } 61 | } 62 | 63 | req <- api("http://httpbin.org/status/503") %>% api_error_handler(my_stop) %>% peep 64 | bb <- RequestIterator$new() 65 | expect_warning(bb$GET(req), "nope, try again") 66 | 67 | req <- api("http://httpbin.org/status/503") %>% peep 68 | bb <- RequestIterator$new() 69 | expect_error(bb$GET(req), "Service Unavailable") 70 | }) 71 | -------------------------------------------------------------------------------- /R/caching.R: -------------------------------------------------------------------------------- 1 | #' Caching helper 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param dir (character) Directory to cache in. Uses 6 | #' \code{rappdirs::user_cache_dir()} by default 7 | #' @param ... ignored 8 | #' @examples \dontrun{ 9 | #' # cache 10 | #' ## first call is slower 11 | #' api('http://localhost:5000') %>% 12 | #' api_path(get) %>% 13 | #' api_query(foo = "bar") %>% 14 | #' api_cache() 15 | #' 16 | #' ## second call is faster, pulling from cache 17 | #' api('http://localhost:5000') %>% 18 | #' api_path(get) %>% 19 | #' api_query(foo = "bar") %>% 20 | #' api_cache() 21 | #' 22 | #' # other egs 23 | #' x <- api('api.crossref.org') %>% 24 | #' api_path(works) %>% 25 | #' api_query(rows = 1000) %>% 26 | #' api_cache() 27 | #' } 28 | api_cache <- function(.data, dir = NULL, ...) { 29 | pipe_autoexec(toggle = TRUE) 30 | .data <- as.req(.data) 31 | .data <- modifyList( 32 | .data, 33 | list( 34 | cache = TRUE, 35 | cache_path = dir %||% cache_path() 36 | ) 37 | ) 38 | return(.data) 39 | } 40 | 41 | cache_path <- function() rappdirs::user_cache_dir("request-cache") 42 | 43 | cache_make <- function(x) { 44 | if (!file.exists(x)) { 45 | dir.create(x, recursive = TRUE, showWarnings = FALSE) 46 | } 47 | } 48 | 49 | # caculate hash based on 50 | # - url 51 | # - path 52 | # - query parameters 53 | cache_sha <- function(x) { 54 | # x <- as.req(x) 55 | # x$config <- c(httr::user_agent(make_ua()), x$config, x$headers) 56 | # x$url <- gather_paths(x) 57 | # x$query <- if (is.null(x$query)) NULL else as.list(x$query) 58 | # x$cache <- NULL 59 | # x$cache_path <- NULL 60 | url <- httr::parse_url(x$url) 61 | url$path <- gather_path(x) 62 | url$query <- if (is.null(x$query)) NULL else as.list(x$query) 63 | url <- httr::build_url(url) 64 | file.path(cache_path(), paste0(digest::digest(url), ".rds")) 65 | } 66 | 67 | cache_response <- function(x, file) { 68 | saveRDS(x, file = file) 69 | } 70 | 71 | gather_path <- function(x) { 72 | if (!is.null(x$paths) && !is.null(x$template)) { 73 | stop("Cannot pass use both api_template and api_path", call. = FALSE) 74 | } 75 | if (!is.null(x$paths)) { 76 | paste(unlist(x$paths), collapse = "/") 77 | } else if (!is.null(x$template)) { 78 | x$template 79 | } 80 | } 81 | -------------------------------------------------------------------------------- /tests/testthat/test-authentication.R: -------------------------------------------------------------------------------- 1 | context("authentication") 2 | 3 | test_that("authentication - basic auth works", { 4 | skip_on_cran() 5 | 6 | expect_is( 7 | api_simple_auth(api("http://api.plos.org/search"), user = "asd", pwd = "asdf"), 8 | "req" 9 | ) 10 | 11 | aa <- api('https://httpbin.org/basic-auth/user/passwd') %>% 12 | api_simple_auth(user = "user", pwd = "passwd") %>% 13 | peep 14 | 15 | bb <- api('https://httpbin.org/basic-auth/user/passwd') %>% 16 | api_simple_auth(user = "user", pwd = "passwd", type = "digest") %>% 17 | peep 18 | 19 | expect_is(aa, "req") 20 | expect_is(bb, "req") 21 | 22 | expect_is(aa$url, "rurl") 23 | expect_is(aa$config, "request") 24 | expect_is(bb$config, "request") 25 | 26 | aaa <- aa %>% http 27 | expect_is(aaa, "list") 28 | expect_named(aaa, c("authenticated", "user")) 29 | }) 30 | 31 | test_that("authentication - basic auth with different auth type", { 32 | skip_on_travis() 33 | skip_on_cran() 34 | 35 | bb <- api('https://httpbin.org/basic-auth/user/passwd') %>% 36 | api_simple_auth(user = "user", pwd = "passwd", type = "digest") %>% 37 | peep 38 | expect_error(bb %>% http, "Client error: \\(401\\) Unauthorized") 39 | }) 40 | 41 | test_that("authentication - oauth2 works", { 42 | skip_on_cran() 43 | 44 | expect_is( 45 | api_oauth2(api("http://api.plos.org/search"), token = "asfdasfs"), 46 | "req" 47 | ) 48 | 49 | aa <- api('https://api.github.com/') %>% 50 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 51 | peep 52 | 53 | expect_is(aa, "req") 54 | 55 | expect_is(aa$url, "rurl") 56 | expect_is(aa$config, "request") 57 | expect_is(aa$config, "request") 58 | expect_named(aa$config$headers, "Authorization") 59 | }) 60 | 61 | test_that("authentication - oauth2 with differnt auth type", { 62 | skip_on_travis() 63 | skip_on_cran() 64 | 65 | aa <- api('https://httpbin.org/basic-auth/user/passwd') %>% 66 | api_oauth2(token = Sys.getenv("GITHUB_PAT")) %>% 67 | peep 68 | expect_error(aa %>% http, "Client error: \\(401\\) Unauthorized") 69 | }) 70 | 71 | test_that("authentication fails well", { 72 | skip_on_cran() 73 | 74 | expect_error(api_simple_auth(), "argument \".data\" is missing") 75 | expect_error(api_oauth1(), "argument \".data\" is missing") 76 | expect_error(api_oauth2(), "argument \".data\" is missing") 77 | }) 78 | -------------------------------------------------------------------------------- /inst/ignore/helpers.R: -------------------------------------------------------------------------------- 1 | #' http request helpers 2 | #' 3 | #' Various helpers as functions that allow chaining together options to 4 | #' pass to e.g., \code{\link{Get}} 5 | #' 6 | #' @param .data A request object 7 | #' @param seconds Number of seconds to wait for a response until giving up. Can 8 | #' not be less than 1 ms (aka: 0.001 seconds). 9 | #' @param agent An agent character string 10 | #' @param user A user name 11 | #' @param password A password 12 | #' @param type Type of authenticaion. Default: basic 13 | #' @param ... Further args 14 | #' 15 | #' @name helpers 16 | NULL 17 | 18 | #' @export 19 | #' @rdname helpers 20 | Progress <- function(.data){ 21 | .data <- as.req(.data) 22 | .data <- modifyList(.data, list(config = c(progress()))) 23 | .data 24 | } 25 | 26 | #' @export 27 | #' @rdname helpers 28 | Verbose <- function(.data){ 29 | .data <- as.req(.data) 30 | .data <- modifyList(.data, list(config = c(verbose()))) 31 | .data 32 | } 33 | 34 | #' @export 35 | #' @rdname helpers 36 | Timeout <- function(.data, seconds){ 37 | .data <- as.req(.data) 38 | .data <- modifyList(.data, list(config = c(timeout(seconds = seconds) ))) 39 | .data 40 | } 41 | 42 | #' @export 43 | #' @rdname helpers 44 | User_agent <- function(.data, agent){ 45 | .data <- as.req(.data) 46 | .data <- modifyList(.data, list(config = c(user_agent(agent = agent)))) 47 | .data 48 | } 49 | 50 | #' @export 51 | #' @rdname helpers 52 | Authenticate <- function(.data, user, password, type = "basic"){ 53 | .data <- as.req(.data) 54 | .data <- modifyList(.data, list(config = c( authenticate(user = user, password = password, type = type) ))) 55 | .data 56 | } 57 | 58 | #' @export 59 | #' @rdname helpers 60 | Query <- function(.data, ...){ 61 | .data <- as.req(.data) 62 | args <- list(...) 63 | .data <- modifyList(.data, list(query = args)) 64 | .data$parse <- TRUE 65 | .data 66 | # Get(.data) 67 | } 68 | 69 | #' @export 70 | #' @rdname helpers 71 | Body <- function(.data, ...){ 72 | .data <- as.req(.data) 73 | args <- list(...) 74 | .data <- modifyList(.data, list(body = args)) 75 | .data$parse <- TRUE 76 | Put(.data) 77 | } 78 | 79 | # query <- function(.data=list(), ...){ 80 | # query_(.data, .dots = lazyeval::lazy_dots(...)) 81 | # } 82 | # 83 | # query_ <- function(.data=list(), ..., .dots){ 84 | # dots <- lazyeval::all_dots(.dots, ...) 85 | # args <- sapply(bb, "[[", "expr") 86 | # structure(args, class = "query") 87 | # } 88 | -------------------------------------------------------------------------------- /inst/ignore/get.R: -------------------------------------------------------------------------------- 1 | #' Get a url, with sensible defaults 2 | #' 3 | #' @export 4 | #' @param .data A request object 5 | #' @param ... Curl options passed on to \code{\link[httr]{GET}}. 6 | #' @param parse (logical) Attempt to parse data to data.frame if possible. Default: TRUE 7 | #' @details Attempts to simplify the http request process by using sensible defaults: 8 | #' \itemize{ 9 | #' \item GET by default: you most likely want to use \code{\link[httr]{GET}} 10 | #' \item You most likely want a data.frame back, so we attempt to coerce to a data.frame 11 | #' } 12 | #' @examples \dontrun{ 13 | #' "https://api.github.com/" %>% 14 | #' Get() 15 | #' 16 | #' "https://api.github.com/" %>% 17 | #' Progress() %>% 18 | #' Verbose() %>% 19 | #' Get() 20 | #' 21 | #' "https://api.github.com/" %>% 22 | #' Timeout(3) %>% 23 | #' Get() 24 | #' 25 | #' "http://api.crossref.org/works/" %>% 26 | #' User_agent("howdydoodie") %>% 27 | #' Get() 28 | #' 29 | #' "http://api.plos.org/search" %>% 30 | #' Query(q = "*:*", wt = "json") %>% 31 | #' Get() %>% 32 | #' .$response %>% 33 | #' .$docs 34 | #' } 35 | 36 | Get <- function(.data, parse = TRUE, ...) { 37 | .data <- as.req(.data) 38 | .data$config <- c(httr::user_agent(make_ua()), .data$config) 39 | # .data$config <- c(user_agent(make_ua()), combconfig(.data$config)) 40 | .data$url <- gather_paths(.data) 41 | res <- suppressWarnings(httr::GET(.data$url[1], .data$config, query = .data$query, ...)) 42 | 43 | # hu <- httr:::handle_url(NULL, .data$url[[1]], query = .data$query) 44 | # req <- httr:::request_build("GET", hu$url, .data$config) 45 | # res <- suppressWarnings(httr:::request_perform(req, hu$handle$handle)) 46 | 47 | # fix me, replace with error handler from .data 48 | if (is.null(.data$error)) { 49 | httr::stop_for_status(res) 50 | } else { 51 | .data$error[[1]](res) 52 | } 53 | if (grepl("json", res$headers$`content-type`)) { 54 | txt <- httr::content(res, "text") 55 | jsonlite::fromJSON(txt, parse, flatten = TRUE) 56 | } else { 57 | content(res) 58 | } 59 | } 60 | 61 | Put <- function(.data, ...) { 62 | .data <- as.req(.data) 63 | res <- httr::PUT(.data$url, body = .data$body, ...) 64 | httr::stop_for_status(res) 65 | if (grepl("json", res$headers$`content-type`)) { 66 | jsonlite::fromJSON(httr::content(res, "text")) 67 | } else { 68 | httr::content(res) 69 | } 70 | } 71 | 72 | #' @export 73 | print.snapdf <- function(x, ..., n = 10){ 74 | trunc_mat(x, n = n) 75 | } 76 | -------------------------------------------------------------------------------- /R/print-req.R: -------------------------------------------------------------------------------- 1 | #' @export 2 | print.req <- function(x, ...){ 3 | cat(" ", sep = "\n") 4 | cat(paste0(" url: ", x$url), sep = "\n") 5 | cat(paste0(" paths: ", 6 | paste(unlist(x$paths), collapse = "/")), sep = "\n") 7 | cat(paste0(" query: ", 8 | paste(names(x$query), unname(unlist(x$query)), sep = "=", collapse = ", ")), sep = "\n") 9 | cat(paste0(" body: ", 10 | print_body(x$body)), sep = "\n") 11 | x$paging <- dr_op(x$paging, "size") 12 | cat(paste0(" paging: ", 13 | paste(vapply(x$paging, function(x) names(x), ""), 14 | sapply(x$paging, function(x) x[[1]]$expr), sep = "=", collapse = ", ")), sep = "\n") 15 | cat(paste0(" headers: ", 16 | print_heads(x$config)), sep = "\n") 17 | cat(paste0(" rate limit: ", 18 | print_rate(x$rate_limit)), sep = "\n") 19 | cat(paste0(" retry (n/delay (s)): ", 20 | paste0(x$retry$n, "/", x$retry$time)), sep = "\n") 21 | cat(paste0(" error handler: ", 22 | names(x$error)), sep = "\n") 23 | cat(paste0(" write: ", 24 | print_write(x$config)), sep = "\n") 25 | cat(" config: ", sep = "\n") 26 | if (!is.null(x$config)) print_config(x$config) 27 | } 28 | 29 | print_config <- function(z) { 30 | z$options$debugfunction <- NULL 31 | z$headers <- NULL 32 | for (i in seq_along(z$options)) { 33 | if (!is.null(z$options[[i]])) { 34 | cat(sprintf(" %s: %s", 35 | names(z$options)[i], z$options[[i]]), sep = "\n") 36 | } 37 | } 38 | } 39 | 40 | print_rate <- function(z) { 41 | if (!is.null(z)) { 42 | z2 <- unname(unlist(z)) 43 | sprintf("%s @ %s - on_limit: %s", z2[1], z2[2], z2[3]) 44 | } 45 | } 46 | 47 | print_heads <- function(x) { 48 | if (is.logical(x) || is.null(x) || is.character(x)) { 49 | return(x) 50 | } else { 51 | print_lazy(as.list(x$headers)) 52 | } 53 | } 54 | 55 | print_write <- function(z) { 56 | if (!is.null(z$output)) { 57 | print_lazy(comp(as.list(z$output))) 58 | } 59 | } 60 | 61 | print_body <- function(x) { 62 | if ("body_value" %in% names(x) && length(x) == 1) x <- unlist(unname(x)) 63 | if (is.logical(x) || is.null(x) || is.character(x)) { 64 | return(x) 65 | } else if (any(grepl("upload_file", x[[1]]))) { 66 | " File Upload" 67 | } else { 68 | print_lazy(x) 69 | } 70 | } 71 | 72 | print_lazy <- function(x) { 73 | out <- list() 74 | for (i in seq_along(x)) { 75 | val <- if (is(x[[i]], "name")) { 76 | deparse(x[[i]]) 77 | } else { 78 | x[[i]] 79 | } 80 | out[[i]] <- sprintf(" %s: %s", names(x)[i], val) 81 | } 82 | return(paste0("\n", paste0(out, collapse = "\n"))) 83 | } 84 | -------------------------------------------------------------------------------- /R/pipe_helpers.R: -------------------------------------------------------------------------------- 1 | # from @smbache Stefan Milton Bache 2 | 3 | #' Toggle Auto Execution On or Off for Pipelines 4 | #' 5 | #' A call to \code{pipe_autoexec} allows a function to toggle auto execution of 6 | #' \code{http} on or off at the end of a pipeline. 7 | #' 8 | #' @param toggle logical: \code{TRUE} toggles auto execution on, \code{FALSE} 9 | #' toggles auto execution off. 10 | #' 11 | #' @details Once auto execution is turned on the \code{result} identifier inside 12 | #' the pipeline is bound to an "Active Binding". This will not be changed on 13 | #' toggling auto execution off, but rather the function to be executed is 14 | #' changed to \code{identity}. 15 | #' 16 | #' @noRd 17 | pipe_autoexec <- function(toggle, method = "GET") { 18 | if (!identical(toggle, TRUE) && !identical(toggle, FALSE)) { 19 | stop("Argument 'toggle' must be logical.") 20 | } 21 | 22 | info <- pipeline_info() 23 | 24 | if (isTRUE(info[["is_piped"]])) { 25 | pipeline_on_exit(info$env) 26 | info$env$.http_exitfun <- if (toggle) http else identity 27 | # info$env$.http_exitfun <- if (toggle) http2 else identity 28 | } 29 | 30 | invisible() 31 | } 32 | 33 | #' Information on Potential Pipeline 34 | #' 35 | #' This function figures out whether it is called from within a pipeline. 36 | #' It does so by examining the parent evironment of the active system frames, 37 | #' and whether any of these are the same as the enclosing environment of 38 | #' \code{\%>\%}. 39 | #' 40 | #' @return A list with the values \code{is_piped} (logical) and \code{env} 41 | #' (an environment reference). The former is \code{TRUE} if a pipeline is 42 | #' identified as \code{FALSE} otherwise. The latter holds a reference to 43 | #' the \code{\%>\%} frame where the pipeline is created and evaluated. 44 | #' 45 | #' @noRd 46 | pipeline_info <- function() { 47 | parents <- lapply(sys.frames(), parent.env) 48 | 49 | is_magrittr_env <- 50 | vapply(parents, identical, logical(1), y = environment(`%>%`)) 51 | 52 | is_piped <- any(is_magrittr_env) 53 | 54 | list(is_piped = is_piped, 55 | env = if (is_piped) sys.frames()[[min(which(is_magrittr_env))]]) 56 | } 57 | 58 | #' Setup On-Exit Action for a Pipeline 59 | #' 60 | #' A call to \code{pipeline_on_exit} will setup the pipeline for auto execution by 61 | #' making \code{result} inside \code{\%>\%} an active binding. The initial 62 | #' call will register the \code{identity} function as the exit action, 63 | #' but this can be changed to \code{jq} with a call to \code{pipe_autoexec}. 64 | #' Subsequent calls to \code{pipeline_on_exit} has no effect. 65 | #' 66 | #' @param env A reference to the \code{\%>\%} environment, in which 67 | #' \code{result} is to be bound. 68 | #' 69 | #' @noRd 70 | pipeline_on_exit <- function(env) { 71 | # Only activate the first time; after this the binding is already active. 72 | if (exists(".http_exitfun", envir = env, inherits = FALSE, mode = "function")) { 73 | return(invisible()) 74 | } 75 | env$.http_exitfun <- identity 76 | 77 | res <- NULL 78 | 79 | http_result <- function(v) { 80 | if (missing(v)) { 81 | res 82 | } 83 | else { 84 | res <<- `$<-`(v, value, env$.http_exitfun(v$value)) 85 | } 86 | } 87 | 88 | makeActiveBinding("result", http_result, env) 89 | } 90 | -------------------------------------------------------------------------------- /R/http.R: -------------------------------------------------------------------------------- 1 | #' Make a HTTP request 2 | #' 3 | #' @export 4 | #' 5 | #' @param req A \code{req} class object 6 | #' @param method (character) Pick which HTTP method to use. Only GET and 7 | #' POST for now. Default: GET 8 | #' 9 | #' @details By default, a GET request is made. Will fix this soon to easily allow 10 | #' a different HTTP verb. 11 | #' 12 | #' The \code{http} function makes the request and gives back the parsed result. 13 | #' Whereas, the \code{http_client} function makes the request, but gives back 14 | #' the raw R6 class object, which you can inspect all parts of, modify, etc. 15 | #' @examples \dontrun{ 16 | #' # high level - http() 17 | #' api('https://api.github.com/') %>% 18 | #' api_path(repos, ropensci, rgbif, commits) %>% 19 | #' http() 20 | #' 21 | #' # low level - http_client() 22 | #' res <- api('https://api.github.com/') %>% 23 | #' api_path(repos, ropensci, rgbif, commits) %>% 24 | #' http_client() 25 | #' res$count() 26 | #' res$body() 27 | #' res$status() 28 | #' res$result 29 | #' res$links 30 | #' res$parse() 31 | #' 32 | #' # Specify HTTP verb 33 | #' ## POST 34 | #' api("https://httpbin.org/post") %>% 35 | #' api_body(x = "A simple text string") %>% 36 | #' http("POST") 37 | #' 38 | #' ## PUT 39 | #' api("https://httpbin.org/put") %>% 40 | #' api_body(x = "A simple text string") %>% 41 | #' http("PUT") 42 | #' } 43 | http <- function(req, method = "GET") { 44 | pipe_autoexec(toggle = FALSE) 45 | if (!method %in% c("GET", "POST", "PUT")) { 46 | stop("method must be one of GET, POST, or PUT", call. = FALSE) 47 | } 48 | #if ('body' %in% names(req)) method <- "POST" 49 | if ('body' %in% names(req) && method == "GET") { 50 | stop("body found - specify method = POST or method = PUT", call. = FALSE) 51 | } 52 | #rr <- RequestIterator$new(paging = req$paging) 53 | rr <- RequestIterator$new() 54 | switch( 55 | method, 56 | GET = rr$GET(req), 57 | POST = rr$POST(req), 58 | PUT = rr$PUT(req) 59 | ) 60 | rr$parse() 61 | } 62 | 63 | # http2 <- function(req, method = "GET") { 64 | # pipe_autoexec(toggle = FALSE) 65 | # if (!method %in% c("GET", "POST")) stop("method must be one of GET or POST", call. = FALSE) 66 | # rr <- RequestIterator$new(paging = req$paging) 67 | # switch( 68 | # method, 69 | # GET = { 70 | # if (!is.null(req$paging)) { 71 | # if (all(get_names(req$paging) %in% c('page', 'per_page'))) { 72 | # # pattern: page/per_page 73 | # rr$GET(req) 74 | # } else { 75 | # # pattern: limit 76 | # tot <- 0 77 | # while (tot <= get_req_size(req$paging)) { 78 | # rr$GET(req) 79 | # tot <- rr$count() 80 | # } 81 | # } 82 | # } 83 | # }, 84 | # POST = rr$POST(req) 85 | # ) 86 | # rr$parse() 87 | # } 88 | 89 | # get_req_size <- function(x) { 90 | # xx <- sapply(x, function(z) { 91 | # as.list(setNames(z[[1]]$expr, names(z))) 92 | # }) 93 | # xx[names(xx) %in% c('size', 'limit', 'max')][[1]] 94 | # } 95 | 96 | #' @export 97 | #' @rdname http 98 | http_client <- function(req) { 99 | pipe_autoexec(toggle = FALSE) 100 | # rr <- RequestIterator$new(paging = req$paging) 101 | rr <- RequestIterator$new() 102 | rr$GET(req) 103 | return(rr) 104 | } 105 | -------------------------------------------------------------------------------- /R/zzz.R: -------------------------------------------------------------------------------- 1 | pluck <- function(x, name, type) { 2 | if (missing(type)) { 3 | lapply(x, "[[", name) 4 | } else { 5 | vapply(x, "[[", name, FUN.VALUE = type) 6 | } 7 | } 8 | 9 | dr_op <- function(x, name) { 10 | x[name] <- NULL 11 | x 12 | } 13 | 14 | is_url <- function(x){ 15 | grepl("https?://", x, ignore.case = TRUE) || grepl("localhost:[0-9]{4}", x, ignore.case = TRUE) 16 | } 17 | 18 | is_port <- function(x) { 19 | # strip other characters 20 | x <- strextract(x, "[[:digit:]]+") 21 | if (length(x) == 0) { 22 | FALSE 23 | } else { 24 | grepl("[[:digit:]]", x) && nchar(x) == 4 25 | } 26 | } 27 | 28 | add_scheme <- function(x) { 29 | if (!grepl("https?://", x, ignore.case = TRUE)) { 30 | paste0("http://", x) 31 | } else { 32 | x 33 | } 34 | } 35 | 36 | has_scheme <- function(x) { 37 | grepl("https?://", x, ignore.case = TRUE) 38 | } 39 | 40 | comp <- function(l) { 41 | Filter(Negate(is.null), l) 42 | } 43 | 44 | empty <- function(l) { 45 | is_length_zero <- function(z) { 46 | length(z) == 0 47 | } 48 | tmp <- Filter(Negate(is_length_zero), l) 49 | if (length(tmp) == 1 && is(tmp, "list")) { 50 | tmp[[1]] 51 | } else { 52 | tmp 53 | } 54 | } 55 | 56 | strextract <- function(str, pattern) { 57 | regmatches(str, regexpr(pattern, str)) 58 | } 59 | 60 | strtrim <- function(str) { 61 | gsub("^\\s+|\\s+$", "", str) 62 | } 63 | 64 | trimslash <- function(str) { 65 | gsub("\\/+$", "", str) 66 | } 67 | 68 | combconfig <- function(x) { 69 | x <- comp(x) 70 | if (is.null(x)) { 71 | NULL 72 | } else { 73 | req <- do.call("c", x[vapply(x, class, "") == "request"]) 74 | c(req, x[vapply(x, class, "") != "request"]) 75 | } 76 | } 77 | 78 | gather_paths <- function(x) { 79 | x$url <- trimslash(x$url) 80 | if (!is.null(x$paths) && !is.null(x$template)) { 81 | stop("Cannot pass use both api_template and api_path", call. = FALSE) 82 | } 83 | if (!is.null(x$paths)) { 84 | file.path(x$url, paste(unlist(x$paths), collapse = "/")) 85 | } else if (!is.null(x$template)) { 86 | file.path(x$url, x$template) 87 | } else { 88 | x$url 89 | } 90 | } 91 | 92 | make_ua <- function() { 93 | versions <- c(libcurl = curl::curl_version()$version, 94 | `r-curl` = as.character(packageVersion("curl")), 95 | httr = as.character(packageVersion("httr")), 96 | request = as.character(packageVersion("request"))) 97 | paste0(names(versions), "/", versions, collapse = " ") 98 | } 99 | 100 | get_links <- function(w) { 101 | lk <- w$link 102 | if (is.null(lk)) { 103 | NULL 104 | } else { 105 | if (is(lk, "character")) { 106 | links <- strtrim(strsplit(lk, ",")[[1]]) 107 | lapply(links, each_link) 108 | } else { 109 | nms <- sapply(w, "[[", "name") 110 | tmp <- unlist(w[nms %in% "next"]) 111 | grep("http", tmp, value = TRUE) 112 | } 113 | } 114 | } 115 | 116 | each_link <- function(z) { 117 | tmp <- strtrim(strsplit(z, ";")[[1]]) 118 | nm <- gsub("\"|(rel)|=", "", tmp[2]) 119 | url <- gsub("^<|>$", "", tmp[1]) 120 | list(name = nm, url = url) 121 | } 122 | 123 | `%||%` <- function(x, y) { 124 | if (is.null(x)) y else x 125 | } 126 | 127 | isC <- function(x) { 128 | if ("cache" %in% names(x)) { 129 | stopifnot(inherits(x$cache, "logical")) 130 | x$cache 131 | } else { 132 | FALSE 133 | } 134 | } 135 | -------------------------------------------------------------------------------- /man/auth.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/authentication.R 3 | \name{auth} 4 | \alias{auth} 5 | \alias{api_simple_auth} 6 | \alias{api_oauth2} 7 | \alias{api_oauth1} 8 | \title{Authentication configuration/setup} 9 | \usage{ 10 | api_simple_auth(.data, user, pwd, type = "basic") 11 | 12 | api_oauth2( 13 | .data, 14 | token = NULL, 15 | app_name = NULL, 16 | key = NULL, 17 | secret = NULL, 18 | base_url = NULL, 19 | authorize = NULL, 20 | access = NULL 21 | ) 22 | 23 | api_oauth1( 24 | .data, 25 | token = NULL, 26 | app_name = NULL, 27 | key = NULL, 28 | secret = NULL, 29 | base_url = NULL, 30 | request = NULL, 31 | authorize = NULL, 32 | access = NULL 33 | ) 34 | } 35 | \arguments{ 36 | \item{.data}{Result of a call to \code{api}} 37 | 38 | \item{user}{user name} 39 | 40 | \item{pwd}{password} 41 | 42 | \item{type}{type of HTTP authentication. Should be one of the following types 43 | supported by Curl: basic, digest, digest_ie, gssnegotiate, ntlm, ntlm_vn, any. 44 | Default: "basic" (the most common type)} 45 | 46 | \item{token}{An OAuth token} 47 | 48 | \item{app_name}{An OAuth application name} 49 | 50 | \item{key}{An OAuth key} 51 | 52 | \item{secret}{An OAuth secret key} 53 | 54 | \item{base_url}{option url to use as base for request, authorize and access urls.} 55 | 56 | \item{authorize}{url to send client to for authorisation} 57 | 58 | \item{access}{url used to exchange unauthenticated for authenticated token.} 59 | 60 | \item{request}{url used to request initial (unauthenticated) token. If using 61 | OAuth2.0, leave as NULL.} 62 | } 63 | \description{ 64 | Authentication configuration/setup 65 | } 66 | \examples{ 67 | \dontrun{ 68 | # simple authentication (user/password) 69 | api('https://httpbin.org/basic-auth/user/passwd') \%>\% 70 | api_simple_auth(user = "user", pwd = "passwd") 71 | ## different auth type 72 | api('https://httpbin.org/basic-auth/user/passwd') \%>\% 73 | api_simple_auth(user = "user", pwd = "passwd", type = "gssnegotiate") 74 | 75 | # OAuth setup 76 | ## using a token 77 | ### fill in your own token 78 | # api('https://api.github.com/') \%>\% 79 | # api_path(orgs, ropensci, events) \%>\% 80 | # api_oauth2(token = "") \%>\% 81 | # api_config(verbose()) 82 | 83 | # OAuth2 84 | ## using a app name, key, and secret combination 85 | ### uses a OAuth app set up by Hadley Wickham, which you'll auth against 86 | # api('https://api.github.com/') \%>\% 87 | # api_oauth2(app_name = "github", key = "56b637a5baffac62cad9", 88 | # secret = "8e107541ae1791259e9987d544ca568633da2ebf", 89 | # base_url = "https://github.com/login/oauth", 90 | # authorize = "authorize", access = "access_token") 91 | 92 | # OAuth1 93 | # api('https://api.twitter.com/1.1/statuses/home_timeline.json') \%>\% 94 | # api_oauth1(app_name = "twitter", key = "afdafasdfs", 95 | # secret = "asdfasdfasfasfsdf", 96 | # base_url = "https://api.twitter.com/oauth/", 97 | # request = "request_token", authorize = "authenticate", access = "access_token") 98 | 99 | # Request some data with oauth2 via Github 100 | ## put in your username and password 101 | # api('https://api.github.com/') \%>\% 102 | # api_simple_auth(user = "", pwd = "") 103 | } 104 | } 105 | \seealso{ 106 | Other dsl: 107 | \code{\link{api_body}()}, 108 | \code{\link{api_config}()}, 109 | \code{\link{api_error_handler}()}, 110 | \code{\link{api_path}()}, 111 | \code{\link{api_query}()}, 112 | \code{\link{api_template}()}, 113 | \code{\link{api}()} 114 | } 115 | \concept{dsl} 116 | -------------------------------------------------------------------------------- /R/authentication.R: -------------------------------------------------------------------------------- 1 | #' Authentication configuration/setup 2 | #' 3 | #' @export 4 | #' 5 | #' @family dsl 6 | #' @name auth 7 | #' @param .data Result of a call to \code{api} 8 | #' @param token An OAuth token 9 | #' @param app_name An OAuth application name 10 | #' @param key An OAuth key 11 | #' @param secret An OAuth secret key 12 | #' @param base_url option url to use as base for request, authorize and access urls. 13 | #' @param request url used to request initial (unauthenticated) token. If using 14 | #' OAuth2.0, leave as NULL. 15 | #' @param authorize url to send client to for authorisation 16 | #' @param access url used to exchange unauthenticated for authenticated token. 17 | #' @param user user name 18 | #' @param pwd password 19 | #' @param type type of HTTP authentication. Should be one of the following types 20 | #' supported by Curl: basic, digest, digest_ie, gssnegotiate, ntlm, ntlm_vn, any. 21 | #' Default: "basic" (the most common type) 22 | #' @examples \dontrun{ 23 | #' # simple authentication (user/password) 24 | #' api('https://httpbin.org/basic-auth/user/passwd') %>% 25 | #' api_simple_auth(user = "user", pwd = "passwd") 26 | #' ## different auth type 27 | #' api('https://httpbin.org/basic-auth/user/passwd') %>% 28 | #' api_simple_auth(user = "user", pwd = "passwd", type = "gssnegotiate") 29 | #' 30 | #' # OAuth setup 31 | #' ## using a token 32 | #' ### fill in your own token 33 | #' # api('https://api.github.com/') %>% 34 | #' # api_path(orgs, ropensci, events) %>% 35 | #' # api_oauth2(token = "") %>% 36 | #' # api_config(verbose()) 37 | #' 38 | #' # OAuth2 39 | #' ## using a app name, key, and secret combination 40 | #' ### uses a OAuth app set up by Hadley Wickham, which you'll auth against 41 | #' # api('https://api.github.com/') %>% 42 | #' # api_oauth2(app_name = "github", key = "56b637a5baffac62cad9", 43 | #' # secret = "8e107541ae1791259e9987d544ca568633da2ebf", 44 | #' # base_url = "https://github.com/login/oauth", 45 | #' # authorize = "authorize", access = "access_token") 46 | #' 47 | #' # OAuth1 48 | #' # api('https://api.twitter.com/1.1/statuses/home_timeline.json') %>% 49 | #' # api_oauth1(app_name = "twitter", key = "afdafasdfs", 50 | #' # secret = "asdfasdfasfasfsdf", 51 | #' # base_url = "https://api.twitter.com/oauth/", 52 | #' # request = "request_token", authorize = "authenticate", access = "access_token") 53 | #' 54 | #' # Request some data with oauth2 via Github 55 | #' ## put in your username and password 56 | #' # api('https://api.github.com/') %>% 57 | #' # api_simple_auth(user = "", pwd = "") 58 | #' } 59 | 60 | # simple authentication ------------------------------------ 61 | #' @export 62 | #' @rdname auth 63 | api_simple_auth <- function(.data, user, pwd, type = "basic") { 64 | pipe_autoexec(toggle = TRUE) 65 | .data <- as.req(.data) 66 | #modifyList(.data, list(config = c(authenticate(user = user, password = pwd, type = type)))) 67 | .data$config <- combconfig(list(.data$config, authenticate(user = user, password = pwd, type = type))) 68 | return(.data) 69 | } 70 | 71 | # oauth ------------------------------------ 72 | # oauth2 ------------------------------------ 73 | #' @export 74 | #' @rdname auth 75 | api_oauth2 <- function(.data, token = NULL, app_name = NULL, key = NULL, 76 | secret = NULL, base_url = NULL, 77 | authorize = NULL, access = NULL) { 78 | 79 | pipe_autoexec(toggle = TRUE) 80 | .data <- as.req(.data) 81 | args <- comp(list(token = token, app_name = app_name, key = key, secret = secret)) 82 | if (length(args) == 0) { 83 | stop("either token or app_name + key + secret must be provided", call. = FALSE) 84 | } else { 85 | if (!is.null(token)) { 86 | #auth <- config(token = token) 87 | auth <- add_headers(Authorization = paste0("token ", token)) 88 | } else { 89 | app <- oauth_app(app_name, key, secret) 90 | endpts <- oauth_endpoint(authorize = authorize, access = access, base_url = base_url) 91 | token <- oauth2.0_token(endpts, app) 92 | auth <- config(token = token) 93 | } 94 | } 95 | # modifyList(.data, list(config = c(auth))) 96 | .data$config <- combconfig(list(.data$config, auth)) 97 | return(.data) 98 | } 99 | 100 | # oauth1 ------------------------------------ 101 | #' @export 102 | #' @rdname auth 103 | api_oauth1 <- function(.data, token = NULL, app_name = NULL, key = NULL, 104 | secret = NULL, base_url = NULL, request = NULL, 105 | authorize = NULL, access = NULL) { 106 | 107 | pipe_autoexec(toggle = TRUE) 108 | .data <- as.req(.data) 109 | args <- comp(list(token = token, app_name = app_name, key = key, secret = secret)) 110 | if (length(args) == 0) { 111 | stop("either token or app_name + key + secret must be provided", call. = FALSE) 112 | } else { 113 | if (!is.null(token)) { 114 | auth <- config(token = token) 115 | } else { 116 | app <- oauth_app(app_name, key, secret) 117 | endpts <- oauth_endpoint(request = request, authorize = authorize, 118 | access = access, base_url = base_url) 119 | token <- oauth1.0_token(endpts, app) 120 | auth <- config(token = token) 121 | } 122 | } 123 | # modifyList(.data, list(config = c(auth))) 124 | .data$config <- combconfig(list(.data$config, auth)) 125 | return(.data) 126 | } 127 | -------------------------------------------------------------------------------- /inst/ignore/paging.R: -------------------------------------------------------------------------------- 1 | #' Paging helpers 2 | #' 3 | #' @export 4 | #' @param .data Result of a call to \code{api} 5 | #' @param limit Maximum number results desired. 6 | #' @param limit_max Maximum number results allowed in each request. 7 | #' @param offset Record to start at 8 | #' @param by Chunk size, if chunking desired. Default: 9 | #' @family dsl 10 | #' @section Special Functions: 11 | #' \itemize{ 12 | #' \item \code{limit(x)}: \code{x = N}, where x is the name of the API 13 | #' variable for determing how many results to return, 14 | #' \item \code{limit_max(x)}: xx 15 | #' \item \code{offset(x)}: \code{x = N}, where x is the name of the API 16 | #' variable for determing what record to start at 17 | #' \item \code{page(x)}: what page to return 18 | #' } 19 | #' @examples 20 | #' url <- 'http://localhost:9200' 21 | #' quer <- 22 | #' api(url) %>% 23 | #' api_path(shakespeare, `_search`) %>% 24 | #' api_paging(limit(size = 10)) 25 | #' 26 | #' api(url) %>% 27 | #' api_path(shakespeare, act, `_search`) %>% 28 | #' api_paging(size = 5) 29 | #' 30 | #' url <- 'https://api.github.com/' 31 | #' quer <- api(url) %>% 32 | #' api_path(repos, ropensci, rgbif, issues) %>% 33 | #' api_query(state = open) 34 | #' 35 | #' # per_page & page, w/ known max_limit 36 | #' api('https://api.github.com/') %>% 37 | #' api_paging(limit = 220, limit_max = 100) 38 | #' 39 | #' ##### Not working yet 40 | #' # per_page & page 41 | #' # quer %>% 42 | #' # api_paging(per_page = 10, page = 2) 43 | #' 44 | #' # limit & offset 45 | #' # quer %>% 46 | #' # api_paging(limit = 10, offset = 20) 47 | #' 48 | #' # rows & start 49 | #' # quer %>% 50 | #' # api_paging(rows = 10, start = 5) 51 | #' 52 | #' # or could it look like this: 53 | #' ## YES, this! 54 | #' api('https://api.github.com/') %>% api_paging(limit(size = 10)) 55 | #' 56 | #' #### pattern: page/per_page 57 | #' api('https://api.github.com/') %>% 58 | #' api_path(orgs, ropensci, events) %>% 59 | #' api_paging(chunk(per_page = 4), page(page = 2)) %>% 60 | #' peep 61 | #' 62 | #' #### pattern: limit/offset 63 | #' api('http://api.gbif.org/v1') %>% 64 | #' api_path(occurrence, search) %>% 65 | #' api_query(scientificName = Accipiter) %>% 66 | #' api_paging(limit(limit = 4), offset(offset = 2)) %>% 67 | #' peep 68 | 69 | api_paging <- function(.data, ..., by = NULL) { 70 | .data <- as.req(.data) 71 | # stopifnot(is.numeric(limit), is.numeric(limit_max), is.numeric(offset)) 72 | # by <- get_by(by, limit, limit_max) 73 | # args <- list(limit = limit, size = size, rows = rows, page = page, 74 | # per_page = per_page, limit_max = limit_max, 75 | # start = start, offset = offset, by = by) 76 | 77 | # modifyList(.data, list(paging = list(size = 0, ...))) 78 | modifyList(.data, list(paging = list(...))) 79 | } 80 | 81 | limit <- function(...) { 82 | lazyeval::all_dots(lazyeval::lazy_dots(...)) 83 | } 84 | 85 | offset <- function(...) { 86 | lazyeval::all_dots(lazyeval::lazy_dots(...)) 87 | } 88 | 89 | page <- function(...) { 90 | lazyeval::all_dots(lazyeval::lazy_dots(...)) 91 | } 92 | 93 | chunk <- function(...) { 94 | lazyeval::all_dots(lazyeval::lazy_dots(...)) 95 | } 96 | # vals <- unname(Map(function(x, y) { 97 | # if (nchar(x) == 0) { 98 | # as.character(y$expr) 99 | # } 100 | # else { 101 | # sprintf("%s: %s", x, as.character(y$expr)) 102 | # } 103 | # }, names(tmp), tmp)) 104 | # z <- paste0("{", paste0(vals, collapse = ", "), "}") 105 | # dots <- comb(tryargs(.data), structure(z, type = "select")) 106 | # structure(list(data = getdata(.data), args = dots), class = "jqr") 107 | #} 108 | 109 | get_by <- function(by, limit, limit_max) { 110 | if (!is.null(by)) { 111 | stopifnot(is.numeric(by)) 112 | stopifnot(by < limit_max) 113 | return(by) 114 | } else { 115 | if (limit > limit_max) { 116 | return(limit_max) 117 | } else { 118 | return(limit) 119 | } 120 | } 121 | } 122 | 123 | rename_vars <- function(limit, size, rows) { 124 | 125 | } 126 | 127 | # ## four headers 128 | # x=HEAD("https://api.github.com/repos/ropensci/taxize/issues?state=open&per_page=5&page=4") 129 | # get_links(x$headers) 130 | # ## two headers 131 | # x=HEAD("https://api.github.com/repos/ropensci/taxize/issues") 132 | # get_links(x$headers) 133 | # ## no headers 134 | # x=HEAD("https://api.github.com/repos/ropensci/pangaear/issues") 135 | # get_links(x$headers) 136 | get_links <- function(w) { 137 | lk <- w$link 138 | if (is.null(lk)) { 139 | NULL 140 | } else { 141 | if (is(lk, "character")) { 142 | links <- strtrim(strsplit(lk, ",")[[1]]) 143 | lapply(links, each_link) 144 | } else { 145 | nms <- sapply(w, "[[", "name") 146 | tmp <- unlist(w[nms %in% "next"]) 147 | grep("http", tmp, value = TRUE) 148 | } 149 | } 150 | } 151 | # get_links <- function(w) { 152 | # lk <- w$link 153 | # urls <- comp(sapply(w, "[[", "url")) 154 | # if (is.null(lk) && length(urls) == 0) { 155 | # NULL 156 | # } else { 157 | # if (is(w, "character")) { 158 | # links <- strtrim(strsplit(lk, ",")[[1]]) 159 | # lapply(links, each_link) 160 | # } else { 161 | # nms <- sapply(w, "[[", "name") 162 | # tmp <- unlist(w[nms %in% "next"]) 163 | # grep("http", tmp, value = TRUE) 164 | # } 165 | # } 166 | # } 167 | 168 | each_link <- function(z) { 169 | tmp <- strtrim(strsplit(z, ";")[[1]]) 170 | nm <- gsub("\"|(rel)|=", "", tmp[2]) 171 | url <- gsub("^<|>$", "", tmp[1]) 172 | list(name = nm, url = url) 173 | } 174 | -------------------------------------------------------------------------------- /inst/ignore/brainstorming.R: -------------------------------------------------------------------------------- 1 | #' http DSL 2 | #' 3 | #' @export 4 | #' @family dsl 5 | #' @examples \dontrun{ 6 | #' # Set base url 7 | #' ## works with full or partial URLs 8 | #' api('https://api.github.com/') 9 | #' api('http://api.gbif.org/v1') 10 | #' api('api.gbif.org/v1') 11 | #' 12 | #' ## works with ports, full or partial 13 | #' api('http://localhost:9200') 14 | #' api('localhost:9200') 15 | #' api(':9200') 16 | #' api('9200') 17 | #' api('9200/stuff') 18 | #' 19 | #' # set paths 20 | #' ## NSE 21 | #' api('https://api.github.com/') %>% 22 | #' api_path(repos, ropensci, rgbif, issues) 23 | #' ## SE 24 | #' api('https://api.github.com/') %>% 25 | #' api_path_('repos', 'ropensci', 'rgbif', 'issues') 26 | #' 27 | #' # template 28 | #' repo_info <- list(username = 'craigcitro', repo = 'r-travis') 29 | #' api('https://api.github.com/') %>% 30 | #' api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) 31 | #' 32 | #' # OAuth setup 33 | #' api('https://api.github.com/') %>% 34 | #' api_oauth2(token = "") 35 | #' 36 | #' # Error handler 37 | #' api('https://api.github.com/') %>% 38 | #' api_error_handler(stop_for_status) 39 | #' 40 | #' # Config handler 41 | #' api('https://api.github.com/') %>% 42 | #' api_config(verbose()) 43 | #' 44 | #' # Query handler 45 | #' ## NSE 46 | #' api("http://api.plos.org/search") %>% 47 | #' api_query(q = ecology, wt = json, fl = 'id,journal') %>% 48 | #' Get() 49 | #' ## SE 50 | #' api("http://api.plos.org/search") %>% 51 | #' api_query_(q = "ecology", wt = "json", fl = 'id', fl = 'journal') %>% 52 | #' Get() 53 | #' 54 | #' # xxx handler 55 | #' api("http://api.plos.org/search") %>% 56 | #' xxxx 57 | #' 58 | #' # Full examples 59 | #' api('https://api.github.com/') %>% 60 | #' api_path(repos, ropensci, rgbif, issues) %>% 61 | #' api_config(verbose()) %>% 62 | #' Get() 63 | #' 64 | #' repo_info <- list(username = 'craigcitro', repo = 'r-travis') 65 | #' api('https://api.github.com/') %>% 66 | #' api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) %>% 67 | #' Get() 68 | #' 69 | #' # parse=TRUE by default, in this eg parses directly to a data.frame 70 | #' api('https://api.github.com/') %>% 71 | #' api_path(repos, ropensci, rgbif, issues) %>% 72 | #' Get() 73 | #' } 74 | api <- function(x) { 75 | structure(list(url = as.url(x)), class = "endpoint") 76 | } 77 | 78 | print.endpoint <- function(x, ...) { 79 | cat(sprintf("URL: %s", x$url)) 80 | } 81 | 82 | #' path defintion ------------------------------------ 83 | #' @export 84 | #' @family dsl 85 | api_path <- function(.data, ..., .dots) { 86 | api_path_(.data, .dots = lazyeval::lazy_dots(...)) 87 | } 88 | 89 | #' @export 90 | #' @family dsl 91 | api_path_ <- function(.data, ..., .dots) { 92 | tmp <- lazyeval::all_dots(.dots, ...) 93 | .data <- as.req(.data) 94 | modifyList(.data, list(paths = getpaths(tmp))) 95 | } 96 | 97 | getpaths <- function(x) { 98 | unname(sapply(x, function(z) as.character(z$expr))) 99 | } 100 | 101 | #' api template ------------------------------------ 102 | #' @export 103 | #' @family dsl 104 | api_template <- function(.data, template, data) { 105 | .data <- as.req(.data) 106 | temp <- whisker::whisker.render(template, data) 107 | modifyList(.data, list(template = temp)) 108 | } 109 | 110 | #' oauth setup ------------------------------------ 111 | #' @export 112 | #' @family dsl 113 | api_oauth2 <- function(.data, token = NULL, app_name = NULL, key = NULL, 114 | secret = NULL, request = NULL, authorize = NULL, 115 | access = NULL, base_url = NULL, ...) { 116 | .data <- as.req(.data) 117 | 118 | args <- comp(list(token = token, app_name = app_name, key = key, secret = secret)) 119 | if (length(args) == 0) { 120 | stop("either token or app_name + key + secret must be provided", call. = FALSE) 121 | } else { 122 | if (!is.null(token)) { 123 | auth <- config(token = token) 124 | } else { 125 | app <- oauth_app(app_name, key, secret) 126 | endpts <- oauth_endpoint(request = request, authorize = authorize, 127 | access = access, base_url = base_url) 128 | token <- oauth2.0_token(endpts, app) 129 | auth <- config(token = token) 130 | } 131 | } 132 | 133 | modifyList(.data, list(config = c(auth))) 134 | } 135 | 136 | #' error handler ------------------------------------ 137 | #' @export 138 | #' @family dsl 139 | api_error_handler <- function(.data, func) { 140 | .data <- as.req(.data) 141 | fn_name <- deparse(substitute(func)) 142 | tmp <- setNames(list(func), fn_name) 143 | modifyList(.data, list(error = tmp)) 144 | } 145 | 146 | #' configuration handler ------------------------------------ 147 | #' @export 148 | #' @family dsl 149 | api_config <- function(.data, ...) { 150 | .data <- as.req(.data) 151 | tmp <- list(...) 152 | modifyList(.data, list(config = tmp)) 153 | } 154 | 155 | #' query handler ------------------------------------ 156 | #' @export 157 | #' @family dsl 158 | api_query <- function(.data, ...){ 159 | api_query_(.data, .dots = lazyeval::lazy_dots(...)) 160 | } 161 | 162 | api_query_ <- function(.data, ..., .dots){ 163 | dots <- lazyeval::all_dots(.dots, ...) 164 | args <- sapply(dots, "[[", "expr") 165 | .data <- as.req(.data) 166 | modifyList(.data, list(query = args)) 167 | } 168 | 169 | # api_query <- function(.data, ...){ 170 | # .data <- as.req(.data) 171 | # args <- list(...) 172 | # modifyList(.data, list(query = args)) 173 | # } 174 | 175 | # #' @export 176 | # api_config <- function(.data, ..., .dots) { 177 | # api_config_(.data, .dots = lazyeval::lazy_dots(...)) 178 | # } 179 | # 180 | # #' @export 181 | # api_config_ <- function(.data, ..., .dots) { 182 | # tmp <- lazyeval::all_dots(.dots, ...) 183 | # .data <- as.req(.data) 184 | # modifyList(.data, list(config = tmp)) 185 | # } 186 | -------------------------------------------------------------------------------- /inst/ignore/RequestIterator_withpaging.R: -------------------------------------------------------------------------------- 1 | RequestIterator <- R6::R6Class( 2 | "RequestIterator", 3 | public = list( 4 | result = list(), 5 | paging = NULL, 6 | links = list(), 7 | size = 0, 8 | initialize = function(result, paging, links) { 9 | if (!missing(result)) self$result <- result 10 | if (!missing(paging)) self$paging <- paging 11 | if (!missing(links)) self$links <- links 12 | }, 13 | GET = function(.data, ...) { 14 | if (length(self$links) == 0) { 15 | .data <- as.req(.data) 16 | .data$config <- c(httr::user_agent(make_ua()), .data$config, .data$headers) 17 | .data$url <- gather_paths(.data) 18 | .data$query <- if (is.null(.data$query)) NULL else as.list(.data$query) 19 | .data$query <- 20 | as.list(c(.data$query, setNames(lapply(self$paging, function(z) z[[1]]$expr), 21 | get_names(self$paging)))) 22 | res <- suppressWarnings(httr::GET(.data$url[1], .data$config, .data$write, 23 | query = .data$query, ...)) 24 | } else { 25 | .data <- as.req(self$links[[1]]$url) 26 | res <- suppressWarnings(httr::GET(.data$url[1], .data$config, .data$write, ...)) 27 | } 28 | # error catching 29 | self$handle_errors(.data, res) 30 | # cache links 31 | self$links <- get_links(res$headers) 32 | # give back result 33 | self$result <- empty(list(self$result, res)) 34 | }, 35 | POST = function(.data, ...) { 36 | if (length(self$links) == 0) { 37 | .data <- as.req(.data) 38 | .data$config <- c(httr::user_agent(make_ua()), .data$config) 39 | .data$url <- gather_paths(.data) 40 | res <- suppressWarnings(httr::POST(.data$url[1], .data$config, body = .data$body, ...)) 41 | } else { 42 | .data <- as.req(self$links[[1]]$url) 43 | res <- suppressWarnings(httr::POST(.data$url[1], .data$config, ...)) 44 | } 45 | # error catching 46 | self$handle_errors(.data, res) 47 | # cache links 48 | self$links <- get_links(res$headers) 49 | # give back result 50 | self$result <- empty(list(self$result, res)) 51 | }, 52 | body = function() { 53 | self$result 54 | }, 55 | status = function() { 56 | if (inherits(self$result, "response")) { 57 | self$result$status_code 58 | } else { 59 | lapply(self$result, function(z) { 60 | if (inherits(z, "response")) { 61 | z$status_code 62 | } else { 63 | NULL 64 | } 65 | }) 66 | } 67 | }, 68 | parse = function(parse = TRUE) { 69 | x <- self$result 70 | if (inherits(x, "response")) { 71 | httr_parse(x, parse = parse) 72 | } else { 73 | lapply(x, httr_parse, parse = parse) 74 | } 75 | }, 76 | count = function() { 77 | if (inherits(self$result, "response")) { 78 | tmp <- httr::content(self$result, "text", encoding = "UTF-8") 79 | if (grepl("json", self$result$headers$`content-type`)) tmp <- jsonlite::fromJSON(tmp) 80 | self$size <- if (inherits(tmp, "data.frame")) NROW(tmp) else length(tmp) 81 | self$size 82 | } else { 83 | self$size <- sum( 84 | sapply(self$result, function(x) { 85 | tmp <- httr::content(self$result, "text", encoding = "UTF-8") 86 | if (grepl("json", self$result$headers$`content-type`)) tmp <- jsonlite::fromJSON(tmp) 87 | if (inherits(tmp, "data.frame")) NROW(tmp) else length(tmp) 88 | }) 89 | ) 90 | self$size 91 | } 92 | }, 93 | handle_errors = function(.data, x) { 94 | if (!is.null(.data$retry)) { 95 | i <- 0 96 | while (x$status_code > 201 && i < .data$retry$n) { 97 | i <- i + 1 98 | message("Retrying request\n") 99 | x <- self$GET(.data) 100 | Sys.sleep(.data$retry$time) 101 | } 102 | return(x) 103 | } 104 | if (is.null(.data$error)) { 105 | # httr::stop_for_status(x) 106 | try_error(x) 107 | } else { 108 | .data$error[[1]](x) 109 | } 110 | } 111 | )) 112 | 113 | try_error <- function(x) { 114 | if (x$status_code > 201) { 115 | one <- tryCatch(httr::content(x, "text", encoding = "UTF-8"), error = function(e) e) 116 | if (!inherits(one, "error")) { 117 | two <- tryCatch(one$error, error = function(e) e) 118 | if (!inherits(two, "error")) { 119 | msg <- sprintf("%s - %s", x$status_code, two) 120 | } else { 121 | msg <- httr::http_status(x)$message 122 | } 123 | } else { 124 | msg <- httr::http_status(x)$message 125 | } 126 | stop(msg, call. = FALSE) 127 | } 128 | } 129 | 130 | httr_parse <- function(x, parse) { 131 | if (grepl("json", x$headers$`content-type`)) { 132 | if (!is.null(x$request$output$path)) { 133 | return(x$request$output$path) 134 | } else { 135 | txt <- httr::content(x, "text", encoding = "UTF-8") 136 | tibble::as_data_frame(jsonlite::fromJSON(txt, parse, flatten = TRUE)) 137 | } 138 | } else { 139 | httr::content(x, "text", encoding = "UTF-8") 140 | } 141 | } 142 | 143 | get_names <- function(x) { 144 | res <- c() 145 | for (i in seq_along(x)) { 146 | res[i] <- 147 | if (inherits(x[[i]], "lazy_dots")) { 148 | names(x[[i]]) 149 | } else { 150 | names(x[i]) 151 | } 152 | } 153 | return(res) 154 | } 155 | 156 | # dd <- api('https://api.github.com/') %>% 157 | # api_path(repos, ropensci, rgbif, commits) %>% 158 | # api_paging(limit = 220, limit_max = 100) 159 | # # dd <- api('https://api.github.com/') %>% 160 | # # api_path(repos, ropensci, rplos, commits) %>% 161 | # # api_paging(limit = 220, limit_max = 100) 162 | # rr <- GetIter$new(limit = dd$paging$limit, limit_max = dd$paging$limit_max) 163 | # rr$GET(dd) 164 | # rr$count() 165 | # rr$result 166 | # rr$links 167 | # rr$parse() 168 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | request 2 | ======= 3 | 4 | ```{r echo=FALSE} 5 | hook_output <- knitr::knit_hooks$get("output") 6 | knitr::knit_hooks$set(output = function(x, options) { 7 | lines <- options$output.lines 8 | if (is.null(lines)) { 9 | return(hook_output(x, options)) # pass to default hook 10 | } 11 | x <- unlist(strsplit(x, "\n")) 12 | more <- "..." 13 | if (length(lines) == 1) { # first n lines 14 | if (length(x) > lines) { 15 | # truncate the output, but add .... 16 | x <- c(head(x, lines), more) 17 | } 18 | } else { 19 | x <- c(if (abs(lines[1])>1) more else NULL, 20 | x[lines], 21 | if (length(x)>lines[abs(length(lines))]) more else NULL 22 | ) 23 | } 24 | # paste these lines together 25 | x <- paste(c(x, ""), collapse = "\n") 26 | hook_output(x, options) 27 | }) 28 | 29 | knitr::opts_chunk$set( 30 | warning = FALSE, 31 | message = FALSE, 32 | collapse = TRUE, 33 | comment = "#>" 34 | ) 35 | ``` 36 | 37 | [![cran checks](https://cranchecks.info/badges/worst/request)](https://cranchecks.info/pkgs/request) 38 | [![Build Status](https://travis-ci.org/sckott/request.svg)](https://travis-ci.org/sckott/request) 39 | [![codecov.io](https://codecov.io/github/sckott/request/coverage.svg?branch=master)](https://codecov.io/github/sckott/request?branch=master) 40 | [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/request?color=F3B1FF)](https://github.com/metacran/cranlogs.app) 41 | [![cran version](http://www.r-pkg.org/badges/version/request)](https://cran.r-project.org/package=request) 42 | 43 | `request` is DSL for http requests for R, and is inspired by the CLI tool [httpie](https://github.com/jakubroztocil/httpie). 44 | 45 | `request` is built on `httr`, though may allow using the R packages `RCurl` or `curl` as optional backends at some point. 46 | 47 | I gave a poster at User2016, its in my [talks repo](https://github.com/sckott/talks/blob/gh-pages/user2016/request.pdf) 48 | 49 | ## Philosophy 50 | 51 | * The web is increasingly a JSON world, so we assume `applications/json` by default, but give back other types if not 52 | * The workflow follows logically, or at least should, from, _hey, I got this url_, to _i need to add some options_, to _execute request_ 53 | * Whenever possible, we transform output to data.frame's - facilitating downstream manipulation via `dplyr`, etc. 54 | * We do `GET` requests by default. Specify a different type if you don't want `GET` 55 | * You can use non-standard evaluation to easily pass in query parameters without worrying about `&`'s, URL escaping, etc. (see `api_query()`) 56 | * Same for body params (see `api_body()`) 57 | 58 | All of the defaults just mentioned can be changed. 59 | 60 | ## Auto execute http requests with pipes 61 | 62 | When using pipes, we autodetect that a pipe is being used within the function calls, and automatically do the appropriate http request on the last piped function call. When you call a function without using pipes, you have to use the `http()` function explicitly to make the http request. 63 | 64 | ## low level http 65 | 66 | Low level access is available with `http_client()`, which returns an `R6` class with various methods for inspecting http request results. 67 | 68 | ## Peek at a request 69 | 70 | The function `peep()` let's you peek at a request without performing the http request. 71 | 72 | ## Install 73 | 74 | From CRAN 75 | 76 | ```{r eval=FALSE} 77 | install.packages("request") 78 | ``` 79 | 80 | Development version from GitHub 81 | 82 | ```{r eval=FALSE} 83 | remotes::install_github("sckott/request") 84 | ``` 85 | 86 | ```{r} 87 | library("request") 88 | ``` 89 | 90 | ## NSE and SE 91 | 92 | NSE is supported 93 | 94 | ```{r eval=FALSE} 95 | api('https://api.github.com/') %>% 96 | api_path(repos, ropensci, rgbif, issues) 97 | ``` 98 | 99 | as well as SE 100 | 101 | ```{r eval=FALSE} 102 | api('https://api.github.com/') %>% 103 | api_path_('repos', 'ropensci', 'rgbif', 'issues') 104 | ``` 105 | 106 | ## Building API routes 107 | 108 | Works with full or partial URLs 109 | 110 | ```{r} 111 | api('https://api.github.com/') 112 | api('http://api.gbif.org/v1') 113 | api('api.gbif.org/v1') 114 | ``` 115 | 116 | Works with ports, full or partial 117 | 118 | ```{r} 119 | api('http://localhost:9200') 120 | api('localhost:9200') 121 | api(':9200') 122 | api('9200') 123 | api('9200/stuff') 124 | ``` 125 | 126 | ## Make HTTP requests 127 | 128 | The above examples with `api()` are not passed through a pipe, so only define a URL, but don't do an HTTP request. To make an HTTP request, you can either pipe a url or partial url to e.g., `api()`, or call `http()` at the end of a string of function calls: 129 | 130 | ```{r output.lines = 1:10} 131 | 'https://api.github.com/' %>% api() 132 | ``` 133 | 134 | Or 135 | 136 | ```{r output.lines = 1:10} 137 | api('https://api.github.com/') %>% http() 138 | ``` 139 | 140 | `http()` is called at the end of a chain of piped commands, so no need to invoke it. However, you can if you like. 141 | 142 | ## Templating 143 | 144 | ```{r} 145 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 146 | api('https://api.github.com/') %>% 147 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) %>% 148 | peep 149 | ``` 150 | 151 | ## Set paths 152 | 153 | `api_path()` adds paths to the base URL (see `api_query()`) for query parameters 154 | 155 | ```{r} 156 | api('https://api.github.com/') %>% 157 | api_path(repos, ropensci, rgbif, issues) %>% 158 | peep 159 | ``` 160 | 161 | ## Query 162 | 163 | ```{r} 164 | api("http://api.plos.org/search") %>% 165 | api_query(q = ecology, wt = json, fl = 'id,journal') %>% 166 | peep 167 | ``` 168 | 169 | ## ToDo 170 | 171 | See [the issues](https://github.com/sckott/request/issues) for discussion of these 172 | 173 | * Paging 174 | * Retry 175 | * Rate limit 176 | 177 | ## Meta 178 | 179 | * Please note that this project is released with a [Contributor Code of Conduct][coc]. By participating in this project you agree to abide by its terms. 180 | 181 | [coc]: https://github.com/sckott/request/blob/master/.github/CODE_OF_CONDUCT.md 182 | -------------------------------------------------------------------------------- /R/RequestIterator.R: -------------------------------------------------------------------------------- 1 | RequestIterator <- R6::R6Class("RequestIterator", 2 | public = list( 3 | result = list(), 4 | limit = NA, 5 | limit_max = NA, 6 | links = list(), 7 | initialize = function(result, limit, limit_max, links) { 8 | if (!missing(result)) self$result <- result 9 | if (!missing(limit)) self$limit <- limit 10 | if (!missing(limit_max)) self$limit_max <- limit_max 11 | if (!missing(links)) self$links <- links 12 | }, 13 | 14 | GET = function(.data, ...) { 15 | if (isC(.data)) cache_make(.data$cache_path) 16 | if (isC(.data) && file.exists(cache_sha(.data))) { 17 | message("Cache Hit \n\n") 18 | res <- readRDS(file = cache_sha(.data)) 19 | } else { 20 | if (length(self$links) == 0) { 21 | .data <- as.req(.data) 22 | .data$config <- c(httr::user_agent(make_ua()), .data$config, .data$headers) 23 | .data$url <- gather_paths(.data) 24 | .data$query <- if (is.null(.data$query)) NULL else as.list(.data$query) 25 | res <- suppressWarnings(httr::GET(.data$url[1], .data$config, .data$write, 26 | query = .data$query, ...)) 27 | } else { 28 | .data <- as.req(self$links[[1]]$url) 29 | res <- suppressWarnings(httr::GET(.data$url[1], .data$config, .data$write, ...)) 30 | } 31 | # error catching 32 | self$handle_errors(.data, res) 33 | # caching 34 | if (isC(.data)) cache_response(res, cache_sha(.data)) 35 | } 36 | # cache links 37 | self$links <- get_links(res$headers) 38 | # give back result 39 | self$result <- empty(list(self$result, res)) 40 | }, 41 | 42 | POST = function(.data, ...) { 43 | if (length(self$links) == 0) { 44 | .data <- as.req(.data) 45 | .data$config <- c(httr::user_agent(make_ua()), .data$config) 46 | .data$url <- gather_paths(.data) 47 | res <- suppressWarnings(httr::POST(.data$url[1], .data$config, body = .data$body, ...)) 48 | } else { 49 | .data <- as.req(self$links[[1]]$url) 50 | res <- suppressWarnings(httr::POST(.data$url[1], .data$config, ...)) 51 | } 52 | # error catching 53 | self$handle_errors(.data, res) 54 | # cache links 55 | self$links <- get_links(res$headers) 56 | # give back result 57 | self$result <- empty(list(self$result, res)) 58 | }, 59 | 60 | PUT = function(.data, ...) { 61 | if (length(self$links) == 0) { 62 | .data <- as.req(.data) 63 | .data$config <- c(httr::user_agent(make_ua()), .data$config) 64 | .data$url <- gather_paths(.data) 65 | res <- suppressWarnings(httr::PUT(.data$url[1], .data$config, body = .data$body, ...)) 66 | } else { 67 | .data <- as.req(self$links[[1]]$url) 68 | res <- suppressWarnings(httr::PUT(.data$url[1], .data$config, ...)) 69 | } 70 | # error catching 71 | self$handle_errors(.data, res) 72 | # cache links 73 | self$links <- get_links(res$headers) 74 | # give back result 75 | self$result <- empty(list(self$result, res)) 76 | }, 77 | 78 | body = function() { 79 | self$result 80 | }, 81 | 82 | status = function() { 83 | if (is(self$result, "response")) { 84 | self$result$status_code 85 | } else { 86 | lapply(self$result, function(z) { 87 | if (is(z, "response")) { 88 | z$status_code 89 | } else { 90 | NULL 91 | } 92 | }) 93 | } 94 | }, 95 | parse = function(parse = TRUE) { 96 | x <- self$result 97 | if (is(x, "response")) { 98 | httr_parse(x, parse = parse) 99 | } else { 100 | lapply(x, httr_parse, parse = parse) 101 | } 102 | }, 103 | count = function() { 104 | if (is(self$result, "response")) { 105 | length(httr::content(self$result, "text", encoding = "UTF-8")) 106 | } else { 107 | sum(sapply(self$result, function(x) length(httr::content(x, "text", encoding = "UTF-8")))) 108 | } 109 | }, 110 | handle_errors = function(.data, x) { 111 | if (!is.null(.data$retry)) { 112 | i <- 0 113 | while (x$status_code > 201 && i < .data$retry$n) { 114 | i <- i + 1 115 | message("Retrying request\n") 116 | x <- self$GET(.data) 117 | Sys.sleep(.data$retry$time) 118 | } 119 | return(x) 120 | } 121 | if (is.null(.data$error)) { 122 | # httr::stop_for_status(x) 123 | try_error(x) 124 | } else { 125 | .data$error[[1]](x) 126 | } 127 | } 128 | )) 129 | 130 | try_error <- function(x) { 131 | if (x$status_code > 201) { 132 | one <- tryCatch(content(x, "text", encoding = "UTF-8"), error = function(e) e) 133 | if (!is(one, "error")) { 134 | two <- tryCatch(one$error, error = function(e) e) 135 | if (!is(two, "error")) { 136 | msg <- sprintf("%s - %s", x$status_code, two) 137 | } else { 138 | msg <- http_status(x)$message 139 | } 140 | } else { 141 | msg <- http_status(x)$message 142 | } 143 | stop(msg, call. = FALSE) 144 | } 145 | } 146 | 147 | httr_parse <- function(x, parse) { 148 | if (grepl("json", x$headers$`content-type`)) { 149 | if (!is.null(x$request$output$path)) { 150 | return(x$request$output$path) 151 | } else { 152 | txt <- httr::content(x, "text", encoding = "UTF-8") 153 | tmp <- jsonlite::fromJSON(txt, parse, flatten = TRUE) 154 | if (inherits(tmp, "data.frame")) { 155 | tibble::as_tibble(tmp) 156 | } else { 157 | if (inherits(tmp, "list")) { 158 | lapply(tmp, function(z) { 159 | if (inherits(z, "data.frame")) { 160 | tibble::as_tibble(z) 161 | } else { 162 | z 163 | } 164 | }) 165 | } else { 166 | tmp 167 | } 168 | } 169 | } 170 | } else { 171 | content(x, "text", encoding = "UTF-8") 172 | } 173 | } 174 | 175 | # dd <- api('https://api.github.com/') %>% 176 | # api_path(repos, ropensci, rgbif, commits) %>% 177 | # api_paging(limit = 220, limit_max = 100) 178 | # # dd <- api('https://api.github.com/') %>% 179 | # # api_path(repos, ropensci, rplos, commits) %>% 180 | # # api_paging(limit = 220, limit_max = 100) 181 | # rr <- GetIter$new(limit = dd$paging$limit, limit_max = dd$paging$limit_max) 182 | # rr$GET(dd) 183 | # rr$count() 184 | # rr$result 185 | # rr$links 186 | # rr$parse() 187 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | request 2 | ======= 3 | 4 | 5 | 6 | [![cran checks](https://cranchecks.info/badges/worst/request)](https://cranchecks.info/pkgs/request) 7 | [![Build Status](https://travis-ci.org/sckott/request.svg)](https://travis-ci.org/sckott/request) 8 | [![codecov.io](https://codecov.io/github/sckott/request/coverage.svg?branch=master)](https://codecov.io/github/sckott/request?branch=master) 9 | [![rstudio mirror downloads](http://cranlogs.r-pkg.org/badges/request?color=F3B1FF)](https://github.com/metacran/cranlogs.app) 10 | [![cran version](http://www.r-pkg.org/badges/version/request)](https://cran.r-project.org/package=request) 11 | 12 | `request` is DSL for http requests for R, and is inspired by the CLI tool [httpie](https://github.com/jakubroztocil/httpie). 13 | 14 | `request` is built on `httr`, though may allow using the R packages `RCurl` or `curl` as optional backends at some point. 15 | 16 | I gave a poster at User2016, its in my [talks repo](https://github.com/sckott/talks/blob/gh-pages/user2016/request.pdf) 17 | 18 | ## Philosophy 19 | 20 | * The web is increasingly a JSON world, so we assume `applications/json` by default, but give back other types if not 21 | * The workflow follows logically, or at least should, from, _hey, I got this url_, to _i need to add some options_, to _execute request_ 22 | * Whenever possible, we transform output to data.frame's - facilitating downstream manipulation via `dplyr`, etc. 23 | * We do `GET` requests by default. Specify a different type if you don't want `GET` 24 | * You can use non-standard evaluation to easily pass in query parameters without worrying about `&`'s, URL escaping, etc. (see `api_query()`) 25 | * Same for body params (see `api_body()`) 26 | 27 | All of the defaults just mentioned can be changed. 28 | 29 | ## Auto execute http requests with pipes 30 | 31 | When using pipes, we autodetect that a pipe is being used within the function calls, and automatically do the appropriate http request on the last piped function call. When you call a function without using pipes, you have to use the `http()` function explicitly to make the http request. 32 | 33 | ## low level http 34 | 35 | Low level access is available with `http_client()`, which returns an `R6` class with various methods for inspecting http request results. 36 | 37 | ## Peek at a request 38 | 39 | The function `peep()` let's you peek at a request without performing the http request. 40 | 41 | ## Install 42 | 43 | From CRAN 44 | 45 | 46 | ```r 47 | install.packages("request") 48 | ``` 49 | 50 | Development version from GitHub 51 | 52 | 53 | ```r 54 | remotes::install_github("sckott/request") 55 | ``` 56 | 57 | 58 | ```r 59 | library("request") 60 | ``` 61 | 62 | ## NSE and SE 63 | 64 | NSE is supported 65 | 66 | 67 | ```r 68 | api('https://api.github.com/') %>% 69 | api_path(repos, ropensci, rgbif, issues) 70 | ``` 71 | 72 | as well as SE 73 | 74 | 75 | ```r 76 | api('https://api.github.com/') %>% 77 | api_path_('repos', 'ropensci', 'rgbif', 'issues') 78 | ``` 79 | 80 | ## Building API routes 81 | 82 | Works with full or partial URLs 83 | 84 | 85 | ```r 86 | api('https://api.github.com/') 87 | #> URL: https://api.github.com/ 88 | api('http://api.gbif.org/v1') 89 | #> URL: http://api.gbif.org/v1 90 | api('api.gbif.org/v1') 91 | #> URL: http://api.gbif.org/v1 92 | ``` 93 | 94 | Works with ports, full or partial 95 | 96 | 97 | ```r 98 | api('http://localhost:9200') 99 | #> URL: http://localhost:9200 100 | api('localhost:9200') 101 | #> URL: http://localhost:9200 102 | api(':9200') 103 | #> URL: http://localhost:9200 104 | api('9200') 105 | #> URL: http://localhost:9200 106 | api('9200/stuff') 107 | #> URL: http://localhost:9200/stuff 108 | ``` 109 | 110 | ## Make HTTP requests 111 | 112 | The above examples with `api()` are not passed through a pipe, so only define a URL, but don't do an HTTP request. To make an HTTP request, you can either pipe a url or partial url to e.g., `api()`, or call `http()` at the end of a string of function calls: 113 | 114 | 115 | ```r 116 | 'https://api.github.com/' %>% api() 117 | #> $current_user_url 118 | #> [1] "https://api.github.com/user" 119 | #> 120 | #> $current_user_authorizations_html_url 121 | #> [1] "https://github.com/settings/connections/applications{/client_id}" 122 | #> 123 | #> $authorizations_url 124 | #> [1] "https://api.github.com/authorizations" 125 | #> 126 | #> $code_search_url 127 | ... 128 | ``` 129 | 130 | Or 131 | 132 | 133 | ```r 134 | api('https://api.github.com/') %>% http() 135 | #> $current_user_url 136 | #> [1] "https://api.github.com/user" 137 | #> 138 | #> $current_user_authorizations_html_url 139 | #> [1] "https://github.com/settings/connections/applications{/client_id}" 140 | #> 141 | #> $authorizations_url 142 | #> [1] "https://api.github.com/authorizations" 143 | #> 144 | #> $code_search_url 145 | ... 146 | ``` 147 | 148 | `http()` is called at the end of a chain of piped commands, so no need to invoke it. However, you can if you like. 149 | 150 | ## Templating 151 | 152 | 153 | ```r 154 | repo_info <- list(username = 'craigcitro', repo = 'r-travis') 155 | api('https://api.github.com/') %>% 156 | api_template(template = 'repos/{{username}}/{{repo}}/issues', data = repo_info) %>% 157 | peep 158 | #> 159 | #> url: https://api.github.com/ 160 | #> paths: 161 | #> query: 162 | #> body: 163 | #> paging: 164 | #> headers: 165 | #> rate limit: 166 | #> retry (n/delay (s)): / 167 | #> error handler: 168 | #> write: 169 | #> config: 170 | ``` 171 | 172 | ## Set paths 173 | 174 | `api_path()` adds paths to the base URL (see `api_query()`) for query parameters 175 | 176 | 177 | ```r 178 | api('https://api.github.com/') %>% 179 | api_path(repos, ropensci, rgbif, issues) %>% 180 | peep 181 | #> 182 | #> url: https://api.github.com/ 183 | #> paths: repos/ropensci/rgbif/issues 184 | #> query: 185 | #> body: 186 | #> paging: 187 | #> headers: 188 | #> rate limit: 189 | #> retry (n/delay (s)): / 190 | #> error handler: 191 | #> write: 192 | #> config: 193 | ``` 194 | 195 | ## Query 196 | 197 | 198 | ```r 199 | api("http://api.plos.org/search") %>% 200 | api_query(q = ecology, wt = json, fl = 'id,journal') %>% 201 | peep 202 | #> 203 | #> url: http://api.plos.org/search 204 | #> paths: 205 | #> query: q=ecology, wt=json, fl=id,journal 206 | #> body: 207 | #> paging: 208 | #> headers: 209 | #> rate limit: 210 | #> retry (n/delay (s)): / 211 | #> error handler: 212 | #> write: 213 | #> config: 214 | ``` 215 | 216 | ## ToDo 217 | 218 | See [the issues](https://github.com/sckott/request/issues) for discussion of these 219 | 220 | * Paging 221 | * Retry 222 | * Rate limit 223 | 224 | ## Meta 225 | 226 | * Please note that this project is released with a [Contributor Code of Conduct][coc]. By participating in this project you agree to abide by its terms. 227 | 228 | [coc]: https://github.com/sckott/request/blob/master/.github/CODE_OF_CONDUCT.md 229 | --------------------------------------------------------------------------------