feat: generalize ResponseM to any MonadAff

src/HTTPure.purs

@@ -45,7 +45,7 @@ import HTTPurple.NodeMiddleware
 import HTTPurple.Path (Path)
 import HTTPurple.Query (Query)
 import HTTPurple.Request (ExtRequest, Request, RequestR, fullPath)
-import HTTPurple.Response (Response, ResponseM, accepted, accepted', alreadyReported, alreadyReported', badGateway, badGateway', badRequest, badRequest', conflict, conflict', continue, continue', created, created', emptyResponse, emptyResponse', expectationFailed, expectationFailed', failedDependency, failedDependency', forbidden, forbidden', found, found', gatewayTimeout, gatewayTimeout', gone, gone', hTTPVersionNotSupported, hTTPVersionNotSupported', iMUsed, iMUsed', imATeapot, imATeapot', insufficientStorage, insufficientStorage', internalServerError, internalServerError', lengthRequired, lengthRequired', locked, locked', loopDetected, loopDetected', methodNotAllowed, methodNotAllowed', misdirectedRequest, misdirectedRequest', movedPermanently, movedPermanently', multiStatus, multiStatus', multipleChoices, multipleChoices', networkAuthenticationRequired, networkAuthenticationRequired', noContent, noContent', nonAuthoritativeInformation, nonAuthoritativeInformation', notAcceptable, notAcceptable', notExtended, notExtended', notFound, notFound', notImplemented, notImplemented', notModified, notModified', ok, ok', partialContent, partialContent', payloadTooLarge, payloadTooLarge', paymentRequired, paymentRequired', permanentRedirect, permanentRedirect', preconditionFailed, preconditionFailed', preconditionRequired, preconditionRequired', processing, processing', proxyAuthenticationRequired, proxyAuthenticationRequired', rangeNotSatisfiable, rangeNotSatisfiable', requestHeaderFieldsTooLarge, requestHeaderFieldsTooLarge', requestTimeout, requestTimeout', resetContent, resetContent', response, response', seeOther, seeOther', serviceUnavailable, serviceUnavailable', switchingProtocols, switchingProtocols', temporaryRedirect, temporaryRedirect', tooManyRequests, tooManyRequests', uRITooLong, uRITooLong', unauthorized, unauthorized', unavailableForLegalReasons, unavailableForLegalReasons', unprocessableEntity, unprocessableEntity', unsupportedMediaType, unsupportedMediaType', upgradeRequired, upgradeRequired', useProxy, useProxy', variantAlsoNegotiates, variantAlsoNegotiates')
+import HTTPurple.Response (Response, accepted, accepted', alreadyReported, alreadyReported', badGateway, badGateway', badRequest, badRequest', conflict, conflict', continue, continue', created, created', emptyResponse, emptyResponse', expectationFailed, expectationFailed', failedDependency, failedDependency', forbidden, forbidden', found, found', gatewayTimeout, gatewayTimeout', gone, gone', hTTPVersionNotSupported, hTTPVersionNotSupported', iMUsed, iMUsed', imATeapot, imATeapot', insufficientStorage, insufficientStorage', internalServerError, internalServerError', lengthRequired, lengthRequired', locked, locked', loopDetected, loopDetected', methodNotAllowed, methodNotAllowed', misdirectedRequest, misdirectedRequest', movedPermanently, movedPermanently', multiStatus, multiStatus', multipleChoices, multipleChoices', networkAuthenticationRequired, networkAuthenticationRequired', noContent, noContent', nonAuthoritativeInformation, nonAuthoritativeInformation', notAcceptable, notAcceptable', notExtended, notExtended', notFound, notFound', notImplemented, notImplemented', notModified, notModified', ok, ok', partialContent, partialContent', payloadTooLarge, payloadTooLarge', paymentRequired, paymentRequired', permanentRedirect, permanentRedirect', preconditionFailed, preconditionFailed', preconditionRequired, preconditionRequired', processing, processing', proxyAuthenticationRequired, proxyAuthenticationRequired', rangeNotSatisfiable, rangeNotSatisfiable', requestHeaderFieldsTooLarge, requestHeaderFieldsTooLarge', requestTimeout, requestTimeout', resetContent, resetContent', response, response', seeOther, seeOther', serviceUnavailable, serviceUnavailable', switchingProtocols, switchingProtocols', temporaryRedirect, temporaryRedirect', tooManyRequests, tooManyRequests', uRITooLong, uRITooLong', unauthorized, unauthorized', unavailableForLegalReasons, unavailableForLegalReasons', unprocessableEntity, unprocessableEntity', unsupportedMediaType, unsupportedMediaType', upgradeRequired, upgradeRequired', useProxy, useProxy', variantAlsoNegotiates, variantAlsoNegotiates')
 import HTTPurple.Routes (type (<+>), catchAll, combineRoutes, mkRoute, orElse, (<+>))
 import HTTPurple.Server
   ( BasicRoutingSettings
@@ -58,6 +58,7 @@ import HTTPurple.Server
   , ServerM
   , defaultMiddlewareErrorHandler
   , serve
+  , serve'
   , serveNodeMiddleware
   )
 import HTTPurple.Status (Status)

