R/middleware_core.R

In Bart6114/jug: A Simple Web Framework for R

library(R6)

#' Middleware class
#'
#' @import R6
Middleware<-
  R6Class("Middleware",
          public=list(
            path=NULL,
            func=NULL,
            method=NULL,
            protocol=NULL,
            initialize=function(func, path, method, websocket){
              self$func=func
              self$path=path
              self$method=method
              self$protocol=if(websocket) "websocket" else "http"
            }
          ))


#' Internal function to add middleware
#'
#' @param jug the jug instance
#' @param func the function to bind
#' @param path the path to bind to
#' @param method the method to bind to
#' @param websocket should the middleware bind to the websocket protocol
add_middleware<-function(jug, func, path=NULL, method=NULL, websocket=FALSE){
  method<-if(!is.null(method)) toupper(method) else NULL
  mw<-Middleware$new(func, path, method, websocket)

  jug$request_handler$add_middleware(mw)

  jug
}

#' Function to add GET-binding middleware
#'
#' The params to this function are slightly different from \code{post}, \code{put} and the like due to \code{get} being a base function.
#'
#' @param object the jug object
#' @param ... first argument should be the \code{path} followed by middelware functions (order matters) to bind to the path (will receive the params \code{req}, \code{res} and \code{err})
#'
#' @seealso \code{\link{post}}, \code{\link{put}}, \code{\link{delete}}, \code{\link{use}}, \code{\link{ws}}
#' @export
get<-function(object, ...) UseMethod("get")

#' @export
get.default <- function(object, ...) base::get(object, ...)


#' @describeIn get Function to add GET-binding middleware
#' @export
get.Jug<-function(object, ...){
  funcs<-list(...)
  path<-funcs[[1]]
  funcs<-funcs[-1]

  lapply(funcs, function(mw_func) add_middleware(object, mw_func, path, method="GET"))

  object
}

#' Function to add POST-binding middleware
#'
#' @param jug the jug object
#' @param path the path to bind to
#' @param ... functions (order matters) to bind to the path (will receive the params \code{req}, \code{res} and \code{err})
#'
#' @seealso \code{\link{get}}, \code{\link{put}}, \code{\link{delete}}, \code{\link{use}}, \code{\link{ws}}
#' @export
post<-function(jug, path, ...){
  lapply(list(...), function(mw_func) add_middleware(jug, mw_func, path, method="POST"))

  jug
}

#' Function to add PUT-binding middleware
#'
#' @param jug the jug object
#' @param path the path to bind to
#' @param ... functions (order matters) to bind to the path (will receive the params \code{req}, \code{res} and \code{err})
#'
#' @seealso \code{\link{post}}, \code{\link{get}}, \code{\link{delete}}, \code{\link{use}}, \code{\link{ws}}
#' @export
put<-function(jug, path, ...){
  lapply(list(...), function(mw_func) add_middleware(jug, mw_func, path, method="PUT"))

  jug
}

#' Function to add DELETE-binding middleware
#'
#' @param jug the jug object
#' @param path the path to bind to
#' @param ... functions (order matters) to bind to the path (will receive the params \code{req}, \code{res} and \code{err})
#'
#' @seealso \code{\link{post}}, \code{\link{put}}, \code{\link{get}}, \code{\link{use}}, \code{\link{ws}}
#' @export
delete<-function(jug, path, ...){
  lapply(list(...), function(mw_func) add_middleware(jug, mw_func, path, method="DELETE"))

  jug
}


#' Function to add request method insensitive middleware
#'
#' @param jug the jug object
#' @param path the path to bind to
#' @param ... functions (order matters) to bind to the path (will receive the params \code{req}, \code{res} and \code{err})
#' @param method the method to bind to, defauts to \code{NULL}
#'
#' @seealso \code{\link{post}}, \code{\link{put}}, \code{\link{delete}}, \code{\link{get}}, \code{\link{ws}}
#' @export
use<-function(jug, path, ..., method=NULL){
  lapply(list(...), function(mw_func) add_middleware(jug, mw_func, path, method=method))

  jug
}

#' Function to add websocket handling middleware
#'
#' @param jug the jug object
#' @param path the path to bind to
#' @param ... functions (order matters) to bind to the path (will receive the params \code{req}, \code{res} and \code{err})
#'
#' @seealso \code{\link{post}}, \code{\link{put}}, \code{\link{delete}}, \code{\link{get}}, \code{\link{get}}
#' @export
ws<-function(jug, path, ...){
  lapply(list(...), function(mw_func) add_middleware(jug, mw_func, path, method=NULL, websocket=TRUE))

  jug
}