Fix #12 add redirect functionality

Author: thomasp85

NAMESPACE

@@ -18,7 +18,6 @@ S3method(roxy_tag_parse,roxy_tag_except)
 S3method(roxy_tag_parse,roxy_tag_get)
 S3method(roxy_tag_parse,roxy_tag_head)
 S3method(roxy_tag_parse,roxy_tag_header)
-S3method(roxy_tag_parse,roxy_tag_logger)
 S3method(roxy_tag_parse,roxy_tag_message)
 S3method(roxy_tag_parse,roxy_tag_noDoc)
 S3method(roxy_tag_parse,roxy_tag_options)
@@ -28,6 +27,7 @@ S3method(roxy_tag_parse,roxy_tag_plumber)
 S3method(roxy_tag_parse,roxy_tag_post)
 S3method(roxy_tag_parse,roxy_tag_put)
 S3method(roxy_tag_parse,roxy_tag_query)
+S3method(roxy_tag_parse,roxy_tag_redirect)
 S3method(roxy_tag_parse,roxy_tag_rejectMissingMethods)
 S3method(roxy_tag_parse,roxy_tag_response)
 S3method(roxy_tag_parse,roxy_tag_routeName)
@@ -78,6 +78,7 @@ export(api_post)
 export(api_post_header)
 export(api_put)
 export(api_put_header)
+export(api_redirect)
 export(api_run)
 export(api_session_cookie)
 export(api_statics)

R/Plumber.R

