Represent running servers as R6 objects

DESCRIPTION

@@ -21,6 +21,7 @@ Depends:
 Imports:
     Rcpp (>= 0.11.0),
     utils,
+    R6,
     promises,
     later (>= 0.7.3)
 LinkingTo: Rcpp, BH, later
@@ -30,3 +31,8 @@ RoxygenNote: 6.1.0.9000
 Suggests:
     testthat,
     callr
+Collate:
+    'RcppExports.R'
+    'server.R'
+    'httpuv.R'
+    'utils.R'

NAMESPACE

@@ -1,16 +1,15 @@
 # Generated by roxygen2: do not edit by hand
 
-export(addStaticPaths)
+export(WebServer)
 export(decodeURI)
 export(decodeURIComponent)
 export(encodeURI)
 export(encodeURIComponent)
 export(getRNGState)
-export(getStaticPaths)
+export(getStaticPaths_)
 export(interrupt)
 export(ipFamily)
 export(rawToBase64)
-export(removeStaticPaths)
 export(runServer)
 export(service)
 export(startDaemonizedServer)
@@ -21,6 +20,7 @@ export(stopDaemonizedServer)
 export(stopServer)
 exportClasses(WebSocket)
 import(methods)
+importFrom(R6,R6Class)
 importFrom(Rcpp,evalCpp)
 importFrom(later,run_now)
 importFrom(promises,"%...!%")

R/RcppExports.R

@@ -17,20 +17,8 @@ makePipeServer <- function(name, mask, onHeaders, onBodyData, onRequest, onWSOpe
     .Call('_httpuv_makePipeServer', PACKAGE = 'httpuv', name, mask, onHeaders, onBodyData, onRequest, onWSOpen, onWSMessage, onWSClose, getStaticPaths)
 }
 
