First working version supporting node middlewares

packages.dhall

@@ -1,5 +1,6 @@
 let upstream =
-      https://github.com/purescript/package-sets/releases/download/psc-0.15.0-20220525/packages.dhall
+      https://github.com/purescript/package-sets/releases/download/psc-0.15.4-20220805/packages.dhall
-        sha256:5facfdf9c35801a0e6a41b08b4293f947743007a9224a2a3d7694d87a44a7f28
+        sha256:c80e241af3ba62fc42284b9bc26b4c9bd4525eebe4ab0e9198c9bbeac102f656
 
 in  upstream
+  with untagged-union = ../purescript-untagged-union/spago.dhall as Location

spago.dhall

@@ -5,12 +5,17 @@
   , "bifunctors"
   , "console"
   , "control"
+  , "debug"
   , "effect"
   , "either"
+  , "exceptions"
   , "foldable-traversable"
   , "foreign-object"
+  , "functions"
   , "js-uri"
   , "justifill"
+  , "lists"
+  , "literals"
   , "maybe"
   , "newtype"
   , "node-buffer"
@@ -26,10 +31,14 @@
   , "record"
   , "refs"
   , "routing-duplex"
+  , "safe-coerce"
   , "strings"
   , "transformers"
   , "tuples"
   , "type-equality"
+  , "typelevel-prelude"
+  , "unsafe-coerce"
+  , "untagged-union"
   ]
 , packages = ./packages.dhall
 , sources = [ "src/**/*.purs" ]

src/HTTPurple/NodeMiddleware.purs

@@ -0,0 +1,83 @@
+module HTTPurple.NodeMiddleware where
+
+import Prelude
+
+import Control.Monad.Cont (ContT(..))
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe(..))
+import Data.Newtype (class Newtype)
+import Data.Show.Generic (genericShow)
+import Effect (Effect)
+import Effect.Exception (Error)
+import Effect.Ref as Ref
+import Effect.Uncurried (EffectFn1, EffectFn3, mkEffectFn1, runEffectFn1, runEffectFn3)
+import Literals.Undefined (Undefined, undefined)
+import Node.HTTP as HTTP
+import Prim.Row (class Union)
+import Untagged.Union (type (|+|), UndefinedOr, asOneOf, uorToMaybe)
+
+newtype NodeMiddleware :: forall k. k -> Type
+newtype NodeMiddleware extended =
+  NodeMiddleware (EffectFn3 HTTP.Request HTTP.Response (EffectFn1 (UndefinedOr Error) Unit) (Effect Unit))
+
+derive instance Newtype (NodeMiddleware extended) _
+
+type MiddlewareResultR =
+  (request :: HTTP.Request, response :: HTTP.Response, middlewareResult :: NextInvocation)
+
+newtype MiddlewareResult :: forall k. k -> Type
+newtype MiddlewareResult input = MiddlewareResult { | MiddlewareResultR }
+
+data NextInvocation = NotCalled | ProcessingFailed Error | ProcessingSucceeded
+
+derive instance Generic NextInvocation _
+instance Show NextInvocation where
+  show = genericShow
+
+usingContinuation ::
+  forall input thru tmp tmp2 output.
+  Union input thru tmp =>
+  Union tmp tmp2 output =>
+  NodeMiddleware thru ->
+  MiddlewareResult input ->
+  (MiddlewareResult input -> Effect (MiddlewareResult output)) ->
+  Effect (MiddlewareResult output)
+usingContinuation (NodeMiddleware middleware) reqResp@(MiddlewareResult { request, response }) nextHandler = do
+  middlewareResult <- callMiddleware reqResp
+  case middlewareResult of
+    res@(ProcessingSucceeded) ->
+      nextHandler (MiddlewareResult { request, response, middlewareResult: res })
+    res@(ProcessingFailed _) -> pure (MiddlewareResult { request, response, middlewareResult: res })
+    res@(NotCalled) -> pure (MiddlewareResult { request, response, middlewareResult: res })
+  where
+  callMiddleware :: MiddlewareResult input -> Effect (NextInvocation)
+  callMiddleware (MiddlewareResult { request: rIn, response: rOut }) = do
+    ref <- Ref.new NotCalled
+    let
+      next :: EffectFn1 (UndefinedOr Error) Unit
+      next = mkEffectFn1 \error -> case uorToMaybe error of
+        Just err -> Ref.write (ProcessingFailed err) ref
+        Nothing -> Ref.write (ProcessingSucceeded) ref
+    _ <- runEffectFn3 middleware rIn rOut next
+    Ref.read ref
+
+class UsingMiddleware :: Row Type -> Row Type -> Row Type -> Constraint
+class UsingMiddleware input thru output | input thru -> output where
+  usingMiddleware ::
+    NodeMiddleware thru ->
+    MiddlewareResult input ->
+    ContT (MiddlewareResult output) Effect (MiddlewareResult input)
+
+instance (Union input thru tmp, Union tmp tmp2 output) => UsingMiddleware input thru output where
+  usingMiddleware nodeMiddleware reqResp = ContT $ usingContinuation nodeMiddleware reqResp
+
+type NextHandlerArg = Undefined |+| Error
+
+dontCallNext :: forall (m :: Type -> Type). Applicative m => m Unit
+dontCallNext = pure unit
+
+callNext :: EffectFn1 NextHandlerArg Unit -> Effect Unit
+callNext next = runEffectFn1 next (asOneOf $ undefined)
+
+callNextWithError :: EffectFn1 NextHandlerArg Unit -> Error -> Effect Unit
+callNextWithError next err = runEffectFn1 next (asOneOf err)

