Permalink
Join GitHub today
GitHub is home to over 28 million developers working together to host and review code, manage projects, and build software together.
Sign up
a99126c
Dec 4, 2018
peterdesmet
gaborcsardi
bbrewington
| #' Extract status code from response. | |
| #' | |
| #' @param x A response | |
| #' @export | |
| status_code <- function(x) UseMethod("status_code") | |
| #' @export | |
| status_code.response <- function(x) x$status_code | |
| #' @export | |
| status_code.numeric <- function(x) x | |
| #' Give information on the status of a request. | |
| #' | |
| #' Extract the http status code and convert it into a human readable message. | |
| #' | |
| #' http servers send a status code with the response to each request. This code | |
| #' gives information regarding the outcome of the execution of the request | |
| #' on the server. Roughly speaking, codes in the 100s and 200s mean the request | |
| #' was successfully executed; codes in the 300s mean the page was redirected; | |
| #' codes in the 400s mean there was a mistake in the way the client sent the | |
| #' request; codes in the 500s mean the server failed to fulfill | |
| #' an apparently valid request. More details on the codes can be found at | |
| #' `http://en.wikipedia.org/wiki/Http_error_codes`. | |
| #' | |
| #' @param x a request object or a number. | |
| #' @return If the status code does not match a known status, an error. | |
| #' Otherwise, a list with components | |
| #' \item{category}{the broad category of the status} | |
| #' \item{message}{the meaning of the status code} | |
| #' @family response methods | |
| #' @examples | |
| #' http_status(100) | |
| #' http_status(404) | |
| #' | |
| #' x <- GET("http://httpbin.org/status/200") | |
| #' http_status(x) | |
| #' | |
| #' http_status(GET("http://httpbin.org/status/300")) | |
| #' http_status(GET("http://httpbin.org/status/301")) | |
| #' http_status(GET("http://httpbin.org/status/404")) | |
| #' | |
| #' # errors out on unknown status | |
| #' \dontrun{ | |
| #' http_status(GET("http://httpbin.org/status/320")) | |
| #' } | |
| #' @export | |
| http_status <- function(x) { | |
| status <- status_code(x) | |
| status_desc <- http_statuses[[as.character(status)]] | |
| if (is.na(status_desc)) { | |
| stop("Unknown http status code: ", status, call. = FALSE) | |
| } | |
| status_types <- c( | |
| "Information", "Success", "Redirection", "Client error", | |
| "Server error" | |
| ) | |
| status_type <- status_types[[status %/% 100]] | |
| # create the final information message | |
| message <- paste(status_type, ": (", status, ") ", status_desc, sep = "") | |
| list( | |
| category = status_type, | |
| reason = status_desc, | |
| message = message | |
| ) | |
| } | |
| http_statuses <- c( | |
| "100" = "Continue", | |
| "101" = "Switching Protocols", | |
| "102" = "Processing (WebDAV; RFC 2518)", | |
| "200" = "OK", | |
| "201" = "Created", | |
| "202" = "Accepted", | |
| "203" = "Non-Authoritative Information", | |
| "204" = "No Content", | |
| "205" = "Reset Content", | |
| "206" = "Partial Content", | |
| "207" = "Multi-Status (WebDAV; RFC 4918)", | |
| "208" = "Already Reported (WebDAV; RFC 5842)", | |
| "226" = "IM Used (RFC 3229)", | |
| "300" = "Multiple Choices", | |
| "301" = "Moved Permanently", | |
| "302" = "Found", | |
| "303" = "See Other", | |
| "304" = "Not Modified", | |
| "305" = "Use Proxy", | |
| "306" = "Switch Proxy", | |
| "307" = "Temporary Redirect", | |
| "308" = "Permanent Redirect (experimental Internet-Draft)", | |
| "400" = "Bad Request", | |
| "401" = "Unauthorized", | |
| "402" = "Payment Required", | |
| "403" = "Forbidden", | |
| "404" = "Not Found", | |
| "405" = "Method Not Allowed", | |
| "406" = "Not Acceptable", | |
| "407" = "Proxy Authentication Required", | |
| "408" = "Request Timeout", | |
| "409" = "Conflict", | |
| "410" = "Gone", | |
| "411" = "Length Required", | |
| "412" = "Precondition Failed", | |
| "413" = "Request Entity Too Large", | |
| "414" = "Request-URI Too Long", | |
| "415" = "Unsupported Media Type", | |
| "416" = "Requested Range Not Satisfiable", | |
| "417" = "Expectation Failed", | |
| "418" = "I'm a teapot (RFC 2324)", | |
| "420" = "Enhance Your Calm (Twitter)", | |
| "422" = "Unprocessable Entity (WebDAV; RFC 4918)", | |
| "423" = "Locked (WebDAV; RFC 4918)", | |
| "424" = "Failed Dependency (WebDAV; RFC 4918)", | |
| "424" = "Method Failure (WebDAV)", | |
| "425" = "Unordered Collection (Internet draft)", | |
| "426" = "Upgrade Required (RFC 2817)", | |
| "428" = "Precondition Required (RFC 6585)", | |
| "429" = "Too Many Requests (RFC 6585)", | |
| "431" = "Request Header Fields Too Large (RFC 6585)", | |
| "444" = "No Response (Nginx)", | |
| "449" = "Retry With (Microsoft)", | |
| "450" = "Blocked by Windows Parental Controls (Microsoft)", | |
| "451" = "Unavailable For Legal Reasons (Internet draft)", | |
| "499" = "Client Closed Request (Nginx)", | |
| "500" = "Internal Server Error", | |
| "501" = "Not Implemented", | |
| "502" = "Bad Gateway", | |
| "503" = "Service Unavailable", | |
| "504" = "Gateway Timeout", | |
| "505" = "HTTP Version Not Supported", | |
| "506" = "Variant Also Negotiates (RFC 2295)", | |
| "507" = "Insufficient Storage (WebDAV; RFC 4918)", | |
| "508" = "Loop Detected (WebDAV; RFC 5842)", | |
| "509" = "Bandwidth Limit Exceeded (Apache bw/limited extension)", | |
| "510" = "Not Extended (RFC 2774)", | |
| "511" = "Network Authentication Required (RFC 6585)", | |
| "598" = "Network read timeout error (Unknown)", | |
| "599" = "Network connect timeout error (Unknown)" | |
| ) | |
| #' Check for an http error. | |
| #' | |
| #' @param x Object to check. Default methods are provided for strings | |
| #' (which perform an [HEAD()] request), responses, and | |
| #' integer status codes. | |
| #' @param ... Other arguments passed on to methods. | |
| #' @return `TRUE` if the request fails (status code 400 or above), | |
| #' otherwise `FALSE`. | |
| #' @export | |
| #' @family response methods | |
| #' @examples | |
| #' # You can pass a url: | |
| #' http_error("http://www.google.com") | |
| #' http_error("http://httpbin.org/status/404") | |
| #' | |
| #' # Or a request | |
| #' r <- GET("http://httpbin.org/status/201") | |
| #' http_error(r) | |
| #' | |
| #' # Or an (integer) status code | |
| #' http_error(200L) | |
| #' http_error(404L) | |
| http_error <- function(x, ...) { | |
| UseMethod("http_error") | |
| } | |
| #' @export | |
| http_error.character <- function(x, ...) { | |
| http_error(HEAD(x, ...)) | |
| } | |
| #' @export | |
| http_error.response <- function(x, ...) { | |
| http_error(status_code(x)) | |
| } | |
| #' @export | |
| http_error.integer <- function(x, ...) { | |
| x >= 400L | |
| } | |
| #' @export | |
| #' @rdname http_error | |
| #' @usage NULL | |
| url_success <- function(x, ...) { | |
| warning( | |
| "`url_success(x)` is deprecated; please use `!http_error(x)` instead.", | |
| call. = FALSE | |
| ) | |
| !http_error(x, ...) | |
| } | |
| #' @export | |
| #' @rdname http_error | |
| #' @usage NULL | |
| url_ok <- function(x, ...) { | |
| warning( | |
| "`url_ok(x)` is deprecated; ", | |
| "please use `identical(status_code(x), 200L)` instead.", | |
| call. = FALSE | |
| ) | |
| identical(status_code(HEAD(x, ...)), 200L) | |
| } | |
| #' Take action on http error. | |
| #' | |
| #' Converts http errors to R errors or warnings - these should always | |
| #' be used whenever you're creating requests inside a function, so | |
| #' that the user knows why a request has failed. | |
| #' | |
| #' @return If request was successful, the response (invisibly). Otherwise, | |
| #' raised a classed http error or warning, as generated by | |
| #' [http_condition()] | |
| #' @inheritParams http_condition | |
| #' @seealso [http_status()] and | |
| #' `http://en.wikipedia.org/wiki/Http_status_codes` for more information | |
| #' on http status codes. | |
| #' @family response methods | |
| #' @examples | |
| #' x <- GET("http://httpbin.org/status/200") | |
| #' stop_for_status(x) # nothing happens | |
| #' warn_for_status(x) | |
| #' message_for_status(x) | |
| #' | |
| #' x <- GET("http://httpbin.org/status/300") | |
| #' \dontrun{ | |
| #' stop_for_status(x) | |
| #' } | |
| #' warn_for_status(x) | |
| #' message_for_status(x) | |
| #' | |
| #' x <- GET("http://httpbin.org/status/404") | |
| #' \dontrun{ | |
| #' stop_for_status(x) | |
| #' } | |
| #' warn_for_status(x) | |
| #' message_for_status(x) | |
| #' | |
| #' # You can provide more information with the task argument | |
| #' warn_for_status(x, "download spreadsheet") | |
| #' message_for_status(x, "download spreadsheet") | |
| #' @export | |
| stop_for_status <- function(x, task = NULL) { | |
| if (status_code(x) < 300) { | |
| return(invisible(x)) | |
| } | |
| call <- sys.call(-1) | |
| stop(http_condition(x, "error", task = task, call = call)) | |
| } | |
| #' @rdname stop_for_status | |
| #' @export | |
| warn_for_status <- function(x, task = NULL) { | |
| if (status_code(x) < 300) { | |
| return(invisible(x)) | |
| } | |
| call <- sys.call(-1) | |
| warning(http_condition(x, "warning", task = task, call = call)) | |
| } | |
| #' @rdname stop_for_status | |
| #' @export | |
| message_for_status <- function(x, task = NULL) { | |
| call <- sys.call(-1) | |
| message(http_condition(x, "message", task = task, call = call)) | |
| } | |
| #' Generate a classed http condition. | |
| #' | |
| #' This function generate S3 condition objects which are passed to | |
| #' [stop()] or [warning()] to generate classes warnings | |
| #' and error. These can be used in conjunction with [tryCatch()] | |
| #' to respond differently to different type of failure. | |
| #' | |
| #' @keywords internal | |
| #' @return An S3 object that inherits from (e.g.) condition, `type`, | |
| #' http_error, http_400 and http_404. | |
| #' @param x a response, or numeric http code (or other object with | |
| #' `status_code` method) | |
| #' @param type type of condition to generate. Must be one of error, | |
| #' warning or message. | |
| #' @param task The text of the message: either `NULL` or a | |
| #' character vector. If non-`NULL`, the error message will finish with | |
| #' "Failed to `task`". | |
| #' @param call The call stored in the condition object. | |
| #' @seealso | |
| #' <http://adv-r.had.co.nz/Exceptions-Debugging.html#condition-handling> | |
| #' for more details about R's condition handling model | |
| #' @export | |
| #' @examples | |
| #' # You can use tryCatch to take different actions based on the type | |
| #' # of error. Note that tryCatch will call the first handler that | |
| #' # matches any classes of the condition, not the best matching, so | |
| #' # always list handlers from most specific to least specific | |
| #' f <- function(url) { | |
| #' tryCatch(stop_for_status(GET(url)), | |
| #' http_404 = function(c) "That url doesn't exist", | |
| #' http_403 = function(c) "You need to authenticate!", | |
| #' http_400 = function(c) "You made a mistake!", | |
| #' http_500 = function(c) "The server screwed up" | |
| #' ) | |
| #' } | |
| #' f("http://httpbin.org/status/404") | |
| #' f("http://httpbin.org/status/403") | |
| #' f("http://httpbin.org/status/505") | |
| http_condition <- function(x, type, task = NULL, call = sys.call(-1)) { | |
| type <- match.arg(type, c("error", "warning", "message")) | |
| if (is.null(task)) { | |
| task <- "" | |
| } else if (is.character(task)) { | |
| task <- paste0(" Failed to ", task, ".") | |
| } else { | |
| stop("`task` must be NULL or a character vector", call. = FALSE) | |
| } | |
| status <- status_code(x) | |
| reason <- http_status(status)$reason | |
| message <- sprintf("%s (HTTP %d).%s", reason, status, task) | |
| status_type <- (status %/% 100) * 100 | |
| http_class <- paste0("http_", unique(c(status, status_type, "error"))) | |
| structure( | |
| list(message = message, call = call), | |
| class = c(http_class, type, "condition") | |
| ) | |
| } |