feat: smart tryCatch for errors

[ColinFay]

Following a conversation with @psolymos:

When evaluating a function (*_f()), we could have a smart trycatch that will return the correct status code to the user.

Idea => internal functions that will be STOP() => throw 500, and BAD_INPUT() that will throw a 400

Note that we should also catch the traditional errors

[ColinFay]

The functions should return a list for the HTTP message, @psolymos has a template for that.

[psolymos]

@ColinFay here is an example of how errors can be distinguished by using R's condition signalling system.

The goal is to:

• catch error and distinguish server error (developer needs to fix code, status 5xx) and client error (user needs to fix request, status 4xx)
• or return the value (status 200) without error

http_error_codes <- structure(list(category = c("Client Error", 
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Client Error", "Client Error", "Client Error", "Client Error",
    "Server Error", "Server Error", "Server Error", "Server Error",
    "Server Error", "Server Error", "Server Error", "Server Error",
    "Server Error", "Server Error", "Server Error"),
    status = c(400L, 401L, 402L, 403L, 404L, 405L,
    406L, 407L, 408L, 409L, 410L, 411L, 412L, 413L, 414L, 415L, 416L,
    417L, 418L, 421L, 422L, 423L, 424L, 425L, 426L, 428L, 429L, 431L,
    451L, 500L, 501L, 502L, 503L, 504L, 505L, 506L, 507L, 508L, 510L,
    511L), message = c("Bad Request", "Unauthorized", "Payment Required",
    "Forbidden", "Not Found", "Method Not Allowed", "Not Acceptable",
    "Proxy Authentication Required", "Request Timeout", "Conflict",
    "Gone", "Length Required", "Precondition Failed", "Payload Too Large",
    "URI Too Long", "Unsupported Media Type", "Range Not Satisfiable",
    "Expectation Failed", "I'm a teapot", "Misdirected Request",
    "Unprocessable Entity", "Locked", "Failed Dependency", "Too Early",
    "Upgrade Required", "Precondition Required", "Too Many Requests",
    "Request Header Fields Too Large", "Unavailable For Legal Reasons",
    "Internal Server Error", "Not Implemented", "Bad Gateway", "Service Unavailable",
    "Gateway Timeout", "HTTP Version Not Supported", "Variant Also Negotiates",
    "Insufficient Storage", "Loop Detected", "Not Extended", "Network Authentication Required"
    )), row.names = 1:40, class = "data.frame")
rownames(http_error_codes) <- http_error_codes$status

http_error <- function(status = 500L, message = NULL) {
    status <- as.integer(status)
    if (!(status %in% http_error_codes$status))
        stop("Unrecognized status code.")
    i <- as.list(http_error_codes[as.character(status),])
    if (!is.null(message))
        i[["message"]] <- message
    x <- structure(i, class = c("http_error", "error", "condition"))
    stop(x)
}

## R's default error
    str(attr(try(stop("Hey, stop!")), "condition"))
Error in try(stop("Hey, stop!")) : Hey, stop!
List of 2
 $ message: chr "Hey, stop!"
 $ call   : language doTryCatch(return(expr), name, parentenv, handler)
 - attr(*, "class")= chr [1:3] "simpleError" "error" "condition"

## default status code 500 with default error message
    str(attr(try(http_error()), "condition"))
Error : Internal Server Error
List of 3
 $ category: chr "Server Error"
 $ status  : int 500
 $ message : chr "Internal Server Error"
 - attr(*, "class")= chr [1:3] "http_error" "error" "condition"

## custom status code with default error message
str(attr(try(http_error(501L)), "condition"))
Error : Not Implemented
List of 3
 $ category: chr "Server Error"
 $ status  : int 501
 $ message : chr "Not Implemented"
 - attr(*, "class")= chr [1:3] "http_error" "error" "condition"

## custom status code for client error
    str(attr(try(http_error(400L, "Provide valid email address.")), "condition"))
Error : Provide valid email address.
List of 3
 $ category: chr "Client Error"
 $ status  : int 400
 $ message : chr "Provide valid email address."
 - attr(*, "class")= chr [1:3] "http_error" "error" "condition"

Example for catching the error in Plumber is similar to the error handler hook and needs access to the res object

f <- function(z) {
    if (z < 0)
        stop("Object of type 'closure' is not subsettable.")
    if (z > 0)
        http_error(400L, "Provide valid input.")
    "Zero"
}

z <- 0 # try -1, 0, 1
res <- list()
x <- try(f(z))

## there is an error
if (inherits(x, "try-error")) {
    ## there is a server error, user does not need to know specifics but logging it is a good idea
    if (!inherits(attr(x, "condition"), "http_error")) {
        res$status <- 500L
        as.list(http_error_codes["500",])
    } else {
    ## there is a client error, we need to tell the user what happened and how to fix it
        res$status <- attr(x, "condition")$status
        unclass(attr(x, "condition"))
    }
} else {
    x
}

Now the front end application can differentiate based on status codes (2xx, 4xx, 5xx).

[psolymos]

OK, I have a working implementation. Here is an example endpoint (R/post_test.R):

#' POST test
#' 
#' @param req,res HTTP objects
#' 
#' @export
#'  
post_test <- function(req, res, z){
    mariobox::mario_log(
        method = "POST",
        name = "test"
    )
    mariobox::mario_log(
        method = "Received",
        name = z
    )
    mariobox::mario_try(res, post_test_f(z))
}

#' POST test internal
#' 
#' @noRd
#'  
post_test_f <- function(z){
    z <- as.numeric(z)
    if (z < 0)
        stop("Object of type 'closure' is not subsettable.")
    if (z > 0)
        mariobox::http_error(400L, "Provide valid input.")
    "Zero"
}

It logs this:

run_api()
Running plumber API at http://127.0.0.1:43951
Running swagger Docs at http://127.0.0.1:43951/__docs__/
── [2022-09-27 20:23:12] POST - test ─────────────────────────────────────────────────────────────
── [2022-09-27 20:23:12] Received - 0 ────────────────────────────────────────────────────────────
── [2022-09-27 20:23:12] 200 - Success ───────────────────────────────────────────────────────────
── [2022-09-27 20:23:15] POST - test ─────────────────────────────────────────────────────────────
── [2022-09-27 20:23:15] Received - 1 ────────────────────────────────────────────────────────────
── [2022-09-27 20:23:15] 400 - Provide valid input. ──────────────────────────────────────────────
── [2022-09-27 20:23:18] POST - test ─────────────────────────────────────────────────────────────
── [2022-09-27 20:23:18] Received - -1 ───────────────────────────────────────────────────────────
── [2022-09-27 20:23:18] 500 - Internal Server Error ─────────────────────────────────────────────
Error in post_test_f(z) : Object of type 'closure' is not subsettable.

Note: I think it makes sense to log the response status as well; mario_log prints to STDOUT whereas the 500 error at the end also sends the last error message to STDERR.