src/HTTPurple/Record/Extra.js

@@ -0,0 +1,8 @@
+
+export const pickFn = function(ks, r) {
+    var copy = {};
+    for(var i = 0; i < ks.length; i++) {
+        copy[ks[i]] = r[ks[i]];
+    }
+    return copy;
+  };

src/HTTPurple/Record/Extra.purs

@@ -0,0 +1,49 @@
+module HTTPurple.Record.Extra where
+
+import Prelude
+
+import Data.Array (fromFoldable)
+import Data.Function.Uncurried (Fn2, runFn2)
+import Data.List (List, (:))
+import Data.Symbol (class IsSymbol, reflectSymbol)
+import Prim.Row as Row
+import Prim.RowList as RL
+import Type.Proxy (Proxy(..))
+
+class Keys (xs :: RL.RowList Type) where
+  keysImpl :: Proxy xs -> List String
+
+instance Keys RL.Nil where
+  keysImpl _ = mempty
+
+instance
+  ( IsSymbol name
+  , Keys tail
+  ) =>
+  Keys (RL.Cons name ty tail) where
+  keysImpl _ = first : rest
+    where
+    first = reflectSymbol (Proxy :: _ name)
+    rest = keysImpl (Proxy :: _ tail)
+
+keys ::
+  forall g row rl.
+  RL.RowToList row rl =>
+  Keys rl =>
+  g row -- this will work for any type with the row as a param!
+    ->
+  List String
+keys _ = keysImpl (Proxy :: _ rl)
+
+foreign import pickFn :: forall r1 r2. Fn2 (Array String) (Record r1) (Record r2)
+
+pick ::
+  forall a r b l.
+  Row.Union b r a =>
+  RL.RowToList b l =>
+  Keys l =>
+  Record a ->
+  Record b
+pick = runFn2 pickFn ks
+  where
+  ks = fromFoldable $ keys (Proxy :: _ b)

src/HTTPurple/Request.purs

@@ -1,16 +1,22 @@
 module HTTPurple.Request
