R/plugin-dispatch.R

In tjpalanca/webtools: Web Server Tools

#' @title Dispatch Plugin
#'
#' @description
#' Contains utilities for creating and simulating requests, for use primarily
#' in [`PerfPlugin`] and [`TestPlugin`].
DispatchPlugin <- R6Class(

  classname = "DispatchPlugin",
  inherit = Plugin,

  private = list(

    # Generate a dispatch function
    dispatcher = function(router, attach, message, request, binary, close) {

      if (is.null(router)) {
        if (attach == "request") {
          assert_null(message)
          request <- request$origin
          function() {
            header <- self$fire$test_header(request)
            if (is.null(header)) {
              self$fire$test_request(request)
            } else {
              header
            }
          }
        } else if (attach == "header") {
          assert_null(message)
          request <- request$origin
          function() {
            self$fire$test_header(request)
          }
        } else if (attach == "message") {
          assert_false(is.null(message))
          function() {
            self$fire$test_message(
              request = request,
              binary  = binary,
              message = message,
              withClose = close
            )
          }
        }
      } else {
        assert_string(router)
        assert_choice(router, names(self$app$routers[[attach]]))
        function() {
          self$app$routers[[attach]][[router]]$dispatch(request)
        }
      }

    },

    # Constructs a fake request based on the parameters, for profiling
    fake_request = function(path      = "/",
                            url       = NULL,
                            method    = "get",
                            base_path = "",
                            content   = "",
                            headers   = list(),
                            trust     = TRUE,
                            ...) {

      Request$new(
        rook = fake_request(
          url         = modify_url(url %||% self$fire$url, path = path),
          method      = method,
          appLocation = base_path,
          content     = content,
          headers     = headers,
          ...
        ),
        trust = trust
      )

    }

  )
)