src/HTTPurple/Request.purs

@@ -11,13 +11,16 @@ module HTTPurple.Request
 
 import Prelude
 
+import Control.Monad.Error.Class (class MonadError)
 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.Aff.Class (class MonadAff)
 import Effect.Class (class MonadEffect, liftEffect)
+import Effect.Exception (Error)
 import Foreign.Object (isEmpty, toArrayWithKey)
 import HTTPurple.Body (RequestBody)
 import HTTPurple.Body (read) as Body
@@ -97,16 +100,18 @@ mkRequest request route = do
 
 -- | Given an HTTP `Request` object, this method will convert it to an HTTPurple
 -- | `Request` object.
-fromHTTPRequest :: forall route. RD.RouteDuplex' route -> IncomingMessage IMServer -> Aff (Either (Request Unit) (Request route))
+fromHTTPRequest :: forall route m. MonadAff m => MonadError Error m => RD.RouteDuplex' route -> IncomingMessage IMServer -> m (Either (Request Unit) (Request route))
 fromHTTPRequest route request = do
   RD.parse route (IM.url request) #
     bitraverse (const $ mkRequest request unit) (mkRequest request)
 
-fromHTTPRequestUnit :: IncomingMessage IMServer -> Aff (Request Unit)
+fromHTTPRequestUnit :: forall m. MonadEffect m => IncomingMessage IMServer -> m (Request Unit)
 fromHTTPRequestUnit = flip mkRequest unit
 
 fromHTTPRequestExt ::
-  forall ctx ctxRL thru route.
+  forall ctx ctxRL thru route m.
+  MonadAff m =>
+  MonadError Error m =>
   Union ctx thru ctx =>
   Nub (RequestR route ctx) (RequestR route ctx) =>
   RowToList ctx ctxRL =>
@@ -114,7 +119,7 @@ fromHTTPRequestExt ::
   RD.RouteDuplex' route ->
   Proxy ctx ->
   IncomingMessage IMServer ->
-  Aff (Either (Request Unit) (ExtRequestNT route ctx))
+  m (Either (Request Unit) (ExtRequestNT route ctx))
 fromHTTPRequestExt route _ nodeRequest = do
   let
     extension :: Record ctx

src/HTTPurple/Response.purs