-  ( Request
+  ( ExtRequest(..)
+  , Request
+  , RequestR
   , fromHTTPRequest
+  , fromHTTPRequestExt
+  , fromHTTPRequestUnit
   , fullPath
   ) where
 
 import Prelude
 
-import Data.Bifunctor (bimap)
+import Data.Bifunctor (rmap)
+import Data.Bitraversable (bitraverse)
 import Data.Either (Either)
+import Data.Newtype (class Newtype)
 import Data.String (joinWith)
 import Effect.Aff (Aff)
-import Effect.Class (liftEffect)
+import Effect.Class (class MonadEffect, liftEffect)
 import Foreign.Object (isEmpty, toArrayWithKey)
 import HTTPurple.Body (RequestBody)
 import HTTPurple.Body (read) as Body
@@ -22,17 +28,22 @@ import HTTPurple.Path (Path)
 import HTTPurple.Path (read) as Path
 import HTTPurple.Query (Query)
 import HTTPurple.Query (read) as Query
+import HTTPurple.Record.Extra (pick)
+import HTTPurple.Record.Extra as Extra
 import HTTPurple.Utils (encodeURIComponent)
 import HTTPurple.Version (Version)
 import HTTPurple.Version (read) as Version
 import Node.HTTP (Request) as HTTP
 import Node.HTTP (requestURL)
+import Prim.Row (class Nub, class Union)
+import Prim.RowList (class RowToList)
+import Record (merge)
 import Routing.Duplex as RD
+import Type.Prelude (Proxy)
+import Unsafe.Coerce (unsafeCoerce)
 
--- | The `Request` type is a `Record` type that includes fields for accessing
+type RequestR route r =
--- | the different parts of the HTTP request.
+  ( method :: Method
-type Request route =
-  { method :: Method
   , path :: Path
   , query :: Query
   , route :: route
@@ -40,36 +51,71 @@ type Request route =
   , body :: RequestBody
   , httpVersion :: Version
   , url :: String
-  }
+  | r
+  )
+
+-- | The `Request` type is a `Record` type that includes fields for accessing
+-- | the different parts of the HTTP request.
+type Request route = { | RequestR route () }
+
+newtype ExtRequest :: Type -> Row Type -> Type
+newtype ExtRequest route ext = ExtRequest { | RequestR route ext }
+
+derive instance Newtype (ExtRequest route ext) _
 
 -- | Return the full resolved path, including query parameters. This may not
 -- | match the requested path--for instance, if there are empty path segments in
 -- | the request--but it is equivalent.
-fullPath :: forall route. Request route -> String
+fullPath :: forall r. { path :: Path, query :: Query | r } -> String
-fullPath request = "/" <> path <> questionMark <> queryParams
+fullPath { path: p, query } = "/" <> path <> questionMark <> queryParams
   where
-  path = joinWith "/" request.path
+  path = joinWith "/" p
-  questionMark = if isEmpty request.query then "" else "?"
+  questionMark = if isEmpty query then "" else "?"
   queryParams = joinWith "&" queryParamsArr
-  queryParamsArr = toArrayWithKey stringifyQueryParam request.query
+  queryParamsArr = toArrayWithKey stringifyQueryParam query
   stringifyQueryParam key value = encodeURIComponent key <> "=" <> encodeURIComponent value
 
--- | Given an HTTP `Request` object, this method will convert it to an HTTPurple
+mkRequest :: forall route m. MonadEffect m => HTTP.Request -> route -> m (Request route)
--- | `Request` object.
+mkRequest request route = do
-fromHTTPRequest :: forall route. RD.RouteDuplex' route -> HTTP.Request -> Aff (Either (Request Unit) (Request route))
-fromHTTPRequest route request = do
   body <- liftEffect $ Body.read request
-  let
+  pure
-    mkRequest :: forall r. r -> Request r
-    mkRequest r =
     { method: Method.read request
     , path: Path.read request
     , query: Query.read request
-      , route: r
+    , route: route
     , headers: Headers.read request
     , body
     , httpVersion: Version.read request
     , url: requestURL request
     }
-  pure $ bimap (const $ mkRequest unit) mkRequest $ RD.parse route (requestURL request)
 
+-- | Given an HTTP `Request` object, this method will convert it to an HTTPurple
+-- | `Request` object.
+fromHTTPRequest :: forall route. RD.RouteDuplex' route -> HTTP.Request -> Aff (Either (Request Unit) (Request route))
+fromHTTPRequest route request = do
+  RD.parse route (requestURL request) #
+    bitraverse (const $ mkRequest request unit) (mkRequest request)
+
+fromHTTPRequestUnit :: HTTP.Request -> Aff (Request Unit)
+fromHTTPRequestUnit request = mkRequest request unit
+
+fromHTTPRequestExt ::
+  forall ctx ctxRL thru route.
+  Union ctx thru ctx =>
+  Nub (RequestR route ctx) (RequestR route ctx) =>
+  RowToList ctx ctxRL =>
+  Extra.Keys ctxRL =>
+  RD.RouteDuplex' route ->
+  Proxy ctx ->
+  HTTP.Request ->
+  Aff (Either (Request Unit) (ExtRequest route ctx))
+fromHTTPRequestExt route _ nodeRequest = do
+  let
+    extension :: Record ctx
+    extension = pick (unsafeCoerce nodeRequest :: Record ctx)
+
+    addExtension :: Request route -> ExtRequest route ctx
+    addExtension = flip merge extension >>> ExtRequest
+
+  request <- fromHTTPRequest route nodeRequest
+  pure $ rmap addExtension request

src/HTTPurple/Server.purs

@@ -5,22 +5,29 @@ module HTTPurple.Server
   , RoutingSettings
   , RoutingSettingsR
   , ServerM
+  , defaultMiddlewareErrorHandler
   , serve
+  , serveWithMiddleware
   ) where
 
 import Prelude
 
