Nothing
R/Application.R
In RestRserve: A Framework for Building HTTP API
#' @title Creates application - RestRserve usage starts from here
#'
#' @description
#' Creates Application object.
#' Application provides an interface for building high-performance
#' REST API by registering R functions as handlers http requests.
#' @details
#' There are several advanced options to control how HTTP headers are
#' processed:
#' - `options("RestRserve.headers.server")` controls response `"Server"` header
#' - `options("RestRserve.headers.split")` controls which header values
#' split by comma during parsing. See
#' [https://en.wikipedia.org/wiki/List_of_HTTP_header_fields](),
#' [https://stackoverflow.com/a/29550711/3048453]()
#'
#' There is also an option to switch-off runtime types validation in
#' the Request/Response handlers. This might provide some performance gains,
#' but ultimately leads to less robust applications. Use at your own risk!
#' See `options("RestRserve.runtime.asserts")`
#' @export
#'
#' @seealso [HTTPError] [Middleware]
#' [Request] [Response]
#'
#' @examples
#' # init logger
#' app_logger = Logger$new()
#' # set log level for the middleware
#' app_logger$set_log_level("debug")
#' # set logger name
#' app_logger$set_name("MW Logger")
#' # init middleware to logging
#' mw = Middleware$new(
#' process_request = function(rq, rs) {
#' app_logger$info(sprintf("Incomming request (id %s): %s", rq$id, rq$path))
#' },
#' process_response = function(rq, rs) {
#' app_logger$info(sprintf("Outgoing response (id %s): %s", rq$id, rs$status))
#' },
#' id = "awesome-app-logger"
#' )
#'
#' # init application
#' app = Application$new(middleware = list(mw))
#'
#' # set internal log level
#' app$logger$set_log_level("error")
#'
#' # define simply request handler
#' status_handler = function(rq, rs) {
#' rs$set_body("OK")
#' rs$set_content_type("text/plain")
#' rs$set_status_code(200L)
#' }
#' # add route
#' app$add_get("/status", status_handler, "exact")
#'
#' # add static file handler
#' desc_file = system.file("DESCRIPTION", package = "RestRserve")
#' # add route
#' app$add_static("/desc", desc_file, "text/plain")
#'
#' # define say message handler
#' say_handler = function(rq, rs) {
#' who = rq$parameters_path[["user"]]
#' msg = rq$parameters_query[["message"]]
#' if (is.null(msg)) msg = "Hello"
#' rs$set_body(paste(who, "say", dQuote(msg)))
#' rs$set_content_type("text/plain")
#' rs$set_status_code(200L)
#' }
#' # add route
#' app$add_get("/say/{user}", say_handler, "regex")
#'
#' # print application info
#' app
#'
#' # test app
#' # simulate requests
#' not_found_rq = Request$new(path = "/no")
#' status_rq = Request$new(path = "/status")
#' desc_rq = Request$new(path = "/desc")
#' say_rq = Request$new(path = "/say/anonym", parameters_query = list("message" = "Hola"))
#' # process prepared requests
#' app$process_request(not_found_rq)
#' app$process_request(status_rq)
#' app$process_request(desc_rq)
#' app$process_request(say_rq)
#'
#' # run app
#' backend = BackendRserve$new()
#' \donttest{
#' if (interactive()) {
#' backend$start(app, 8080)
#' }
#' }
#'
Application = R6::R6Class(
classname = "Application",
public = list(
#' @field logger Logger object which records events during request processing.
#' Alternatively user can use loggers from lgr package as a drop-in
#' replacement - `Logger` methods and loggers created by `lgr` share
#' function signatures.
logger = NULL,
#' @field content_type Default response body content type.
content_type = NULL,
#' @field HTTPError Class which raises HTTP errors.
#' Global [HTTPError] is used by default. In theory user can replace it with
#' his own class (see `RestRserve:::HTTPErrorFactory`). However we believe
#' in the majority of the cases using [HTTPError] will be enough.
HTTPError = NULL,
#' @description
#' Creates Application object.
#' @param middleware List of [Middleware] objects.
#' @param content_type Default response body content (media) type. `"text/plain"` by default.
#' @param ... Not used at the moment.
initialize = function(middleware = list(EncodeDecodeMiddleware$new()), content_type = "text/plain", ...) {
private$backend = BackendRserve$new()
private$routes = new.env(parent = emptyenv())
private$handlers = new.env(parent = emptyenv())
self$logger = Logger$new("info", name = "Application")
self$content_type = content_type
self$HTTPError = HTTPError
private$response = Response$new(content_type = self$content_type)
private$request = Request$new()
checkmate::assert_list(middleware, types = "Middleware", unique = TRUE)
private$middleware = list()
for (mw in middleware) {
self$append_middleware(mw)
}
return(invisible(self))
},
#' @description
#' Adds endpoint and register user-supplied R function as a handler.
#' @param path Endpoint path.
#' @param method HTTP method. Allowed methods at the moment:
#' `GET`, `HEAD`, `POST`, `PUT`, `DELETE`, `OPTIONS`, `PATCH`.
#' @param FUN User function to handle requests. `FUN` **must** take two arguments:
#' first is `request` ([Request]) and second is `response` ([Response]).\cr
#' The goal of the user function is to **modify** `response` or throw
#' exception (call [raise()] or [stop()]).\cr
#' Both `response` and `request` objects modified in-place and internally
#' passed further to RestRserve execution pipeline.
#' @param match Defines how route will be processed. Allowed values:
#' * `exact` - match route as is. Returns 404 if route is not matched.
#' * `partial` - match route as prefix. Returns 404 if prefix are not matched.
#' * `regex` - match route as template. Returns 404 if template pattern not matched.
#' @param ... Not used.
add_route = function(path, method, FUN, match = c("exact", "partial", "regex"), ...) {
checkmate::assert_string(path, min.chars = 1L, pattern = "^/")
checkmate::assert_choice(method, private$supported_methods)
checkmate::assert_function(FUN, nargs = 2L)
# Add router if no exists
if (is.null(private$routes[[method]])) {
private$routes[[method]] = Router$new()
}
# Generate ID for handler
id = as.character(length(private$handlers) + 1L)
# Add path
private$routes[[method]]$add_path(path, match, id)
# Add handler
private$handlers[[id]] = compiler::cmpfun(FUN)
return(invisible(self))
},
#' @description
#' Shorthand to `Application$add_route()` with `GET` method.
#' @param path Endpoint path.
#' @param FUN User function to handle requests. `FUN` **must** take two arguments:
#' first is `request` ([Request]) and second is `response` ([Response]).\cr
#' The goal of the user function is to **modify** `response` or throw
#' exception (call [raise()] or [stop()]).\cr
#' Both `response` and `request` objects modified in-place and internally
#' passed further to RestRserve execution pipeline.
#' @param match Defines how route will be processed. Allowed values:
#' * `exact` - match route as is. Returns 404 if route is not matched.
#' * `partial` - match route as prefix. Returns 404 if prefix are not matched.
#' * `regex` - match route as template. Returns 404 if template pattern not matched.
#' @param ... Not used.
#' @param add_head Adds HEAD method.
add_get = function(path, FUN, match = c("exact", "partial", "regex"), ..., add_head = TRUE) {
if (isTRUE(add_head)) {
self$add_route(path, "HEAD", FUN, match, ...)
}
self$add_route(path, "GET", FUN, match, ...)
return(invisible(self))
},
#' @description
#' Shorthand to `Application$add_route()` with `POST` method.
#' @param path Endpoint path.
#' @param FUN User function to handle requests. `FUN` **must** take two arguments:
#' first is `request` ([Request]) and second is `response` ([Response]).\cr
#' The goal of the user function is to **modify** `response` or throw
#' exception (call [raise()] or [stop()]).\cr
#' Both `response` and `request` objects modified in-place and internally
#' passed further to RestRserve execution pipeline.
#' @param match Defines how route will be processed. Allowed values:
#' * `exact` - match route as is. Returns 404 if route is not matched.
#' * `partial` - match route as prefix. Returns 404 if prefix are not matched.
#' * `regex` - match route as template. Returns 404 if template pattern not matched.
#' @param ... Not used.
add_post = function(path, FUN, match = c("exact", "partial", "regex"), ...) {
self$add_route(path, "POST", FUN, match, ...)
return(invisible(self))
},
#' @description
#' Adds `GET` method to serve file or directory at `file_path`.
#' @param path Endpoint path.
#' @param file_path Path file or directory.
#' @param content_type MIME-type for the content.\cr
#' If `content_type = NULL` then MIME code `content_type` will be inferred
#' automatically (from file extension).\cr
#' If it will be impossible to guess about file type then `content_type` will
#' be set to `application/octet-stream`.
#' @param ... Not used.
add_static = function(path, file_path, content_type = NULL, ...) {
handler = private$static_handler(url_path = path, file_path = file_path, content_type = content_type)
self$add_route(path, "GET", handler, attr(handler, "match"), ...)
return(invisible(self))
},
#' @description
#' Adds endpoint to serve [OpenAPI](https://www.openapis.org/) description of
#' available methods.
#' @param path path Endpoint path.
#' @param file_path Path to the OpenAPI specification file.
add_openapi = function(path = "/openapi.yaml", file_path = "openapi.yaml") {
checkmate::assert_string(path, pattern = "/.*")
file_path = path.expand(file_path)
checkmate::assert_file_exists(file_path, extension = c("yaml", "yml", "json"))
content_type = switch(
tools::file_ext(file_path),
json = "application/json",
"text/plain"
)
self$add_static(path = path, file_path = file_path, content_type = content_type)
return(invisible(self))
},
#' @description
#' Adds endpoint to show [Swagger UI](https://swagger.io/tools/swagger-ui/).
#' @param path path Endpoint path.
#' @param path_openapi Path to the OpenAPI specification file.
#' @param use_cdn Use CDN to load Swagger UI libraries.
#' @param path_swagger_assets Swagger UI asstes endpoint.
#' @param file_path Path to Swagger UI HTML file.
add_swagger_ui = function(path = "/swagger", path_openapi = "/openapi.yaml",
use_cdn = TRUE, path_swagger_assets = "/__swagger__/",
file_path = "swagger-ui.html") {
# check openapi defenition is already added
checkmate::assert_choice(path_openapi, self$endpoints$GET[names(self$endpoints$GET) == "exact"])
checkmate::assert_string(file_path)
checkmate::assert_string(path_swagger_assets, pattern = "^/")
checkmate::assert_flag(use_cdn)
file_path = path.expand(file_path)
file_dir = dirname(file_path)
if (!dir.exists(file_dir)) {
dir.create(file_dir, recursive = TRUE)
}
html = readLines(system.file("swagger", "index.html", package = packageName()))
html = gsub("{path_openapi}", path_openapi, html, fixed = TRUE)
if (use_cdn) {
cdn_url = "https://cdn.jsdelivr.net/npm/swagger-ui-dist@latest"
html = gsub("{path_swagger_assets}", cdn_url, html, fixed = TRUE)
} else {
path_swagger_assets = sub("/$", "", path_swagger_assets)
html = gsub("{path_swagger_assets}", path_swagger_assets, html, fixed = TRUE)
self$add_static(path_swagger_assets, system.file("swagger", package = packageName()))
}
writeLines(html, file_path)
self$add_static(path, file_path, "text/html")
return(invisible(self))
},
#' @description
#' Appends middleware to handlers pipeline.
#' @param mw [Middleware] object.
append_middleware = function(mw) {
checkmate::assert_r6(mw, classes = "Middleware")
private$middleware = append(private$middleware, mw)
return(invisible(self))
},
#' @description
#' Process incoming request and generate [Response] object.
#' @param request [Request] object.\cr
#' Useful for tests your handlers before deploy application.
process_request = function(request = NULL) {
# if we use fork-mode then on.exit wlll be called in a fork and
# request_id will never be updated. Hence if the input request is `private$request`
# we need to do it manually
if (is.null(request)) {
request = private$request
request$set_id()
}
on.exit(private$request$reset())
response = private$response
private$eval_with_error_handling({
response$reset()
response$set_content_type(self$content_type)
# log request
self$logger$debug(
"",
context = list(
request_id = request$id,
request = list(
method = request$method,
path = request$path,
parameters_query = request$parameters_query,
parameters_path = request$parameters_path,
headers = request$headers
)
)
)
# Call middleware for the request
mw_called = list()
mw_flag = "process_request"
need_call_handler = TRUE
for (id in seq_along(private$middleware)) {
mw_id = private$middleware[[id]][["id"]]
self$logger$trace(
"",
context = list(
request_id = request$id,
middleware = mw_id,
message = sprintf("call %s middleware", mw_flag)
)
)
FUN = private$middleware[[id]][[mw_flag]]
mw_status = private$eval_with_error_handling(FUN(request, response))
# FIXME: move after break if last no need
mw_called[[id]] = id
# break loop on error
if (!isTRUE(mw_status)) {
need_call_handler = FALSE
break
}
}
# call handler
if (isTRUE(need_call_handler)) {
private$eval_with_error_handling({
# as a side effect we will populate request$parameters_path (if any)
handler_id = private$match_handler(request, response)
FUN = private$handlers[[handler_id]]
self$logger$trace(
"",
context = list(
request_id = request$id,
message = sprintf("call handler '%s'", handler_id)
)
)
FUN(request, response)
})
}
# call middleware for the response
mw_flag = "process_response"
# call in reverse order
for (id in rev(mw_called)) {
mw_id = private$middleware[[id]][["id"]]
self$logger$trace(
"",
context = list(
request_id = request$id,
middleware = mw_id,
message = sprintf("call %s middleware", mw_flag)
)
)
FUN = private$middleware[[id]][[mw_flag]]
mw_status = private$eval_with_error_handling(FUN(request, response))
}
# log response
self$logger$debug(
"",
context = list(
request_id = request$id,
response = list(
status_code = response$status_code,
headers = response$headers
)
)
)
})
return(response)
},
#' @description
#' Prints application details.
print = function() {
cat("<RestRserve Application>")
cat("\n")
mw = private$middleware
if (length(mw) > 0L) {
cat(" <Middlewares>")
cat("\n")
for (m in mw) {
if (!identical(m$process_request, TRUE)) {
cat(" [request]")
}
if (!identical(m$process_response, TRUE)) {
cat("[response]")
}
cat(":", m$id)
cat("\n")
}
}
ep = self$endpoints
if (length(ep) > 0L) {
cat(" <Endpoints>")
cat("\n")
for (m in names(ep)) {
cat(sprintf(" %s [%s]: %s\n", m, names(ep[[m]]), ep[[m]]), sep = "")
}
}
return(invisible(self))
}
),
active = list(
#' @field endpoints Prints all the registered routes with allowed methods.
endpoints = function() {
lapply(private$routes, function(r) r$paths)
}
),
private = list(
routes = NULL,
handlers = NULL,
middleware = NULL,
response = NULL,
request = NULL,
backend = NULL,
# according to
# https://github.com/s-u/Rserve/blob/d5c1dfd029256549f6ca9ed5b5a4b4195934537d/src/http.c#L29
# only "GET", "POST", ""HEAD" are ""natively supported. Other methods are "custom"
#------------------------------------------------------------------------
supported_methods = c("GET", "HEAD", "POST", "PUT", "DELETE", "OPTIONS", "PATCH"),
#------------------------------------------------------------------------
static_handler = function(url_path, file_path, content_type = NULL) {
checkmate::assert_string(url_path, min.chars = 1L, pattern = "^/")
checkmate::assert_string(file_path)
checkmate::assert_string(content_type, null.ok = TRUE)
# FIXME: seems not required in contructor
checkmate::assert(
checkmate::check_file_exists(file_path, access = "r"),
checkmate::check_directory_exists(file_path, access = "r"),
combine = "or"
)
# FIXME: need to expand?
# file_path = path.expand(file_path)
file_path = normalizePath(file_path) # absolute path
url_nchars = nchar(url_path) # prevent calc every time
if (dir.exists(file_path)) {
# file_path is a DIRECTORY
handler = function(request, response) {
fl = substr(request$path, url_nchars + 1L, nchar(request$path))
fl = file.path(file_path, fl)
if (!file.exists(fl) || dir.exists(fl)) {
raise(self$HTTPError$not_found())
} else {
response$body = c(file = fl)
response$content_type = guess_mime(fl, content_type)
response$status_code = 200L
}
}
attr(handler, "match") = "partial"
} else {
# file_path is a FILE
handler = function(request, response) {
if (!file.exists(file_path)) {
raise(self$HTTPError$not_found())
} else {
response$body = c(file = file_path)
response$content_type = guess_mime(file_path, content_type)
response$status_code = 200L
}
}
attr(handler, "match") = "exact"
}
return(handler)
},
#------------------------------------------------------------------------
match_handler = function(request, response) {
# Early stop if no routes for this method
router = private$routes[[request$method]]
if (is.null(router) || router$size() == 0L) {
self$logger$trace("",
context = list(request_id = request$id,
message = sprintf("no handlers registered for the method '%s'", request$method))
)
raise(self$HTTPError$method_not_allowed())
}
# Get handler UID
self$logger$trace("",
context = list(request_id = request$id,
message = sprintf("try to match requested path '%s'", request$path))
)
id = router$match_path(request$path)
if (is.null(id)) {
self$logger$trace("",
context = list(
request_id = request$id,
message = "requested path not matched"
)
)
raise(self$HTTPError$not_found())
}
self$logger$trace("",
context = list(
request_id = request$id,
message = "requested path matched"
)
)
# if there are extracted parameters
parameters_path = attr(id, 'parameters_path')
if (is.list(parameters_path)) {
request$parameters_path = parameters_path
}
return(id)
},
#------------------------------------------------------------------------
eval_with_error_handling = function(expr) {
expanded_traceback = isTRUE(getOption("RestRserve.runtime.traceback", TRUE))
if (expanded_traceback) {
x = try_capture_stack(expr)
} else {
x = try(expr, silent = TRUE)
}
success = TRUE
if (inherits(x, "HTTPErrorRaise")) {
# HTTPError response
x = x$response
} else {
if (inherits(x, "simpleError")) {
# means UNHANDLED exception in middleware
self$logger$error(
"",
context = list(
request_id = private$request$id,
message = get_traceback(x)
)
)
x = self$HTTPError$internal_server_error()
}
}
if (inherits(x, "HTTPError")) {
for (field in c("body", "content_type", "headers", "status_code")) {
private$response[[field]] = x[[field]]
}
private$response$body = self$HTTPError$encode(x$body)
private$response$encode = identity
success = FALSE
}
return(success)
}
)
)
Try the RestRserve package in your browser
Any scripts or data that you put into this service are public.
RestRserve documentation built on Sept. 12, 2022, 9:06 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
#' @title Creates application - RestRserve usage starts from here
#'
#' @description
#' Creates Application object.
#' Application provides an interface for building high-performance
#' REST API by registering R functions as handlers http requests.
#' @details
#' There are several advanced options to control how HTTP headers are
#' processed:
#' - `options("RestRserve.headers.server")` controls response `"Server"` header
#' - `options("RestRserve.headers.split")` controls which header values
#' split by comma during parsing. See
#' [https://en.wikipedia.org/wiki/List_of_HTTP_header_fields](),
#' [https://stackoverflow.com/a/29550711/3048453]()
#'
#' There is also an option to switch-off runtime types validation in
#' the Request/Response handlers. This might provide some performance gains,
#' but ultimately leads to less robust applications. Use at your own risk!
#' See `options("RestRserve.runtime.asserts")`
#' @export
#'
#' @seealso [HTTPError] [Middleware]
#' [Request] [Response]
#'
#' @examples
#' # init logger
#' app_logger = Logger$new()
#' # set log level for the middleware
#' app_logger$set_log_level("debug")
#' # set logger name
#' app_logger$set_name("MW Logger")
#' # init middleware to logging
#' mw = Middleware$new(
#' process_request = function(rq, rs) {
#' app_logger$info(sprintf("Incomming request (id %s): %s", rq$id, rq$path))
#' },
#' process_response = function(rq, rs) {
#' app_logger$info(sprintf("Outgoing response (id %s): %s", rq$id, rs$status))
#' },
#' id = "awesome-app-logger"
#' )
#'
#' # init application
#' app = Application$new(middleware = list(mw))
#'
#' # set internal log level
#' app$logger$set_log_level("error")
#'
#' # define simply request handler
#' status_handler = function(rq, rs) {
#' rs$set_body("OK")
#' rs$set_content_type("text/plain")
#' rs$set_status_code(200L)
#' }
#' # add route
#' app$add_get("/status", status_handler, "exact")
#'
#' # add static file handler
#' desc_file = system.file("DESCRIPTION", package = "RestRserve")
#' # add route
#' app$add_static("/desc", desc_file, "text/plain")
#'
#' # define say message handler
#' say_handler = function(rq, rs) {
#' who = rq$parameters_path[["user"]]
#' msg = rq$parameters_query[["message"]]
#' if (is.null(msg)) msg = "Hello"
#' rs$set_body(paste(who, "say", dQuote(msg)))
#' rs$set_content_type("text/plain")
#' rs$set_status_code(200L)
#' }
#' # add route
#' app$add_get("/say/{user}", say_handler, "regex")
#'
#' # print application info
#' app
#'
#' # test app
#' # simulate requests
#' not_found_rq = Request$new(path = "/no")
#' status_rq = Request$new(path = "/status")
#' desc_rq = Request$new(path = "/desc")
#' say_rq = Request$new(path = "/say/anonym", parameters_query = list("message" = "Hola"))
#' # process prepared requests
#' app$process_request(not_found_rq)
#' app$process_request(status_rq)
#' app$process_request(desc_rq)
#' app$process_request(say_rq)
#'
#' # run app
#' backend = BackendRserve$new()
#' \donttest{
#' if (interactive()) {
#' backend$start(app, 8080)
#' }
#' }
#'
Application = R6::R6Class(
classname = "Application",
public = list(
#' @field logger Logger object which records events during request processing.
#' Alternatively user can use loggers from lgr package as a drop-in
#' replacement - `Logger` methods and loggers created by `lgr` share
#' function signatures.
logger = NULL,
#' @field content_type Default response body content type.
content_type = NULL,
#' @field HTTPError Class which raises HTTP errors.
#' Global [HTTPError] is used by default. In theory user can replace it with
#' his own class (see `RestRserve:::HTTPErrorFactory`). However we believe
#' in the majority of the cases using [HTTPError] will be enough.
HTTPError = NULL,
#' @description
#' Creates Application object.
#' @param middleware List of [Middleware] objects.
#' @param content_type Default response body content (media) type. `"text/plain"` by default.
#' @param ... Not used at the moment.
initialize = function(middleware = list(EncodeDecodeMiddleware$new()), content_type = "text/plain", ...) {
private$backend = BackendRserve$new()
private$routes = new.env(parent = emptyenv())
private$handlers = new.env(parent = emptyenv())
self$logger = Logger$new("info", name = "Application")
self$content_type = content_type
self$HTTPError = HTTPError
private$response = Response$new(content_type = self$content_type)
private$request = Request$new()
checkmate::assert_list(middleware, types = "Middleware", unique = TRUE)
private$middleware = list()
for (mw in middleware) {
self$append_middleware(mw)
}
return(invisible(self))
},
#' @description
#' Adds endpoint and register user-supplied R function as a handler.
#' @param path Endpoint path.
#' @param method HTTP method. Allowed methods at the moment:
#' `GET`, `HEAD`, `POST`, `PUT`, `DELETE`, `OPTIONS`, `PATCH`.
#' @param FUN User function to handle requests. `FUN` **must** take two arguments:
#' first is `request` ([Request]) and second is `response` ([Response]).\cr
#' The goal of the user function is to **modify** `response` or throw
#' exception (call [raise()] or [stop()]).\cr
#' Both `response` and `request` objects modified in-place and internally
#' passed further to RestRserve execution pipeline.
#' @param match Defines how route will be processed. Allowed values:
#' * `exact` - match route as is. Returns 404 if route is not matched.
#' * `partial` - match route as prefix. Returns 404 if prefix are not matched.
#' * `regex` - match route as template. Returns 404 if template pattern not matched.
#' @param ... Not used.
add_route = function(path, method, FUN, match = c("exact", "partial", "regex"), ...) {
checkmate::assert_string(path, min.chars = 1L, pattern = "^/")
checkmate::assert_choice(method, private$supported_methods)
checkmate::assert_function(FUN, nargs = 2L)
# Add router if no exists
if (is.null(private$routes[[method]])) {
private$routes[[method]] = Router$new()
}
# Generate ID for handler
id = as.character(length(private$handlers) + 1L)
# Add path
private$routes[[method]]$add_path(path, match, id)
# Add handler
private$handlers[[id]] = compiler::cmpfun(FUN)
return(invisible(self))
},
#' @description
#' Shorthand to `Application$add_route()` with `GET` method.
#' @param path Endpoint path.
#' @param FUN User function to handle requests. `FUN` **must** take two arguments:
#' first is `request` ([Request]) and second is `response` ([Response]).\cr
#' The goal of the user function is to **modify** `response` or throw
#' exception (call [raise()] or [stop()]).\cr
#' Both `response` and `request` objects modified in-place and internally
#' passed further to RestRserve execution pipeline.
#' @param match Defines how route will be processed. Allowed values:
#' * `exact` - match route as is. Returns 404 if route is not matched.
#' * `partial` - match route as prefix. Returns 404 if prefix are not matched.
#' * `regex` - match route as template. Returns 404 if template pattern not matched.
#' @param ... Not used.
#' @param add_head Adds HEAD method.
add_get = function(path, FUN, match = c("exact", "partial", "regex"), ..., add_head = TRUE) {
if (isTRUE(add_head)) {
self$add_route(path, "HEAD", FUN, match, ...)
}
self$add_route(path, "GET", FUN, match, ...)
return(invisible(self))
},
#' @description
#' Shorthand to `Application$add_route()` with `POST` method.
#' @param path Endpoint path.
#' @param FUN User function to handle requests. `FUN` **must** take two arguments:
#' first is `request` ([Request]) and second is `response` ([Response]).\cr
#' The goal of the user function is to **modify** `response` or throw
#' exception (call [raise()] or [stop()]).\cr
#' Both `response` and `request` objects modified in-place and internally
#' passed further to RestRserve execution pipeline.
#' @param match Defines how route will be processed. Allowed values:
#' * `exact` - match route as is. Returns 404 if route is not matched.
#' * `partial` - match route as prefix. Returns 404 if prefix are not matched.
#' * `regex` - match route as template. Returns 404 if template pattern not matched.
#' @param ... Not used.
add_post = function(path, FUN, match = c("exact", "partial", "regex"), ...) {
self$add_route(path, "POST", FUN, match, ...)
return(invisible(self))
},
#' @description
#' Adds `GET` method to serve file or directory at `file_path`.
#' @param path Endpoint path.
#' @param file_path Path file or directory.
#' @param content_type MIME-type for the content.\cr
#' If `content_type = NULL` then MIME code `content_type` will be inferred
#' automatically (from file extension).\cr
#' If it will be impossible to guess about file type then `content_type` will
#' be set to `application/octet-stream`.
#' @param ... Not used.
add_static = function(path, file_path, content_type = NULL, ...) {
handler = private$static_handler(url_path = path, file_path = file_path, content_type = content_type)
self$add_route(path, "GET", handler, attr(handler, "match"), ...)
return(invisible(self))
},
#' @description
#' Adds endpoint to serve [OpenAPI](https://www.openapis.org/) description of
#' available methods.
#' @param path path Endpoint path.
#' @param file_path Path to the OpenAPI specification file.
add_openapi = function(path = "/openapi.yaml", file_path = "openapi.yaml") {
checkmate::assert_string(path, pattern = "/.*")
file_path = path.expand(file_path)
checkmate::assert_file_exists(file_path, extension = c("yaml", "yml", "json"))
content_type = switch(
tools::file_ext(file_path),
json = "application/json",
"text/plain"
)
self$add_static(path = path, file_path = file_path, content_type = content_type)
return(invisible(self))
},
#' @description
#' Adds endpoint to show [Swagger UI](https://swagger.io/tools/swagger-ui/).
#' @param path path Endpoint path.
#' @param path_openapi Path to the OpenAPI specification file.
#' @param use_cdn Use CDN to load Swagger UI libraries.
#' @param path_swagger_assets Swagger UI asstes endpoint.
#' @param file_path Path to Swagger UI HTML file.
add_swagger_ui = function(path = "/swagger", path_openapi = "/openapi.yaml",
use_cdn = TRUE, path_swagger_assets = "/__swagger__/",
file_path = "swagger-ui.html") {
# check openapi defenition is already added
checkmate::assert_choice(path_openapi, self$endpoints$GET[names(self$endpoints$GET) == "exact"])
checkmate::assert_string(file_path)
checkmate::assert_string(path_swagger_assets, pattern = "^/")
checkmate::assert_flag(use_cdn)
file_path = path.expand(file_path)
file_dir = dirname(file_path)
if (!dir.exists(file_dir)) {
dir.create(file_dir, recursive = TRUE)
}
html = readLines(system.file("swagger", "index.html", package = packageName()))
html = gsub("{path_openapi}", path_openapi, html, fixed = TRUE)
if (use_cdn) {
cdn_url = "https://cdn.jsdelivr.net/npm/swagger-ui-dist@latest"
html = gsub("{path_swagger_assets}", cdn_url, html, fixed = TRUE)
} else {
path_swagger_assets = sub("/$", "", path_swagger_assets)
html = gsub("{path_swagger_assets}", path_swagger_assets, html, fixed = TRUE)
self$add_static(path_swagger_assets, system.file("swagger", package = packageName()))
}
writeLines(html, file_path)
self$add_static(path, file_path, "text/html")
return(invisible(self))
},
#' @description
#' Appends middleware to handlers pipeline.
#' @param mw [Middleware] object.
append_middleware = function(mw) {
checkmate::assert_r6(mw, classes = "Middleware")
private$middleware = append(private$middleware, mw)
return(invisible(self))
},
#' @description
#' Process incoming request and generate [Response] object.
#' @param request [Request] object.\cr
#' Useful for tests your handlers before deploy application.
process_request = function(request = NULL) {
# if we use fork-mode then on.exit wlll be called in a fork and
# request_id will never be updated. Hence if the input request is `private$request`
# we need to do it manually
if (is.null(request)) {
request = private$request
request$set_id()
}
on.exit(private$request$reset())
response = private$response
private$eval_with_error_handling({
response$reset()
response$set_content_type(self$content_type)
# log request
self$logger$debug(
"",
context = list(
request_id = request$id,
request = list(
method = request$method,
path = request$path,
parameters_query = request$parameters_query,
parameters_path = request$parameters_path,
headers = request$headers
)
)
)
# Call middleware for the request
mw_called = list()
mw_flag = "process_request"
need_call_handler = TRUE
for (id in seq_along(private$middleware)) {
mw_id = private$middleware[[id]][["id"]]
self$logger$trace(
"",
context = list(
request_id = request$id,
middleware = mw_id,
message = sprintf("call %s middleware", mw_flag)
)
)
FUN = private$middleware[[id]][[mw_flag]]
mw_status = private$eval_with_error_handling(FUN(request, response))
# FIXME: move after break if last no need
mw_called[[id]] = id
# break loop on error
if (!isTRUE(mw_status)) {
need_call_handler = FALSE
break
}
}
# call handler
if (isTRUE(need_call_handler)) {
private$eval_with_error_handling({
# as a side effect we will populate request$parameters_path (if any)
handler_id = private$match_handler(request, response)
FUN = private$handlers[[handler_id]]
self$logger$trace(
"",
context = list(
request_id = request$id,
message = sprintf("call handler '%s'", handler_id)
)
)
FUN(request, response)
})
}
# call middleware for the response
mw_flag = "process_response"
# call in reverse order
for (id in rev(mw_called)) {
mw_id = private$middleware[[id]][["id"]]
self$logger$trace(
"",
context = list(
request_id = request$id,
middleware = mw_id,
message = sprintf("call %s middleware", mw_flag)
)
)
FUN = private$middleware[[id]][[mw_flag]]
mw_status = private$eval_with_error_handling(FUN(request, response))
}
# log response
self$logger$debug(
"",
context = list(
request_id = request$id,
response = list(
status_code = response$status_code,
headers = response$headers
)
)
)
})
return(response)
},
#' @description
#' Prints application details.
print = function() {
cat("<RestRserve Application>")
cat("\n")
mw = private$middleware
if (length(mw) > 0L) {
cat(" <Middlewares>")
cat("\n")
for (m in mw) {
if (!identical(m$process_request, TRUE)) {
cat(" [request]")
}
if (!identical(m$process_response, TRUE)) {
cat("[response]")
}
cat(":", m$id)
cat("\n")
}
}
ep = self$endpoints
if (length(ep) > 0L) {
cat(" <Endpoints>")
cat("\n")
for (m in names(ep)) {
cat(sprintf(" %s [%s]: %s\n", m, names(ep[[m]]), ep[[m]]), sep = "")
}
}
return(invisible(self))
}
),
active = list(
#' @field endpoints Prints all the registered routes with allowed methods.
endpoints = function() {
lapply(private$routes, function(r) r$paths)
}
),
private = list(
routes = NULL,
handlers = NULL,
middleware = NULL,
response = NULL,
request = NULL,
backend = NULL,
# according to
# https://github.com/s-u/Rserve/blob/d5c1dfd029256549f6ca9ed5b5a4b4195934537d/src/http.c#L29
# only "GET", "POST", ""HEAD" are ""natively supported. Other methods are "custom"
#------------------------------------------------------------------------
supported_methods = c("GET", "HEAD", "POST", "PUT", "DELETE", "OPTIONS", "PATCH"),
#------------------------------------------------------------------------
static_handler = function(url_path, file_path, content_type = NULL) {
checkmate::assert_string(url_path, min.chars = 1L, pattern = "^/")
checkmate::assert_string(file_path)
checkmate::assert_string(content_type, null.ok = TRUE)
# FIXME: seems not required in contructor
checkmate::assert(
checkmate::check_file_exists(file_path, access = "r"),
checkmate::check_directory_exists(file_path, access = "r"),
combine = "or"
)
# FIXME: need to expand?
# file_path = path.expand(file_path)
file_path = normalizePath(file_path) # absolute path
url_nchars = nchar(url_path) # prevent calc every time
if (dir.exists(file_path)) {
# file_path is a DIRECTORY
handler = function(request, response) {
fl = substr(request$path, url_nchars + 1L, nchar(request$path))
fl = file.path(file_path, fl)
if (!file.exists(fl) || dir.exists(fl)) {
raise(self$HTTPError$not_found())
} else {
response$body = c(file = fl)
response$content_type = guess_mime(fl, content_type)
response$status_code = 200L
}
}
attr(handler, "match") = "partial"
} else {
# file_path is a FILE
handler = function(request, response) {
if (!file.exists(file_path)) {
raise(self$HTTPError$not_found())
} else {
response$body = c(file = file_path)
response$content_type = guess_mime(file_path, content_type)
response$status_code = 200L
}
}
attr(handler, "match") = "exact"
}
return(handler)
},
#------------------------------------------------------------------------
match_handler = function(request, response) {
# Early stop if no routes for this method
router = private$routes[[request$method]]
if (is.null(router) || router$size() == 0L) {
self$logger$trace("",
context = list(request_id = request$id,
message = sprintf("no handlers registered for the method '%s'", request$method))
)
raise(self$HTTPError$method_not_allowed())
}
# Get handler UID
self$logger$trace("",
context = list(request_id = request$id,
message = sprintf("try to match requested path '%s'", request$path))
)
id = router$match_path(request$path)
if (is.null(id)) {
self$logger$trace("",
context = list(
request_id = request$id,
message = "requested path not matched"
)
)
raise(self$HTTPError$not_found())
}
self$logger$trace("",
context = list(
request_id = request$id,
message = "requested path matched"
)
)
# if there are extracted parameters
parameters_path = attr(id, 'parameters_path')
if (is.list(parameters_path)) {
request$parameters_path = parameters_path
}
return(id)
},
#------------------------------------------------------------------------
eval_with_error_handling = function(expr) {
expanded_traceback = isTRUE(getOption("RestRserve.runtime.traceback", TRUE))
if (expanded_traceback) {
x = try_capture_stack(expr)
} else {
x = try(expr, silent = TRUE)
}
success = TRUE
if (inherits(x, "HTTPErrorRaise")) {
# HTTPError response
x = x$response
} else {
if (inherits(x, "simpleError")) {
# means UNHANDLED exception in middleware
self$logger$error(
"",
context = list(
request_id = private$request$id,
message = get_traceback(x)
)
)
x = self$HTTPError$internal_server_error()
}
}
if (inherits(x, "HTTPError")) {
for (field in c("body", "content_type", "headers", "status_code")) {
private$response[[field]] = x[[field]]
}
private$response$body = self$HTTPError$encode(x$body)
private$response$encode = identity
success = FALSE
}
return(success)
}
)
)
Try the RestRserve package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.