@@ -1,6 +1,5 @@
 module HTTPurple.Response
   ( Response
-  , ResponseM
   , send
   , response
   , response'
@@ -145,11 +144,6 @@ import HTTPurple.Status (Status)
 import HTTPurple.Status (accepted, alreadyReported, badGateway, badRequest, conflict, continue, created, expectationFailed, failedDependency, forbidden, found, gatewayTimeout, gone, hTTPVersionNotSupported, iMUsed, imATeapot, insufficientStorage, internalServerError, lengthRequired, locked, loopDetected, methodNotAllowed, misdirectedRequest, movedPermanently, multiStatus, multipleChoices, networkAuthenticationRequired, noContent, nonAuthoritativeInformation, notAcceptable, notExtended, notFound, notImplemented, notModified, ok, partialContent, payloadTooLarge, paymentRequired, permanentRedirect, preconditionFailed, preconditionRequired, processing, proxyAuthenticationRequired, rangeNotSatisfiable, requestHeaderFieldsTooLarge, requestTimeout, resetContent, seeOther, serviceUnavailable, switchingProtocols, temporaryRedirect, tooManyRequests, uRITooLong, unauthorized, unavailableForLegalReasons, unprocessableEntity, unsupportedMediaType, upgradeRequired, useProxy, variantAlsoNegotiates, write) as Status
 import Node.HTTP.Types (ServerResponse)
 
--- | The `ResponseM` type simply conveniently wraps up an HTTPurple monad that
--- | returns a response. This type is the return type of all router/route
--- | methods.
-type ResponseM = Aff Response
-
 -- | A `Response` is a status code, headers, and a body.
 type Response =
   { status :: Status

src/HTTPurple/Routes.purs

@@ -13,8 +13,9 @@ import Control.Alt ((<|>))
 import Data.Either (Either(..))
 import Data.Generic.Rep (class Generic)
 import Data.Profunctor.Choice ((|||))
+import Effect.Aff.Class (class MonadAff)
 import HTTPurple.Request (Request)
-import HTTPurple.Response (ResponseM)
+import HTTPurple.Response (Response)
 import Record as Record
 import Routing.Duplex as RD
 import Routing.Duplex.Generic as RG
@@ -39,11 +40,12 @@ infixr 3 combineRoutes as <+>
 
 -- | Combine two request handlers.
 orElse ::
-  forall left right.
+  forall left right m.
-  (Request left -> ResponseM) ->
+  MonadAff m =>
-  (Request right -> ResponseM) ->
+  (Request left -> m Response) ->
+  (Request right -> m Response) ->
   Request (left <+> right) ->
-  ResponseM
+  m Response
 orElse leftRouter _ request@{ route: Left l } = leftRouter $ Record.set (Proxy :: _ "route") l request
 orElse _ rightRouter request@{ route: Right r } = rightRouter $ Record.set (Proxy :: _ "route") r request
 

src/HTTPurple/Server.purs

@@ -9,26 +9,29 @@ module HTTPurple.Server
   , ServerM
   , defaultMiddlewareErrorHandler
   , serve
+  , serve'
   , serveNodeMiddleware
   ) where
 
 import Prelude
 
 import Control.Monad.Cont (runContT)
+import Control.Monad.Error.Class (class MonadError)
 import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Newtype (unwrap)
 import Data.Posix.Signal (Signal(..))
 import Data.Profunctor (lcmap)
 import Data.Profunctor.Choice ((|||))
 import Effect (Effect)
-import Effect.Aff (Aff, catchError, message, runAff)
+import Effect.Aff (Aff, catchError, launchAff_, message)
-import Effect.Class (liftEffect)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Class (class MonadEffect, liftEffect)
 import Effect.Class.Console (log)
 import Effect.Console (error)
 import Effect.Exception (Error)
 import HTTPurple.NodeMiddleware (MiddlewareResult(..), NextInvocation(..), NodeMiddlewareStack(..))
 import HTTPurple.Request (ExtRequest, ExtRequestNT, Request, RequestR, fromHTTPRequestExt, fromHTTPRequestUnit)
-import HTTPurple.Response (Response, ResponseM, internalServerError, notFound, send)
+import HTTPurple.Response (Response, internalServerError, notFound, send)
 import Justifill (justifill)
 import Justifill.Fillable (class FillableFields)
 import Justifill.Justifiable (class JustifiableFields)
@@ -58,22 +61,22 @@ type ServerM = Effect (Effect Unit -> Effect Unit)
 
 data ClosingHandler = DefaultClosingHandler | NoClosingHandler
 
-type ListenOptionsR =
+type ListenOptionsR m =
   ( hostname :: Maybe String
   , port :: Maybe Int
   , backlog :: Maybe Int
   , closingHandler :: Maybe ClosingHandler
-  , notFoundHandler :: Maybe (Request Unit -> ResponseM)
+  , notFoundHandler :: Maybe (Request Unit -> m Response)
-  , onStarted :: Maybe (Effect Unit)
+  , onStarted :: Maybe (m Unit)
   , certFile :: Maybe String
   , keyFile :: Maybe String
   )
 
-type ListenOptions = { | ListenOptionsR }
+type ListenOptions m = { | ListenOptionsR m }
 
-type RoutingSettingsR route output r =
+type RoutingSettingsR m route output r =
   ( route :: RD.RouteDuplex' route
-  , router :: ExtRequest route output -> ResponseM
+  , router :: ExtRequest route output -> m Response
   | r
   )
 
@@ -82,104 +85,112 @@ type MiddlewareSettingsR input output =
   ( nodeMiddleware :: NodeMiddlewareStack input output
   )
 
-type BasicRoutingSettings route = { | RoutingSettingsR route () () }
+type BasicRoutingSettings m route = { | RoutingSettingsR m route () () }
 
-type ExtRoutingSettings :: Type -> Row Type -> Row Type -> Type
+type ExtRoutingSettings :: (Type -> Type) -> Type -> Row Type -> Row Type -> Type
-type ExtRoutingSettings route input output = { | RoutingSettingsR route output + MiddlewareSettingsR input output }
+type ExtRoutingSettings m route input output = { | RoutingSettingsR m route output + MiddlewareSettingsR input output }
 
 -- | Given a router, handle unhandled exceptions it raises by
 -- | responding with 500 Internal Server Error.
-onError500 :: forall request. (request -> ResponseM) -> request -> ResponseM
+onError500 :: forall m request. MonadError Error m => MonadAff m => (request -> m Response) -> request -> m Response
 onError500 router request =
   catchError (router request) \err -> do
     liftEffect $ error $ message err
     internalServerError "Internal server error"
 
-defaultMiddlewareErrorHandler :: Error -> Request Unit -> Aff Response
+defaultMiddlewareErrorHandler :: forall m. MonadAff m => Error -> Request Unit -> m Response
 defaultMiddlewareErrorHandler err _ = do
   liftEffect $ error $ message err
   internalServerError "Internal server error"
 
 -- | handle requests without a routing adt.
-handleRequestUnit ::
+handleRequestUnit :: forall m.
-  (Request Unit -> ResponseM) ->
+  MonadError Error m =>
+  MonadAff m =>
+  (Request Unit -> m Response) ->
   IncomingMessage IMServer ->
   ServerResponse ->
-  Effect Unit
+  m Unit
 handleRequestUnit router request httpresponse =
-  void $ runAff (\_ -> pure unit) $ fromHTTPRequestUnit request
+  void $ fromHTTPRequestUnit request
     >>= (onError500 router)
     >>= send httpresponse
 
 -- | This function takes a record containing the 
 -- |  * route - the routing adt
 -- |  * router - the request handler (a method which takes a `Request` and returns a
--- | `ResponseM`)
+-- | `m Response`)
 -- |  * notFoundHandler - a handler to handle 404s 
 -- | as well as  an HTTP `Request` and an HTTP `Response`. It runs the