+import Control.Monad.Cont (ContT, runContT)
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Options ((:=))
 import Data.Posix.Signal (Signal(..))
 import Data.Profunctor.Choice ((|||))
+import Debug (spy)
 import Effect (Effect)
-import Effect.Aff (catchError, message, runAff)
+import Effect.Aff (Aff, catchError, message, runAff)
 import Effect.Class (liftEffect)
 import Effect.Class.Console (log)
 import Effect.Console (error)
-import HTTPurple.Request (Request, fromHTTPRequest)
+import Effect.Exception (Error)
-import HTTPurple.Response (ResponseM, internalServerError, notFound, send)
+import HTTPurple.NodeMiddleware (MiddlewareResult(..), NextInvocation(..))
+import HTTPurple.Record.Extra as Extra
+import HTTPurple.Request (ExtRequest, Request, RequestR, fromHTTPRequest, fromHTTPRequestExt, fromHTTPRequestUnit)
+import HTTPurple.Response (Response, ResponseM, internalServerError, notFound, send)
 import Justifill (justifill)
 import Justifill.Fillable (class FillableFields)
 import Justifill.Justifiable (class JustifiableFields)
@@ -31,9 +38,13 @@ import Node.HTTP (close, listen)
 import Node.HTTP.Secure (cert, certString, key, keyString)
 import Node.HTTP.Secure (createServer) as HTTPS
 import Node.Process (onSignal)
-import Prim.Row (class Union)
+import Prim.Row (class Nub, class Union)
 import Prim.RowList (class RowToList)
+import Record (merge)
 import Routing.Duplex as RD
+import Safe.Coerce (coerce)
+import Type.Prelude (Proxy(..))
+import Type.Row (type (+))
 
 -- | The `ServerM` is just an `Effect` containing a callback to close the
 -- | server. This type is the return type of the HTTPurple serve and related
@@ -62,14 +73,32 @@ type RoutingSettingsR route =
 
 type RoutingSettings route = { | RoutingSettingsR route }
 
+type ExtRoutingSettingsR route output r =
+  ( route :: RD.RouteDuplex' route
+  , router :: ExtRequest route output -> ResponseM
+  | r
+  )
+
+type MiddlewareSettingsR input output =
+  ( middleware :: MiddlewareResult input -> ContT (MiddlewareResult output) Effect (MiddlewareResult input)
+  , middlewareErrorHandler :: Error -> Request Unit -> Aff Response
+  )
+
+type ExtRoutingSettings route input output = { | ExtRoutingSettingsR route output + MiddlewareSettingsR input output }
+
 -- | Given a router, handle unhandled exceptions it raises by
 -- | responding with 500 Internal Server Error.
-onError500 :: forall route. (Request route -> ResponseM) -> Request route -> ResponseM
+onError500 :: forall request. (request -> ResponseM) -> request -> ResponseM
 onError500 router request =
   catchError (router request) \err -> do
     liftEffect $ error $ message err
     internalServerError "Internal server error"
 
+defaultMiddlewareErrorHandler :: Error -> Request Unit -> Aff Response
+defaultMiddlewareErrorHandler err _ = do
+  liftEffect $ error $ message err
+  internalServerError "Internal server error"
+
 -- | This function takes a method which takes a `Request` and returns a
 -- | `ResponseM`, an HTTP `Request`, and an HTTP `Response`. It runs the
 -- | request, extracts the `Response` from the `ResponseM`, and sends the
@@ -88,6 +117,62 @@ handleRequest { route, router, notFoundHandler } request httpresponse =
     >>= (notFoundHandler ||| onError500 router)
     >>= send httpresponse
 