@@ -140,7 +140,11 @@ Plumber <- R6Class(
       ...,
       silent = FALSE
     ) {
-      if (length(private$OPENAPI) != 0 && !is.null(private$DOC_TYPE) && private$DOC_TYPE != "") {
+      if (
+        length(private$OPENAPI) != 0 &&
+          !is.null(private$DOC_TYPE) &&
+          private$DOC_TYPE != ""
+      ) {
         openapi_file <- tempfile(fileext = ".json")
         write_json(private$OPENAPI, openapi_file, auto_unbox = TRUE)
         api_route <- openapi_route(
@@ -263,11 +267,14 @@ Plumber <- R6Class(
         function(p) p$`in` == "path",
         logical(1)
       )
-      doc$parameters <- c(combine_parameters(
-        path_info$params,
-        doc$parameters[doc_path_param],
-        from_block = FALSE
-      ), doc$parameters[!doc_path_param])
+      doc$parameters <- c(
+        combine_parameters(
+          path_info$params,
+          doc$parameters[doc_path_param],
+          from_block = FALSE
+        ),
+        doc$parameters[!doc_path_param]
+      )
       operation_id <- paste0(path_info$path, "-", method)
       doc$parameters <- lapply(doc$parameters, function(par) {
         par$operationId <- par$operationId %||% operation_id
@@ -324,6 +331,41 @@ Plumber <- R6Class(
       handler <- create_plumber_message_handler(handler)
       self$on("message", handler)
     },
+    #' @description Add a redirect to the header router. Depending on the value
+    #' of `permanent` it will respond with a 307 Temporary Redirect or 308
+    #' Permanent Redirect. `from` and `to` can contain path parameters and
+    #' wildcards which will be matched between the two to construct the correct
+    #' redirect path.
+    #' @param method The HTTP method the redirect should respond to
+    #' @param from The path the redirect should respond to
+    #' @param to The path/URL to redirect the incoming request towards. After
+    #' resolving any path parameters and wildcards it will be used in the
+    #' `Location` header
+    #' @param permanent Logical. Is the redirect considered permanent or
+    #' temporary? Determines the type of redirct status code to use
+    redirect = function(method, from, to, permanent = TRUE) {
+      method <- arg_match0(
+        tolower(method),
+        c(
+          "get",
+          "head",
+          "post",
+          "put",
+          "delete",
+          "connect",
+          "options",
+          "trace",
+          "patch",
+          "any",
+          "all"
+        )
+      )
+      if (method == "any") method <- "all"
+      check_string(from)
+      check_string(to)
+      check_bool(permanent)
+      self$header_router(method, from, to, permanent)
+    },
     #' @description Parses a plumber file and updates the app according to it
     #' @param file The path to a file to parse
     #' @param env The parent environment to the environment the file should be
@@ -363,6 +405,14 @@ Plumber <- R6Class(
       for (handler in parsed$message_handlers) {
         self$message_handler(handler)
       }
+      for (redirect in parsed$redirects) {
+        self$redirect(
+          redirect$method,
+          redirect$from,
+          redirect$to,
+          redirect$permanent
+        )
+      }
       self$add_api_doc(parsed$api)
       parsed$modifier(self)
     },

R/api_handlers.R

@@ -362,7 +362,13 @@ api_any_header <- handle_constructor("any", header = TRUE)
 #'
 #' @export
 #'
-api_add_route <- function(api, name, route = NULL, header = FALSE, after = NULL) {
+api_add_route <- function(
+  api,
+  name,
+  route = NULL,
+  header = FALSE,
+  after = NULL
+) {
   api$add_route(name = name, route = route, header = header, after = after)
   api
 }
@@ -408,3 +414,34 @@ api_message <- function(api, handler) {
   api$message_handler(handler)
   api
 }
+
+#' Redirect request to another resource
+#'
+#' While it is optimal that an API remains stable over its lifetime it is often
+#' not fully attainable. In order to direct requests for ressources that has
+#' been moved to the new location you can add a redirect that ensures a smooth
+#' transition for clients still using the old path. Depending on the value
+#' of `permanent` the redirect will respond with a `307 Temporary Redirect` or
+#' `308 Permanent Redirect`. `from` and `to` can contain path parameters and
+#' wildcards which will be matched between the two to construct the correct
+#' redirect path. Further, `to` can either be a path to the same server or a
+#' fully qualified URL to redirect requests to another server alltogether.
+#'
+#' @param api A plumber2 api object to add the redirect to
+#' @param method The HTTP method the redirect should respond to
+#' @param from The path the redirect should respond to
+#' @param to The path/URL to redirect the incoming request towards. After
+#' resolving any path parameters and wildcards it will be used in the
+#' `Location` header
+#' @param permanent Logical. Is the redirect considered permanent or
+#' temporary? Determines the type of redirct status code to use
+#'
+#' @return This functions return the `api` object allowing for easy chaining
+#' with the pipe
+#'
+#' @export
+#'
+api_redirect <- function(api, method, from, to, permanent = TRUE) {
+  api$redirect(method, from, to, permanent)
+  api
+}

R/parse_plumber_file.R

@@ -96,6 +96,9 @@ parse_plumber_file <- function(
     }
   }
 
+  redirects <- blocks[vapply(blocks, inherits, logical(1), "plumber_redirect")]
+  redirects <- unlist(redirects, recursive = FALSE)
+
   list(
     route = route,
     header_route = header_route,
@@ -106,6 +109,7 @@ parse_plumber_file <- function(
       logical(1),
       "message_call"
     )],
+    redirects = redirects,
     api = c(globals, paths),
     modifiers = modifier
   )
@@ -116,11 +120,13 @@ parse_block <- function(block, route, header_route, env = caller_env()) {
   tags <- vapply(block$tags, `[[`, character(1), "tag")
   values <- lapply(block$tags, `[[`, "raw")
   if (any(tags == "assets")) {
-    parse_asset_block(call, block, tags, values, header_route, env)
+    parse_asset_block(call, block, tags, values, route, env)
   } else if (any(tags == "statics")) {
     parse_static_block(call, block, tags, values, env)
   } else if (any(tags == "message")) {
     parse_message_block(call, block, tags, values)
+  } else if (any(tags == "redirect")) {
+    parse_redirect_block(call, block, tags, values)
   } else if (any(tags == "plumber")) {
     parse_plumber_block(call, tags)
   } else if (
@@ -290,3 +296,25 @@ parse_message_block <- function(call, block, tags, values) {
   }
   structure(call, class = "message_call")
 }
+
+parse_redirect_block <- function(call, block, tags, values) {
+  res <- lapply(values[tags == "redirect"], function(x) {
+    x <- stringi::stri_split_fixed(x, " ", n = 3)[[1]]
+    if (length(x) != 3) {
+      cli::cli_warn(c(
+        "Malformed {.field @redirect} tag",
+        i = "The format must conform to: <method> <from path> <to path>"
+      ))
+      return(NULL)
+    }
+    is_permanent <- grepl("^\\!", x[1])
+    x[1] <- sub("!", "", x[1], fixed = TRUE)
+    list(
+      method = x[1],
+      from = x[2],
+      to = x[3],
+      permanent = is_permanent
+    )
+  })
+  class(res) <- "plumber2_redirect"
+}

R/roxygen_tags.R

@@ -138,7 +138,7 @@ roxy_tag_parse.roxy_tag_message <- function(x) {
   x
 }
 
-## Asset annotations ---------------------------------------------------------
+## Asset annotations -----------------------------------------------------------
 
 #' @export
 #' @importFrom roxygen2 roxy_tag_parse
@@ -156,7 +156,15 @@ roxy_tag_parse.roxy_tag_except <- function(x) {
   x
 }
 
-## Other annotations ---------------------------------------------------------
+## Redirect annotations --------------------------------------------------------
+
+#' @export
+#' @importFrom roxygen2 roxy_tag_parse
+roxy_tag_parse.roxy_tag_redirect <- function(x) {
+  x
+}
+
+## Other annotations -----------------------------------------------------------
 
 #' @export
 #' @importFrom roxygen2 roxy_tag_parse
@@ -181,8 +189,3 @@ roxy_tag_parse.roxy_tag_rejectMissingMethods <- function(x) {
 roxy_tag_parse.roxy_tag_routeName <- function(x) {
   x
 }
-#' @export
-#' @importFrom roxygen2 roxy_tag_parse
-roxy_tag_parse.roxy_tag_logger <- function(x) {
-  x
-}

_pkgdown.yml

@@ -44,6 +44,7 @@ reference:
       - api_assets
       - api_message
       - api_add_route
+      - api_redirect
   - title: "Parsers"
     contents:
       - register_parser