--- | request, extracts the `Response` from the `ResponseM`, and sends the
+-- | request, extracts the `Response` from the `m Response`, and sends the
 -- | `Response` to the HTTP `Response`.
 handleExtRequest ::
-  forall ctx ctxRL thru route.
+  forall m ctx ctxRL thru route.
+  MonadError Error m =>
+  MonadAff m =>
   Union ctx thru ctx =>
   RowToList ctx ctxRL =>
   Keys ctx =>
   Nub (RequestR route ctx) (RequestR route ctx) =>
   { route :: RD.RouteDuplex' route
-  , router :: ExtRequestNT route ctx -> ResponseM
+  , router :: ExtRequestNT route ctx -> m Response
-  , notFoundHandler :: Request Unit -> ResponseM
+  , notFoundHandler :: Request Unit -> m Response
   } ->
   IncomingMessage IMServer ->
   ServerResponse ->
-  Aff Unit
+  m Unit
 handleExtRequest { route, router, notFoundHandler } req resp = do
   httpurpleReq <- fromHTTPRequestExt route (Proxy :: Proxy ctx) req
   httpurpleResp <- (notFoundHandler ||| onError500 router) httpurpleReq
   send resp httpurpleResp
 
 handleRequest ::
-  forall ctx ctxRL thru route.
+  forall ctx ctxRL thru route m.
+  MonadAff m =>
+  MonadError Error m =>
   Union ctx thru ctx =>
   RowToList ctx ctxRL =>
   Keys ctx =>
   Nub (RequestR route ctx) (RequestR route ctx) =>
   { route :: RD.RouteDuplex' route
-  , router :: ExtRequestNT route ctx -> ResponseM
+  , router :: ExtRequestNT route ctx -> m Response
-  , notFoundHandler :: Request Unit -> ResponseM
+  , notFoundHandler :: Request Unit -> m Response
   } ->
   IncomingMessage IMServer ->
   ServerResponse ->
-  Effect Unit
+  m Unit
-handleRequest settings request response = void $ runAff (\_ -> pure unit) $ handleExtRequest settings request response
+handleRequest settings request response = void $ handleExtRequest settings request response
 
 handleExtRequestWithMiddleware ::