+handleRequestUnit ::
+  (Request Unit -> ResponseM) ->
+  HTTP.Request ->
+  HTTP.Response ->
+  Effect Unit
+handleRequestUnit router request httpresponse =
+  void $ runAff (\_ -> pure unit) $ fromHTTPRequestUnit request
+    >>= (onError500 router)
+    >>= send httpresponse
+
+handleExtRequest ::
+  forall ctx ctxRL thru route.
+  Union ctx thru ctx =>
+  RowToList ctx ctxRL =>
+  Extra.Keys ctxRL =>
+  Nub (RequestR route ctx) (RequestR route ctx) =>
+  { route :: RD.RouteDuplex' route
+  , router :: ExtRequest route ctx -> ResponseM
+  , notFoundHandler :: Request Unit -> ResponseM
+  } ->
+  HTTP.Request ->
+  HTTP.Response ->
+  Aff Unit
+handleExtRequest { route, router, notFoundHandler } req resp = do
+  httpurpleReq <- fromHTTPRequestExt route (Proxy :: Proxy ctx) req
+  httpurpleResp <- (notFoundHandler ||| onError500 router) httpurpleReq
+  send resp httpurpleResp
+
+handleExtRequestWithMiddleware ::
+  forall input output outputRL thru route.
+  Union output thru output =>
+  RowToList output outputRL =>
+  Extra.Keys outputRL =>
+  Nub (RequestR route output) (RequestR route output) =>
+  { route :: RD.RouteDuplex' route
+  , middleware :: MiddlewareResult input -> ContT (MiddlewareResult output) Effect (MiddlewareResult input)
+  , middlewareErrorHandler :: Error -> Request Unit -> Aff Response
+  , router :: ExtRequest route output -> ResponseM
+  , notFoundHandler :: Request Unit -> ResponseM
+  } ->
+  HTTP.Request ->
+  HTTP.Response ->
+  Effect Unit
+handleExtRequestWithMiddleware { route, middleware, middlewareErrorHandler, router, notFoundHandler } req resp = void $ runAff (\_ -> pure unit) $ do
+  eff <- liftEffect $ flip runContT (coerce >>> pure) $ middleware (MiddlewareResult { request: req, response: resp, middlewareResult: NotCalled })
+  executeHandler eff
+  where
+
+  executeHandler :: MiddlewareResult output -> Aff Unit
+  executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingFailed error }) =
+    liftEffect $ handleRequestUnit (middlewareErrorHandler error) request response
+  executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingSucceeded }) =
+    handleExtRequest { route, router, notFoundHandler } request response
+  executeHandler (MiddlewareResult { middlewareResult: NotCalled }) =
+    pure unit
+
 defaultNotFoundHandler :: forall route. Request route -> ResponseM
 defaultNotFoundHandler = const notFound
 
@@ -147,9 +232,63 @@ serve inputOptions { route, router } = do
     Nothing -> HTTP.createServer (handleRequest routingSettings)
   listen server options onStarted
   let closingHandler = close server
