1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287
|
#' @title HTTP request object
#' @description Create HTTP requests
#'
#' @export
#' @family async
#' @template args
#' @template r6
#' @param path URL path, appended to the base URL
#' @param query query terms, as a named list
#' @param body body as an R list
#' @param encode one of form, multipart, json, or raw
#' @param disk a path to write to. if NULL (default), memory used.
#' See [curl::curl_fetch_disk()] for help.
#' @param stream an R function to determine how to stream data. if
#' NULL (default), memory used. See [curl::curl_fetch_stream()]
#' for help
#' @param ... curl options, only those in the acceptable set from
#' [curl::curl_options()] except the following: httpget, httppost, post,
#' postfields, postfieldsize, and customrequest
#' @seealso [http-headers], [writing-options]
#' @details This R6 class doesn't do actual HTTP requests as does
#' [HttpClient()] - it is for building requests to use for async HTTP
#' requests in [AsyncVaried()]
#'
#' Note that you can access HTTP verbs after creating an `HttpRequest`
#' object, just as you can with `HttpClient`. See examples for usage.
#'
#' Also note that when you call HTTP verbs on a `HttpRequest` object you
#' don't need to assign the new object to a variable as the new details
#' you've added are added to the object itself.
#'
#' See [HttpClient()] for information on parameters.
#'
#' @examples \dontrun{
#' x <- HttpRequest$new(url = "https://httpbin.org/get")
#' ## note here how the HTTP method is shown on the first line to the right
#' x$get()
#'
#' ## assign to a new object to keep the output
#' z <- x$get()
#' ### get the HTTP method
#' z$method()
#'
#' (x <- HttpRequest$new(url = "https://httpbin.org/get")$get())
#' x$url
#' x$payload
#'
#' (x <- HttpRequest$new(url = "https://httpbin.org/post"))
#' x$post(body = list(foo = "bar"))
#'
#' HttpRequest$new(
#' url = "https://httpbin.org/get",
#' headers = list(
#' `Content-Type` = "application/json"
#' )
#' )
#' }
HttpRequest <- R6::R6Class(
'HttpRequest',
public = list(
#' @field url (character) a url
url = NULL,
#' @field opts (list) named list of curl options
opts = list(),
#' @field proxies a [proxy()] object
proxies = list(),
#' @field auth an [auth()] object
auth = list(),
#' @field headers (list) named list of headers, see [http-headers]
headers = list(),
#' @field handle a [handle()]
handle = NULL,
#' @field progress only supports `httr::progress()`, see [progress]
progress = NULL,
#' @field payload resulting payload after request
payload = NULL,
#' @description print method for `HttpRequest` objects
#' @param x self
#' @param ... ignored
print = function(x, ...) {
cat(paste0("<crul http request> ", self$method()), sep = "\n")
# cat(paste0(" url: ", if (is.null(self$url))
# self$handle$url else self$url), sep = "\n")
cat(paste0(" url: ",
self$payload$url$url %||% self$handle$url %||% self$url), sep = "\n")
cat(" curl options: ", sep = "\n")
for (i in seq_along(self$opts)) {
z <- if (inherits(self$opts[[i]], "function")) "<function>" else self$opts[[i]]
cat(sprintf(" %s: %s", names(self$opts)[i], z), sep = "\n")
# cat(sprintf(" %s: %s", names(self$opts)[i],
# self$opts[[i]]), sep = "\n")
}
cat(" proxies: ", sep = "\n")
if (length(self$proxies)) cat(paste(" -",
purl(self$proxies)), sep = "\n")
cat(" auth: ", sep = "\n")
if (length(self$auth$userpwd)) {
cat(paste(" -", self$auth$userpwd), sep = "\n")
cat(paste(" - type: ", self$auth$httpauth), sep = "\n")
}
cat(" headers: ", sep = "\n")
for (i in seq_along(self$headers)) {
cat(sprintf(" %s: %s", names(self$headers)[i],
self$headers[[i]]), sep = "\n")
}
cat(paste0(" progress: ", !is.null(self$progress)), sep = "\n")
invisible(self)
},
#' @description Create a new `HttpRequest` object
#' @param urls (character) one or more URLs
#' @param opts any curl options
#' @param proxies a [proxy()] object
#' @param auth an [auth()] object
#' @param headers named list of headers, see [http-headers]
#' @param handle a [handle()]
#' @param progress only supports `httr::progress()`, see [progress]
#' @return A new `HttpRequest` object
initialize = function(url, opts, proxies, auth, headers, handle, progress) {
if (!missing(url)) self$url <- url
# curl options: check for set_opts first
if (!is.null(crul_opts$opts)) self$opts <- crul_opts$opts
if (!missing(opts)) self$opts <- opts %||% list()
# proxy: check for set_proxy first
if (!is.null(crul_opts$proxies)) self$proxies <- crul_opts$proxies
if (!missing(proxies)) {
if (!inherits(proxies, "proxy") && !is.null(proxies)) {
stop("proxies input must be of class proxy", call. = FALSE)
}
self$proxies <- proxies %||% list()
}
# auth: check for set_auth first
if (!is.null(crul_opts$auth)) self$auth <- crul_opts$auth
if (!missing(auth)) self$auth <- auth %||% list()
# progress
if (!missing(progress)) {
assert(progress, "request")
self$progress <- progress$options
}
# headers: check for set_headers first
if (!is.null(crul_opts$headers)) self$headers <- crul_opts$headers
if (!missing(headers)) self$headers <- headers %||% list()
if (!missing(handle)) self$handle <- handle
if (is.null(self$url) && is.null(self$handle)) {
stop("need one of url or handle", call. = FALSE)
}
},
#' @description Define a GET request
get = function(path = NULL, query = list(), disk = NULL,
stream = NULL, ...) {
curl_opts_check(...)
url <- make_url_async(self$url, self$handle, path, query)
rr <- list(
url = url,
method = "get",
options = ccp(list(httpget = TRUE)),
headers = def_head()
)
rr$headers <- norm_headers(rr$headers, self$headers)
rr$options <- utils::modifyList(
rr$options, c(self$opts, self$proxies, self$auth, self$progress, ...))
rr$disk <- disk
rr$stream <- stream
self$payload <- rr
return(self)
},
#' @description Define a POST request
post = function(path = NULL, query = list(), body = NULL, disk = NULL,
stream = NULL, encode = "multipart", ...) {
curl_opts_check(...)
url <- make_url_async(self$url, self$handle, path, query)
opts <- prep_body(body, encode)
rr <- prep_opts("post", url, self, opts, ...)
rr$disk <- disk
rr$stream <- stream
self$payload <- rr
return(self)
},
#' @description Define a PUT request
put = function(path = NULL, query = list(), body = NULL, disk = NULL,
stream = NULL, encode = "multipart", ...) {
curl_opts_check(...)
url <- make_url_async(self$url, self$handle, path, query)
opts <- prep_body(body, encode)
rr <- prep_opts("put", url, self, opts, ...)
rr$disk <- disk
rr$stream <- stream
self$payload <- rr
return(self)
},
#' @description Define a PATCH request
patch = function(path = NULL, query = list(), body = NULL, disk = NULL,
stream = NULL, encode = "multipart", ...) {
curl_opts_check(...)
url <- make_url_async(self$url, self$handle, path, query)
opts <- prep_body(body, encode)
rr <- prep_opts("patch", url, self, opts, ...)
rr$disk <- disk
rr$stream <- stream
self$payload <- rr
return(self)
},
#' @description Define a DELETE request
delete = function(path = NULL, query = list(), body = NULL, disk = NULL,
stream = NULL, encode = "multipart", ...) {
curl_opts_check(...)
url <- make_url_async(self$url, self$handle, path, query)
opts <- prep_body(body, encode)
rr <- prep_opts("delete", url, self, opts, ...)
rr$disk <- disk
rr$stream <- stream
self$payload <- rr
return(self)
},
#' @description Define a HEAD request
head = function(path = NULL, ...) {
curl_opts_check(...)
url <- make_url_async(self$url, self$handle, path, NULL)
opts <- list(customrequest = "HEAD", nobody = TRUE)
rr <- list(
url = url,
method = "head",
options = ccp(opts),
headers = self$headers
)
rr$options <- utils::modifyList(rr$options,
c(self$opts, self$proxies, ...))
self$payload <- rr
return(self)
},
#' @description Use an arbitrary HTTP verb supported on this class
#' Supported verbs: get, post, put, patch, delete, head
#' @param verb an HTTP verb supported on this class: get,
#' post, put, patch, delete, head. Also supports retry.
#' @examples
#' z <- HttpRequest$new(url = "https://httpbin.org/get")
#' res <- z$verb('get', query = list(hello = "world"))
#' res$payload
verb = function(verb, ...) {
stopifnot(is.character(verb), length(verb) > 0)
verbs <- c('get', 'post', 'put', 'patch', 'delete', 'head')
if (!tolower(verb) %in% verbs) stop("'verb' must be one of: ", paste0(verbs, collapse = ", "))
verbFunc <- self[[tolower(verb)]]
stopifnot(is.function(verbFunc))
verbFunc(...)
},
#' @description Get the HTTP method (if defined)
#' @return (character) the HTTP method
method = function() self$payload$method
)
)
make_url_async <- function(url = NULL, handle = NULL, path, query) {
if (!is.null(handle)) {
url <- handle$url
}
if (!is.null(path)) {
urltools::path(url) <- path
}
url <- gsub("\\s", "%20", url)
url <- add_query(query, url)
if (!is.null(handle)) {
curl::handle_setopt(handle$handle, url = url)
} else {
handle <- curl::new_handle(url = url)
}
return(list(url = url, handle = handle))
}
|