-  forall input output outputRL thru route.
+  forall input output outputRL thru route m.
+  MonadAff m =>
+  MonadError Error m =>
   Union output thru output =>
   RowToList output outputRL =>
   Keys output =>
   Nub (RequestR route output) (RequestR route output) =>
   { route :: RD.RouteDuplex' route
   , nodeMiddleware :: NodeMiddlewareStack input output
-  , router :: ExtRequestNT route output -> ResponseM
+  , router :: ExtRequestNT route output -> m Response
-  , notFoundHandler :: Request Unit -> ResponseM
+  , notFoundHandler :: Request Unit -> m Response
   } ->
   IncomingMessage IMServer ->
   ServerResponse ->
-  Effect Unit
+  m Unit
-handleExtRequestWithMiddleware { route, nodeMiddleware: NodeMiddlewareStack middleware, router, notFoundHandler } req resp = void $ runAff (\_ -> pure unit) $ do
+handleExtRequestWithMiddleware { route, nodeMiddleware: NodeMiddlewareStack middleware, router, notFoundHandler } req resp = void $ 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 output -> m Unit
   executeHandler (MiddlewareResult { request, response, middlewareResult: ProcessingFailed error }) =
-    liftEffect $ handleRequestUnit (defaultMiddlewareErrorHandler error) request response
+    handleRequestUnit (defaultMiddlewareErrorHandler 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 :: forall route m. MonadAff m => Request route -> m Response
 defaultNotFoundHandler = const notFound
 
 asExtended ::
@@ -190,25 +201,28 @@ asExtended ::
 asExtended = lcmap unwrap
 
 serveInternal ::
-  forall route from fromRL via missing missingList input output outputRL thru.
+  forall m route from fromRL via missing missingList input output outputRL thru.
+  MonadAff m =>
+  MonadError Error m =>
   RowToList missing missingList =>
   FillableFields missingList () missing =>
-  Union via missing (ListenOptionsR) =>
+  Union via missing (ListenOptionsR m) =>
   RowToList from fromRL =>
   JustifiableFields fromRL from () via =>
   Union output thru output =>
   RowToList output outputRL =>
   KeysRL outputRL =>
   Nub (RequestR route output) (RequestR route output) =>
+  (m Unit -> Aff Unit) ->
   { | from } ->
   Maybe (NodeMiddlewareStack input output) ->
   { route :: RD.RouteDuplex' route
-  , router :: ExtRequestNT route output -> ResponseM
+  , router :: ExtRequestNT route output -> m Response
   } ->
   ServerM
-serveInternal inputOptions maybeNodeMiddleware settings = do
+serveInternal performM inputOptions maybeNodeMiddleware settings = do
   let
-    filledOptions :: ListenOptions
+    filledOptions :: ListenOptions m
     filledOptions = justifill inputOptions
 
     host = fromMaybe defaultHostname filledOptions.hostname
@@ -221,52 +235,70 @@ serveInternal inputOptions maybeNodeMiddleware settings = do
       , backlog: fromMaybe 511 filledOptions.backlog
       }
 
-    routingSettings = merge settings { notFoundHandler: fromMaybe defaultNotFoundHandler filledOptions.notFoundHandler }
+    routingSettings = merge settings { notFoundHandler: fromMaybe defaultNotFoundHandler $ filledOptions.notFoundHandler }
 
-    handler = case maybeNodeMiddleware of
+    handler req rep = launchAff_ $ performM $ case maybeNodeMiddleware of
-      Just nodeMiddleware -> handleExtRequestWithMiddleware $ merge routingSettings { nodeMiddleware }
+      Just nodeMiddleware -> handleExtRequestWithMiddleware (merge routingSettings { nodeMiddleware }) req rep
-      Nothing -> handleRequest routingSettings
+      Nothing -> handleRequest routingSettings req rep
     sslOptions = { certFile: _, keyFile: _ } <$> filledOptions.certFile <*> filledOptions.keyFile
   netServer <- case sslOptions of
     Just { certFile, keyFile } -> do