-  case filledOptions.closingHandler of
+  registerClosingHandler filledOptions.closingHandler closingHandler
-    Just NoClosingHandler -> pure closingHandler
+
-    _ -> do
+serveWithMiddleware ::
+  forall route from fromRL via missing missingList input output outputRL thru.
+  RowToList missing missingList =>
+  FillableFields missingList () missing =>
+  Union via missing (ListenOptionsR) =>
+  RowToList from fromRL =>
+  JustifiableFields fromRL from () via =>
+  Union output thru output =>
+  RowToList output outputRL =>
+  Extra.Keys outputRL =>
+  Nub (RequestR route output) (RequestR route output) =>
+  { | from } ->
+  ExtRoutingSettings route input output ->
+  ServerM
+serveWithMiddleware inputOptions settings = do
+  let
+    filledOptions :: ListenOptions
+    filledOptions = justifillListenOptions inputOptions
+
+    hostname = fromMaybe defaultHostname filledOptions.hostname
+    port = fromMaybe defaultPort filledOptions.port
+    onStarted = fromMaybe (defaultOnStart hostname port) filledOptions.onStarted
+
+    options :: HTTP.ListenOptions
+    options =
+      { hostname
+      , port
+      , backlog: filledOptions.backlog
+      }
+
+    routingSettings ::
+      { route :: RD.RouteDuplex' route
+      , middleware :: MiddlewareResult input -> ContT (MiddlewareResult output) Effect (MiddlewareResult input)
+      , middlewareErrorHandler :: Error -> Request Unit -> Aff Response
+      , router :: ExtRequest route output -> ResponseM
+      , notFoundHandler :: Request Unit -> ResponseM
+      }
+    routingSettings = merge settings { notFoundHandler: fromMaybe defaultNotFoundHandler filledOptions.notFoundHandler }
+
+    sslOptions = { certFile: _, keyFile: _ } <$> filledOptions.certFile <*> filledOptions.keyFile
+  server <- case sslOptions of
+    Just { certFile, keyFile } ->
+      do
+        cert' <- readTextFile UTF8 certFile
+        key' <- readTextFile UTF8 keyFile
+        let sslOpts = key := keyString key' <> cert := certString cert'
+        HTTPS.createServer sslOpts (handleExtRequestWithMiddleware routingSettings)
+    Nothing -> HTTP.createServer (handleExtRequestWithMiddleware routingSettings)
+  listen server options onStarted
+  let closingHandler = close server
+  registerClosingHandler filledOptions.closingHandler closingHandler
+
+registerClosingHandler :: Maybe ClosingHandler -> (Effect Unit -> Effect Unit) -> ServerM
+registerClosingHandler (Just NoClosingHandler) closingHandler = pure closingHandler
+registerClosingHandler _ closingHandler = do
   onSignal SIGINT $ closingHandler $ log "Aye, stopping service now. Goodbye!"
   onSignal SIGTERM $ closingHandler $ log "Arrgghh I got stabbed in the back 🗡 ... good...bye..."
   pure closingHandler

src/Middleware.purs

@@ -0,0 +1,66 @@
+module Middleware
+  ( MiddlewareProcessing(..)
+  , NodeMiddleware
+  , using
+  , usingContinuation
+  ) where
+
+import Prelude
+
+import Control.Monad.Cont (ContT(..))
+import Data.Tuple.Nested (type (/\), (/\))
+import Debug (spy)
+import Effect (Effect)
+import Effect.Aff (launchAff_)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Ref as Ref
+import HTTPurple.Request (Request, fromHTTPRequest)
+import HTTPurple.Response (Response, send)
+import Node.HTTP as HTTP
+import Routing.Duplex (RouteDuplex')
+
+type NodeMiddleware = HTTP.Request -> HTTP.Response -> Effect Unit -> Effect Unit
+
+data MiddlewareProcessing = NotStarted | ProcessingFailed | ProcessingSucceeded (HTTP.Request /\ HTTP.Response)
+
+usingContinuation ::
+  NodeMiddleware ->
+  (HTTP.Request /\ HTTP.Response) ->
+  ((HTTP.Request /\ HTTP.Response) -> Effect MiddlewareProcessing) ->
+  Effect MiddlewareProcessing
+usingContinuation middleware reqResp nextHandler = do
+  middlewareResult <- callMiddleware reqResp
+  case middlewareResult of
+    res@(ProcessingSucceeded newReqResp) -> let _ = spy "Next called" res in nextHandler newReqResp
+    res -> let _ = spy "Next not called" res in pure res
+  where
+  callMiddleware :: HTTP.Request /\ HTTP.Response -> Effect (MiddlewareProcessing)
+  callMiddleware (req /\ resp) = do
+    ref <- Ref.new NotStarted
+    let
+      next :: Effect Unit
+      next = Ref.write (ProcessingSucceeded reqResp) ref
+    middleware req resp next
+    value <- Ref.read ref
+    pure value
+
+using ::
+  (HTTP.Request -> HTTP.Response -> Effect Unit -> Effect Unit) ->
+  HTTP.Request /\ HTTP.Response ->
+  ContT MiddlewareProcessing Effect (HTTP.Request /\ HTTP.Response)
+using nodeMiddleware reqResp = ContT $ usingContinuation nodeMiddleware reqResp
+
+type Handler route m = Request route -> m Response
+
+-- runHandler ::
+--   forall route m.
+--   MonadAff m =>
+--   RouteDuplex' route ->
+--   Handler route m ->
+--   HTTP.Request ->
+--   HTTP.Response ->
+--   Effect Unit
+-- runHandler rd handler req resp = launchAff_ do
+--   httpurpleReq <- fromHTTPRequest rd req
+--   httpurpleResp <- handler httpurpleReq
+--   send resp httpurpleResp