-#' Stop a server
-#' 
-#' Given a handle that was returned from a previous invocation of 
-#' \code{\link{startServer}} or \code{\link{startPipeServer}}, this closes all
-#' open connections for that server and  unbinds the port.
-#' 
-#' @param handle A handle that was previously returned from
-#'   \code{\link{startServer}} or \code{\link{startPipeServer}}.
-#'
-#' @seealso \code{\link{stopAllServers}} to stop all servers.
-#'
-#' @export
-stopServer <- function(handle) {
-    invisible(.Call('_httpuv_stopServer', PACKAGE = 'httpuv', handle))
+stopServer_ <- function(handle) {
+    invisible(.Call('_httpuv_stopServer_', PACKAGE = 'httpuv', handle))
 }
 
 #' Stop all applications
@@ -46,8 +34,8 @@ stopAllServers <- function() {
 }
 
 #' @export
-getStaticPaths <- function(handle) {
-    .Call('_httpuv_getStaticPaths', PACKAGE = 'httpuv', handle)
+getStaticPaths_ <- function(handle) {
+    .Call('_httpuv_getStaticPaths_', PACKAGE = 'httpuv', handle)
 }
 
 addStaticPaths_ <- function(handle, paths) {

R/httpuv.R

@@ -451,23 +451,7 @@ WebSocket <- setRefClass(
 #' }
 #' @export
 startServer <- function(host, port, app) {
-
-  appWrapper <- AppWrapper$new(app)
-  server <- makeTcpServer(
-    host, port,
-    appWrapper$onHeaders,
-    appWrapper$onBodyData,
-    appWrapper$call,
-    appWrapper$onWSOpen,
-    appWrapper$onWSMessage,
-    appWrapper$onWSClose,
-    appWrapper$getStaticPaths
-  )
-
-  if (is.null(server)) {
-    stop("Failed to create server")
-  }
-  return(server)
+  WebServer$new(host, port, app)
 }
 
 #' @param name A string that indicates the path for the domain socket (on 
@@ -481,21 +465,7 @@ startServer <- function(host, port, app) {
 #' @rdname startServer
 #' @export
 startPipeServer <- function(name, mask, app) {
-
-  appWrapper <- AppWrapper$new(app)
-  if (is.null(mask))
-    mask <- -1
-  server <- makePipeServer(name, mask,
-                           appWrapper$onHeaders,
-                           appWrapper$onBodyData,
-                           appWrapper$call,
-                           appWrapper$onWSOpen,
-                           appWrapper$onWSMessage,
-                           appWrapper$onWSClose)
-  if (is.null(server)) {
-    stop("Failed to create server")
-  }
-  return(server)
+  PipeServer$new(name, mask, app)
 }
 
 #' Process requests
@@ -646,30 +616,6 @@ rawToBase64 <- function(x) {
 #' @export
 startDaemonizedServer <- startServer
 
-#' Stop a running daemonized server in Unix environments (deprecated)
-#'
-#' This function will be removed in a future release of httpuv. Instead, use
-#' \code{\link{stopServer}}.
-#'
-#' @inheritParams stopServer
-#'
-#' @export
-stopDaemonizedServer <- stopServer
-
-
-
-#' @export
-addStaticPaths <- function(handle, paths) {
-  paths <- normalizeStaticPaths(paths)
-  invisible(addStaticPaths_(handle, paths))
-}
-
-#' @export
-removeStaticPaths <- function(handle, paths) {
-  paths <- as.character(paths)
-  invisible(removeStaticPaths_(handle, paths))
-}
-
 
 # Needed so that Rcpp registers the 'httpuv_decodeURIComponent' symbol
 legacy_dummy <- function(value){

R/server.R

@@ -0,0 +1,122 @@
+#' @importFrom R6 R6Class
+Server <- R6Class("Server",
+  cloneable = FALSE,
+  public = list(
+    stop = function() {
+      # TODO: what if is already running?
+      stopServer_(private$handle)
+    },
+    getStaticPaths = function() {
+      getStaticPaths_(private$handle)
+    },
+    addStaticPaths = function(paths) {
+      paths <- normalizeStaticPaths(paths)
+      invisible(addStaticPaths_(private$handle, paths))
+    },
+    removeStaticPaths = function(paths) {
+      paths <- as.character(paths)
+      invisible(removeStaticPaths_(private$handle, paths))
+    }
+  ),
+  private = list(
+    appWrapper = NULL,
+    handle = NULL
+  )
+)
+
+
+#' @export
+WebServer <- R6Class("WebServer",
+  cloneable = FALSE,
+  inherit = Server,
+  public = list(
+    initialize = function(host, port, app) {
+      private$host <- host
+      private$port <- port
+      private$appWrapper <- AppWrapper$new(app)
+
+      private$handle <- makeTcpServer(
+        host, port,
+        private$appWrapper$onHeaders,
+        private$appWrapper$onBodyData,
+        private$appWrapper$call,
+        private$appWrapper$onWSOpen,
+        private$appWrapper$onWSMessage,
+        private$appWrapper$onWSClose,
+        private$appWrapper$getStaticPaths
+      )
+
+      if (is.null(private$handle)) {
+        stop("Failed to create server")
+      }
+    }
+  ),
+  private = list(
+    host = NULL,
+    port = NULL
+  )
+)
+
+
+#' @export
+PipeServer <- R6Class("PipeServer",
+  cloneable = FALSE,
+  inherit = Server,
+  public = list(
+    initialize = function(name, mask, app) {
+      private$name <- name
+      if (is.null(private$mask)) {
+        private$mask <- -1
+      }
+      private$appWrapper <- AppWrapper$new(app)
+
+      private$handle <- makePipeServer(
+        name, mask,
+        private$appWrapper$onHeaders,
+        private$appWrapper$onBodyData,
+        private$appWrapper$call,
+        private$appWrapper$onWSOpen,
+        private$appWrapper$onWSMessage,
+        private$appWrapper$onWSClose
+      )
+      if (is.null(private$handle)) {
+        stop("Failed to create server")
+      }
+    }
+  ),
+  private = list(
+    name = NULL,
+    mask = NULL
+  )
+)
+
+
+#' Stop a server
+#' 
+#' Given a handle that was returned from a previous invocation of 
+#' \code{\link{startServer}} or \code{\link{startPipeServer}}, this closes all
+#' open connections for that server and  unbinds the port.
+#' 
+#' @param handle A handle that was previously returned from
+#'   \code{\link{startServer}} or \code{\link{startPipeServer}}.
+#'
+#' @seealso \code{\link{stopAllServers}} to stop all servers.
+#'
+#' @export
+stopServer <- function(server) {
+  if (!inherits(server, "Server")) {
+    stop("Object must be an object of class Server.")
+  }
+  server$stop()
+}
+
+
+#' Stop a running daemonized server in Unix environments (deprecated)
+#'
+#' This function will be removed in a future release of httpuv. Instead, use
+#' \code{\link{stopServer}}.
+#'
+#' @inheritParams stopServer
+#'
+#' @export
+stopDaemonizedServer <- stopServer

httpuv.Rproj

@@ -16,4 +16,4 @@ AutoAppendNewline: Yes
 
 BuildType: Package
 PackageInstallArgs: --no-multiarch --with-keep.source
-PackageRoxygenize: rd,namespace
+PackageRoxygenize: rd,collate,namespace

src/RcppExports.cpp

@@ -67,13 +67,13 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
-// stopServer
-void stopServer(std::string handle);
-RcppExport SEXP _httpuv_stopServer(SEXP handleSEXP) {
+// stopServer_
+void stopServer_(std::string handle);
+RcppExport SEXP _httpuv_stopServer_(SEXP handleSEXP) {
 BEGIN_RCPP
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP);
-    stopServer(handle);
+    stopServer_(handle);
     return R_NilValue;
 END_RCPP
 }
@@ -86,14 +86,14 @@ BEGIN_RCPP
     return R_NilValue;
 END_RCPP
 }
-// getStaticPaths
-Rcpp::CharacterVector getStaticPaths(std::string handle);
-RcppExport SEXP _httpuv_getStaticPaths(SEXP handleSEXP) {
+// getStaticPaths_
+Rcpp::CharacterVector getStaticPaths_(std::string handle);
+RcppExport SEXP _httpuv_getStaticPaths_(SEXP handleSEXP) {
 BEGIN_RCPP
     Rcpp::RObject rcpp_result_gen;
     Rcpp::RNGScope rcpp_rngScope_gen;
     Rcpp::traits::input_parameter< std::string >::type handle(handleSEXP);
-    rcpp_result_gen = Rcpp::wrap(getStaticPaths(handle));
+    rcpp_result_gen = Rcpp::wrap(getStaticPaths_(handle));
     return rcpp_result_gen;
 END_RCPP
 }
@@ -226,9 +226,9 @@ static const R_CallMethodDef CallEntries[] = {
     {"_httpuv_closeWS", (DL_FUNC) &_httpuv_closeWS, 3},
     {"_httpuv_makeTcpServer", (DL_FUNC) &_httpuv_makeTcpServer, 9},
     {"_httpuv_makePipeServer", (DL_FUNC) &_httpuv_makePipeServer, 9},
-    {"_httpuv_stopServer", (DL_FUNC) &_httpuv_stopServer, 1},
+    {"_httpuv_stopServer_", (DL_FUNC) &_httpuv_stopServer_, 1},
     {"_httpuv_stopAllServers", (DL_FUNC) &_httpuv_stopAllServers, 0},
-    {"_httpuv_getStaticPaths", (DL_FUNC) &_httpuv_getStaticPaths, 1},
+    {"_httpuv_getStaticPaths_", (DL_FUNC) &_httpuv_getStaticPaths_, 1},
     {"_httpuv_addStaticPaths_", (DL_FUNC) &_httpuv_addStaticPaths_, 2},
     {"_httpuv_removeStaticPaths_", (DL_FUNC) &_httpuv_removeStaticPaths_, 2},
     {"_httpuv_base64encode", (DL_FUNC) &_httpuv_base64encode, 1},