Use cli::cli_abort()

Fixes #292

R/curl.R

@@ -36,7 +36,7 @@ curl_translate <- function(cmd, simplify_headers = TRUE) {
       cmd <- clipr::read_clip()
       cmd <- paste0(cmd, collapse = "\n")
     } else {
-      abort("Must supply `cmd`")
+      cli::cli_abort("Must supply {.arg cmd}.")
     }
   } else {
     check_string(cmd)
@@ -103,10 +103,12 @@ curl_translate_eval <- function(cmd, env = caller_env()) {
   eval(parse_expr(code), envir = env)
 }
 
-curl_normalize <- function(cmd) {
+curl_normalize <- function(cmd, error_call = caller_env()) {
   args <- curl_args(cmd)
 
-  url <- args[["--url"]] %||% args[["<url>"]] %||% abort("Must supply url")
+  url <- args[["--url"]] %||%
+    args[["<url>"]] %||%
+    cli::cli_abort("Must supply url.", call = error_call)
 
   if (has_name(args, "--header")) {
     headers <- as_headers(args[["--header"]])
@@ -216,12 +218,15 @@ curl_opts <- "Usage: curl [<url>] [-H <header> ...] [options] [<url>]
   -v, --verbose                Make the operation more talkative
 "
 
-curl_args <- function(cmd) {
+curl_args <- function(cmd, error_call = caller_env()) {
   check_installed("docopt")
 
   pieces <- parse_in_half(cmd, " ")
   if (pieces[[1]] != "curl") {
-    abort(glue("Expecting call to curl not '{pieces[[1]]}'"))
+    cli::cli_abort(
+      "Expecting call to curl not {.str {pieces[[1]]}}",
+      call = error_call
+    )
   }
   if (grepl("'", cmd)) {
     args <- parse_delim(pieces[[2]], " ", quote = "'")

R/headers.R

@@ -13,16 +13,19 @@ as_headers <- function(x, error_call = caller_env()) {
   } else if (is.list(x)) {
     new_headers(x, error_call = error_call)
   } else {
-    abort("`headers` must be a list, character vector, or raw", call = error_call)
+    cli::cli_abort(
+      "`headers` must be a list, character vector, or raw.",
+      call = error_call
+    )
   }
 }
 
 new_headers <- function(x, error_call = caller_env()) {
   if (!is_list(x)) {
-    abort("`x` must be a list", call = error_call)
+    cli::cli_abort("{.arg x} must be a list.", call = error_call)
   }
   if (length(x) > 0 && !is_named(x)) {
-    abort("All elements of `x` must be named", call = error_call)
+    cli::cli_abort("All elements of {.arg x} must be named.", call = error_call)
   }
 
   structure(x, class = "httr2_headers")

R/multi-req.R

@@ -59,7 +59,7 @@
 multi_req_perform <- function(reqs, paths = NULL, pool = NULL, cancel_on_error = FALSE) {
   if (!is.null(paths)) {
     if (length(reqs) != length(paths)) {
-      abort("If supplied, `paths` must be the same length as `req`")
+      cli::cli_abort("If supplied, {.arg paths} must be the same length as {.arg req}.")
     }
   }
 

R/oauth-client.R

@@ -60,19 +60,19 @@ oauth_client <- function(
     auth <- arg_match(auth)
 
     if (auth == "header" && is.null(secret)) {
-      abort("`auth = 'header' requires a `secret`")
+      cli::cli_abort("{.code auth = 'header'} requires a {.arg secret}.")
     } else if (auth == "jwt_sig") {
       if (is.null(key)) {
-        abort("`auth = 'jwt_sig' requires a `key`")
+        cli::cli_abort("{.code auth = 'jwt_sig'} requires a {.arg key}.")
       }
       if (!has_name(auth_params, "claim")) {
-        abort("`auth = 'jwt_sig' requires a claim specification in `auth_params`")
+        cli::cli_abort("{.code auth = 'jwt_sig'} requires a claim specification in {.arg auth_params}.")
       }
     }
 
     auth <- paste0("oauth_client_req_auth_", auth)
   } else if (!is_function(auth)) {
-    abort("`auth` must be a string or function")
+    cli::cli_abort("{.arg auth} must be a string or function.")
   }
 
   structure(
@@ -204,21 +204,31 @@ oauth_client_req_auth_jwt_sig <- function(req, client, claim, size = 256, header
 
 oauth_flow_check <- function(flow, client,
                              is_confidential = FALSE,
-                             interactive = FALSE) {
+                             interactive = FALSE,
+                             error_call = caller_env()) {
 
   if (!inherits(client, "httr2_oauth_client")) {
-    abort("`client` must be an OAuth client created with `oauth_client()`")
+    cli::cli_abort(
+      "{.arg client} must be an OAuth client created with {.fn oauth_client}.",
+      call = error_call
+    )
   }
 
   if (is_confidential && is.null(client$secret) && is.null(client$key)) {
-    abort(c(
-      glue("Can't use this `app` with OAuth 2.0 {flow} flow"),
-      "`app` must have a confidential client (i.e. `client_secret` is required)"
-    ))
+    cli::cli_abort(
+      c(
+        "Can't use this {.arg app} with OAuth 2.0 {flow} flow.",
+        i = "{.arg app} must have a confidential client (i.e. {.arg client_secret} is required)."
+      ),
+      call = error_call
+    )
   }
 
   if (interactive && !is_interactive()) {
-    abort(glue("OAuth 2.0 {flow} flow requires an interactive session"))
+    cli::cli_abort(
+      "OAuth 2.0 {flow} flow requires an interactive session",
+      call = error_call
+    )
   }
 }
 

R/oauth-flow-auth-code.R

@@ -245,7 +245,7 @@ oauth_flow_auth_code_listen <- function(host_ip = "127.0.0.1", port = 1410) {
   httpuv::service() # send data back to client
 
   if (is.null(info)) {
-    abort("Authentication failed; invalid url from server.")
+    cli::cli_abort("Authentication failed; invalid url from server.")
   }
 
   info
@@ -265,15 +265,15 @@ parse_form_urlencoded <- function(query) {
 #' @export
 #' @rdname oauth_flow_auth_code
 #' @param query List of query parameters returned by `oauth_flow_auth_code_listen()`.
-oauth_flow_auth_code_parse <- function(query, state) {
+oauth_flow_auth_code_parse <- function(query, state, error_call = caller_env()) {
   if (has_name(query, "error")) {
     # https://datatracker.ietf.org/doc/html/rfc6749#section-4.1.2.1
     # Never see problems with redirect_uri
     oauth_flow_abort(query$error, query$error_description, query$error_uri)
   }
 
   if (query$state != state) {
-    abort("Authentication failure: state does not match")
+    cli::cli_abort("Authentication failure: state does not match.")
   }
 
   query$code

R/oauth-flow-device.R

@@ -87,7 +87,7 @@ oauth_flow_device <- function(client,
 
   token <- oauth_flow_device_poll(client, request, token_params)
   if (is.null(token)) {
-    abort("Expired without user confirmation; please try again.")
+    cli::cli_abort("Expired without user confirmation; please try again.")
   }
 
   exec(oauth_token, !!!token)

R/oauth-flow-jwt.R

@@ -64,15 +64,15 @@ oauth_flow_bearer_jwt <- function(client,
                                   token_params = list()) {
   check_installed("jose")
   if (is.null(client$key)) {
-    abort("JWT flow requires `client` with a key")
+    cli::cli_("JWT flow requires {.arg client} with a key.")
   }
 
   if (is_list(claim)) {
     claim <- exec("jwt_claim", !!!claim)
   } else if (is.function(claim)) {
     claim <- claim()
   } else {
-    abort("`claim` must be result a list or function")
+    cli::cli_abort("{.arg claim} must be result a list or function.")
   }
 
   jwt <- exec(signature, claim = claim, key = client$key, !!!signature_params)

R/oauth-flow.R

@@ -22,7 +22,7 @@ oauth_flow_fetch <- function(req) {
     oauth_flow_abort(body$error, body$error_description, body$error_uri)
   } else {
     resp_check_status(resp)
-    abort("Failed to process response from 'token' endpoint")
+    cli::cli_abort("Failed to process response from {.str token} endpoint.")
   }
 
 }
@@ -32,15 +32,18 @@ oauth_flow_fetch <- function(req) {
 # https://datatracker.ietf.org/doc/html/rfc6749#section-5.2
 #
 # TODO: automatically fill in description from text in RFC?
-oauth_flow_abort <- function(error, description = NULL, uri = NULL) {
-  message <- c(
-    glue("OAuth failure [{error}]"),
-    description,
-    i = if (!is.null(uri)) glue("Learn more at <{uri}>")
-  )
-  abort(
-    message,
+oauth_flow_abort <- function(error,
+                             description = NULL,
+                             uri = NULL,
+                             erorr_call = caller_env()) {
+  cli::cli_abort(
+    c(
+      "OAuth failure [{error}]",
+      description,
+      i = if (!is.null(uri)) "Learn more at {.url uri}."
+    ),
     code = error,
-    class = c(glue("httr2_oauth_{error}"), "httr2_oauth")
+    class = c(glue("httr2_oauth_{error}"), "httr2_oauth"),
+    call = error_call
   )
 }

R/req-body.R

@@ -53,7 +53,7 @@ NULL
 req_body_raw <- function(req, body, type = NULL) {
   check_request(req)
   if (!is.raw(body) && !is_string(body)) {
-    abort("`body` must be a raw vector or string")
+    cli::cli_abort("{.arg body} must be a raw vector or string.")
   }
 
   req_body(req, data = body, type = "raw", content_type = type %||% "")
@@ -67,7 +67,7 @@ req_body_raw <- function(req, body, type = NULL) {
 req_body_file <- function(req, path, type = NULL) {
   check_request(req)
   if (!file.exists(path)) {
-    abort("`path` does not exist")
+    cli::cli_abort("{.arg path} does not exist.")
   }
 
   # Need to override default content-type "application/x-www-form-urlencoded"
@@ -228,7 +228,7 @@ req_body_apply <- function(req) {
     content_type <- "application/x-www-form-urlencoded"
     req <- req_body_apply_raw(req, query_build(data))
   } else {
-    abort("Unsupported request body `type`", .internal = TRUE)
+    cli::cli_abort("Unsupported request body {.arg type}.", .internal = TRUE)
   }
 
   # Must set header afterwards

R/req-error.R

@@ -104,8 +104,8 @@ error_body <- function(req, resp, call = caller_env()) {
   try_fetch(
     req_policy_call(req, "error_body", list(resp), default = NULL),
     error = function(cnd) {
-      abort(
-        "Failed to parse error body with method defined in req_error()",
+      cli::cli_abort(
+        "Failed to parse error body with method defined in {.fn req_error}.",
         parent = cnd,
         call = call
       )

R/req-options.R

@@ -78,7 +78,7 @@ req_timeout <- function(req, seconds) {
   check_number_decimal(seconds)
 
   if (seconds < 0.001) {
-    abort("`timeout` must be >1 ms")
+    cli::cli_abort("{.arg timeout} must be >1 ms.")
   }
   req_options(req, timeout_ms = seconds * 1000)
 }

R/req-perform.R

@@ -175,7 +175,7 @@ req_perform1 <- function(req, path = NULL, handle = NULL) {
 
 req_verbosity <- function(req, verbosity, error_call = caller_env()) {
   if (!is_integerish(verbosity, n = 1) || verbosity < 0 || verbosity > 3) {
-    abort("`verbosity` must 0, 1, 2, or 3", call = error_call)
+    cli::cli_abort("{.arg verbosity} must 0, 1, 2, or 3.", call = error_call)
   }
 
   switch(verbosity + 1,

R/req-policy.R

@@ -27,7 +27,10 @@ as_callback <- function(x, n, name, error_call = caller_env()) {
 
   x <- as_function(x)
   if (!inherits(x, "rlang_lambda_function") && length(formals(x)) != n) {
-    abort(glue("Callback {name}() must have {n} argument"), call = error_call)
+    cli::cli_abort(
+      "Callback {name}() must have {n} argument{?s}",
+      call = error_call
+    )
   }
   x
 }

R/req-template.R

@@ -44,15 +44,15 @@ req_template <- function(req, template, ..., .env = parent.frame()) {
     req <- req_method(req, pieces[[1]])
     template <- pieces[[2]]
   } else {
-    abort(c(
-      "Can't parse template `template`",
-      i = "Should have form like 'GET /a/b/c' or 'a/b/c/'"
+    cli::cli_abort(c(
+      "Can't parse template {.arg template}.",
+      i = "Should have form like 'GET /a/b/c' or 'a/b/c/'."
     ))
   }
 
   dots <- list2(...)
   if (length(dots) > 0 && !is_named(dots)) {
-    abort("All elements of ... must be named")
+    cli::cli_abort("All elements of {.arg ...} must be named.")
   }
 
   path <- template_process(template, dots, .env)
@@ -83,11 +83,17 @@ template_val <- function(name, dots, env, error_call = caller_env()) {
   } else if (env_has(env, name, inherit = TRUE)) {
     val <- env_get(env, name, inherit = TRUE)
   } else {
-    abort(glue("Can't find template variable '{name}'"), call = error_call)
+    cli::cli_abort(
+      "Can't find template variable {.str {name}}.",
+      call = error_call
+    )
   }
 
   if (!is.atomic(val) || length(val) != 1) {
-    abort(glue("Template variable '{name}' is not a simple scalar value"), call = error_call)
+    cli::cli_abort(
+      "Template variable {.str {name}} is not a simple scalar value.",
+      call = error_call
+    )
   }
   as.character(val)
 }

R/resp-body.R

@@ -34,7 +34,7 @@ resp_body_raw <- function(resp) {
   check_response(resp)
 
   if (!resp_has_body(resp)) {
-    abort("Can not retrieve empty body")
+    cli::cli_abort("Can't retrieve empty body.")
   } else if (is_path(resp$body)) {
     readBin(resp$body, "raw", file.size(resp$body))
   } else {
@@ -143,11 +143,11 @@ check_content_type <- function(
     type <- paste0("'", types, "'")
   }
 
-  abort(c(
-    glue("Unexpected content type '{content_type}'"),
-    glue("Expecting {type}"),
-    if (!is.null(suffix)) glue("Or suffix '{suffix}'"),
-    i = "Override check with `check_type = FALSE`"
+  cli::cli_abort(c(
+    "Unexpected content type {.str {content_type}}.",
+    "Expecting {.str {type}}",
+    if (!is.null(suffix)) "Or suffix {.str {suffix}}.",
+    i = "Override check with {.code check_type = FALSE}."
   ))
 }
 

R/secret.R

@@ -233,10 +233,13 @@ as_key <- function(x, error_call = caller_env()) {
   } else if (is_string(x)) {
     secret_get_key(x, call = error_call)
   } else {
-    abort(paste0(
-      "`key` must be a raw vector containing the key, ",
-      "a string giving the name of an env var, ",
-      "or a string wrapped in I() that contains the base64url encoded key"
-    ), call = error_call)
+    cli::cli_abort(
+      paste0(
+        "{.arg key} must be a raw vector containing the key, ",
+        "a string giving the name of an env var, ",
+        "or a string wrapped in {.fn I} that contains the base64url encoded key."
+      ),
+      call = error_call
+    )
   }
 }