-      cert' <- readFile certFile
+      cert' <- liftEffect $ readFile certFile
-      key' <- readFile keyFile
+      key' <- liftEffect $ readFile keyFile
-      server <- HTTPS.createSecureServer'
+      server <- liftEffect $ HTTPS.createSecureServer'
         { key: [ key' ]
         , cert: [ cert' ]
         }
-      server # EE.on_ HServer.requestH handler
+      liftEffect $ EE.on_ HServer.requestH handler server
       pure $ HServer.toNetServer server
     Nothing -> do
-      server <- HTTP.createServer
+      server <- liftEffect $ HTTP.createServer
-      server # EE.on_ HServer.requestH handler
+      liftEffect $ EE.on_ HServer.requestH handler server
       pure $ HServer.toNetServer server
-  netServer # EE.on_ listeningH onStarted
+  liftEffect $ EE.on_ listeningH (launchAff_ $ performM onStarted) netServer
-  listenTcp netServer options
+  liftEffect $ listenTcp netServer options
   let closingHandler = NServer.close netServer
-  liftEffect $ registerClosingHandler filledOptions.closingHandler (\eff -> eff *> closingHandler)
+  srv <- registerClosingHandler filledOptions.closingHandler (\eff -> eff *> closingHandler)
+  liftEffect srv
 
 serve ::
   forall route from fromRL via missing missingList.
   RowToList missing missingList =>
   FillableFields missingList () missing =>
-  Union via missing (ListenOptionsR) =>
+  Union via missing (ListenOptionsR Aff) =>
   RowToList from fromRL =>
   JustifiableFields fromRL from () via =>
   { | from } ->
-  BasicRoutingSettings route ->
+  BasicRoutingSettings Aff route ->
   ServerM
 serve inputOptions { route, router } = do
   let
     extendedSettings = { route, router: asExtended router }
+  serveInternal identity inputOptions Nothing extendedSettings
 
-  serveInternal inputOptions Nothing extendedSettings
+serve' ::
+  forall m route from fromRL via missing missingList.
+  MonadAff m =>
+  MonadError Error m =>
+  RowToList missing missingList =>
+  FillableFields missingList () missing =>
+  Union via missing (ListenOptionsR m) =>
+  RowToList from fromRL =>
+  JustifiableFields fromRL from () via =>
+  (m Unit -> Aff Unit) ->
+  { | from } ->
+  BasicRoutingSettings m route ->
+  ServerM
+serve' ma inputOptions { route, router } = do
+  let
+    extendedSettings = { route, router: asExtended router }
+  serveInternal ma inputOptions Nothing extendedSettings
 
 serveNodeMiddleware ::
   forall route from fromRL via missing missingList input output outputRL thru.
   RowToList missing missingList =>
   FillableFields missingList () missing =>
-  Union via missing (ListenOptionsR) =>
+  Union via missing (ListenOptionsR Aff) =>
   RowToList from fromRL =>
   JustifiableFields fromRL from () via =>
   Union output thru output =>
@@ -274,17 +306,17 @@ serveNodeMiddleware ::
   KeysRL outputRL =>
   Nub (RequestR route output) (RequestR route output) =>
   { | from } ->
-  ExtRoutingSettings route input output ->
+  ExtRoutingSettings Aff route input output ->
   ServerM
 serveNodeMiddleware inputOptions { route, router, nodeMiddleware } = do
   let
     extendedSettings = { route, router: asExtended router }
 
-  serveInternal inputOptions (Just nodeMiddleware) extendedSettings
+  serveInternal identity inputOptions (Just nodeMiddleware) extendedSettings
 
-registerClosingHandler :: Maybe ClosingHandler -> (Effect Unit -> Effect Unit) -> ServerM
+registerClosingHandler :: forall m. MonadEffect m => Maybe ClosingHandler -> (Effect Unit -> Effect Unit) -> m ServerM
-registerClosingHandler (Just NoClosingHandler) closingHandler = pure closingHandler
+registerClosingHandler (Just NoClosingHandler) closingHandler = pure $ pure closingHandler
-registerClosingHandler _ closingHandler = do
+registerClosingHandler _ closingHandler = pure $ liftEffect do
   Process.process # EE.on_ (mkSignalH SIGINT) (closingHandler $ log "Aye, stopping service now. Goodbye!")
   Process.process # EE.on_ (mkSignalH SIGTERM) (closingHandler $ log "Arrgghh I got stabbed in the back 🗡 ... good...bye...")
   pure closingHandler
@@ -295,5 +327,5 @@ defaultHostname = "0.0.0.0"
 defaultPort :: Int
 defaultPort = 8080
 
-defaultOnStart :: String -> Int -> Effect Unit
+defaultOnStart :: forall m. MonadEffect m => String -> Int -> m Unit
-defaultOnStart hostname port = log $ "HTTPurple 🪁 up and running on http://" <> hostname <> ":" <> show port
+defaultOnStart hostname port = liftEffect $ log $ "HTTPurple 🪁 up and running on http://" <> hostname <> ":" <> show port