Make settings optional

- Add default onStarted and closingHandler
- Use justifill to easily add options
- Remove multiple serve options

docs/Examples/AsyncResponse/Main.purs

@@ -30,7 +30,9 @@ router { route: SayHello } = readTextFile UTF8 filePath >>= ok
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router } 
+  where
+  onStarted = do
     log " ┌────────────────────────────────────────────┐"
     log " │ Server now up on port 8080                 │"
     log " │                                            │"

docs/Examples/BinaryRequest/Main.purs

@@ -28,7 +28,9 @@ router { body } = toBuffer body >>= sha256sum >>> ok
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router } 
+  where
+  onStarted = do
     log " ┌─────────────────────────────────────────────────────────┐"
     log " │ Server now up on port 8080                              │"
     log " │                                                         │"

docs/Examples/BinaryResponse/Main.purs

@@ -32,7 +32,9 @@ router = const $ readFile filePath >>= ok' responseHeaders
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router } 
+  where
+  onStarted = do
     log " ┌──────────────────────────────────────┐"
     log " │ Server now up on port 8080           │"
     log " │                                      │"

docs/Examples/Chunked/Main.purs

@@ -34,7 +34,9 @@ router = const $ runScript "echo 'hello '; sleep 1; echo 'world!'" >>= ok
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router } 
+  where
+  onStarted = do
     log " ┌──────────────────────────────────────┐"
     log " │ Server now up on port 8080           │"
     log " │                                      │"

docs/Examples/CustomStack/Main.purs

@@ -42,7 +42,9 @@ sayHello _ = do
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router: readerMiddleware sayHello, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router: readerMiddleware sayHello } 
+  where
+  onStarted = do
     log " ┌───────────────────────────────────────┐"
     log " │ Server now up on port 8080            │"
     log " │                                       │"

docs/Examples/Headers/Main.purs

@@ -18,7 +18,6 @@ route = RD.root $ RG.sum
   { "SayHello": RG.noArgs
   }
 
-
 -- | The headers that will be included in every response.
 responseHeaders :: Headers
 responseHeaders = header "X-Example" "hello world!"
@@ -30,7 +29,9 @@ router { headers } = ok' responseHeaders $ headers !@ "X-Input"
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing} do
+  serve { port: 8080, onStarted } { route, router }
+  where
+  onStarted = do
     log " ┌──────────────────────────────────────────────┐"
     log " │ Server now up on port 8080                   │"
     log " │                                              │"

docs/Examples/HelloWorld/Main.purs

@@ -21,7 +21,9 @@ route = RD.root $ RG.sum
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router: const $ ok "hello world!", notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router: const $ ok "hello world!" }
+  where
+  onStarted = do
     log " ┌────────────────────────────────────────────┐"
     log " │ Server now up on port 8080                 │"
     log " │                                            │"

docs/Examples/Middleware/Main.purs

@@ -23,7 +23,6 @@ middlewareRoute = RD.root $ RG.sum
   { "Middleware": "middleware" / RG.noArgs
   }
 
-
 data SayHello = SayHello
 
 derive instance Generic SayHello _
@@ -34,7 +33,8 @@ sayHelloRoute = RD.root $ RG.sum
   }
 
 -- | A middleware that logs at the beginning and end of each request
-loggingMiddleware :: forall route.
+loggingMiddleware ::
+  forall route.
   (Request route -> ResponseM) ->
   Request route ->
   ResponseM
@@ -48,7 +48,8 @@ loggingMiddleware router request = do
 
 -- | A middleware that adds the X-Middleware header to the response, if it
 -- | wasn't already in the response
-headerMiddleware :: forall route.
+headerMiddleware ::
+  forall route.
   (Request route -> ResponseM) ->
   Request route ->
   ResponseM
@@ -60,14 +61,14 @@ headerMiddleware router request = do
 
 -- | A middleware that sends the body "Middleware!" instead of running the
 -- | router when requesting /middleware
-pathMiddleware :: forall route.
+pathMiddleware ::
+  forall route.
   (Request route -> ResponseM) ->
   Request (Middleware <+> route) ->
   ResponseM
 pathMiddleware _ { route: Left Middleware } = ok "Middleware!"
 pathMiddleware router request@{ route: Right r } = router $ Record.set (Proxy :: _ "route") r request
 
-
 -- | Say 'hello' when run, and add a default value to the X-Middleware header
 sayHello :: Request SayHello -> ResponseM
 sayHello _ = ok' (header "X-Middleware" "router") "hello"
@@ -79,7 +80,9 @@ middlewareStack = loggingMiddleware <<< headerMiddleware <<< pathMiddleware
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route: middlewareRoute <+> sayHelloRoute , router: middlewareStack sayHello, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route: middlewareRoute <+> sayHelloRoute, router: middlewareStack sayHello }
+  where
+  onStarted = do
     log " ┌───────────────────────────────────────┐"
     log " │ Server now up on port 8080            │"
     log " │                                       │"

docs/Examples/MultiRoute/Main.purs

@@ -29,7 +29,9 @@ router { route: GoodBye } = ok "goodbye"
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router }
+  where
+  onStarted = do
     log " ┌────────────────────────────────┐"
     log " │ Server now up on port 8080     │"
     log " │                                │"

docs/Examples/PathSegments/Main.purs

@@ -30,7 +30,9 @@ router { route: ManySegments elems } = ok $ show elems
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router }
+  where
+  onStarted = do
     log " ┌───────────────────────────────────────────────┐"
     log " │ Server now up on port 8080                    │"
     log " │                                               │"

docs/Examples/Post/Main.purs

@@ -27,7 +27,9 @@ router _ = notFound
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router }
+  where
+  onStarted = do
     log " ┌───────────────────────────────────────────┐"
     log " │ Server now up on port 8080                │"
     log " │                                           │"

docs/Examples/QueryParameters/Main.purs

@@ -4,6 +4,7 @@ import Prelude
 
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
+import Effect (Effect)
 import Effect.Class.Console (log)
 import HTTPurple (Request, ResponseM, ServerM, notFound, ok, serve)
 import Routing.Duplex (RouteDuplex')
@@ -30,7 +31,10 @@ router _ = notFound
 -- | Boot up the server
 main :: ServerM
 main =
-  serve 8080 { route, router, notFoundHandler: Nothing } do
+  serve { port: 8080, onStarted } { route, router }
+  where
+  onStarted :: Effect Unit
+  onStarted = do
     log " ┌───────────────────────────────────────┐"
     log " │ Server now up on port 8080            │"
     log " │                                       │"

docs/Examples/SSL/Main.purs

@@ -5,7 +5,7 @@ import Prelude
 import Data.Generic.Rep (class Generic)
 import Data.Maybe (Maybe(..))
 import Effect.Console (log)
-import HTTPurple (Request, ResponseM, ServerM, ok, serveSecure)
+import HTTPurple (Request, ResponseM, ServerM, ok, serve)
 import Routing.Duplex (RouteDuplex')
 import Routing.Duplex as RD
 import Routing.Duplex.Generic as G
@@ -35,7 +35,10 @@ sayHello _ = ok "hello world!"
 -- | Boot up the server
 main :: ServerM
 main =
-  serveSecure 8080 cert key { route, router: sayHello, notFoundHandler: Nothing } do
+  serve { port: 8080, certFile: cert, keyFile: key, onStarted } { route, router: sayHello } 
+  where 
+    onStarted = 
+      do
         log " ┌───────────────────────────────────────────┐"
         log " │ Server now up on port 8080                │"
         log " │                                           │"

spago.dhall

@@ -10,14 +10,18 @@
   , "foldable-traversable"
   , "foreign-object"
   , "js-uri"
+  , "justifill"
   , "maybe"
   , "newtype"
   , "node-buffer"
   , "node-fs"
   , "node-http"
+  , "node-net"
+  , "node-process"
   , "node-streams"
   , "options"
   , "ordered-collections"
+  , "posix-types"
   , "prelude"
   , "profunctor"
   , "record"

src/HTTPure.purs

@@ -20,6 +20,6 @@ import HTTPurple.Path (Path)
 import HTTPurple.Query (Query)
 import HTTPurple.Request (Request, 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.Routes (type (<+>), combineRoutes, (<+>))
-import HTTPurple.Server (ServerM, serve, serve', serveSecure, serveSecure')
+import HTTPurple.Routes (type (<+>), combineRoutes, orElse, (<+>))
+import HTTPurple.Server (ServerM, serve)
 import HTTPurple.Status (Status)

src/HTTPurple/Server.purs

@@ -1,28 +1,38 @@
 module HTTPurple.Server
-  ( ServerM
+  ( ClosingHandler(..)
+  , ListenOptions
+  , ListenOptionsR
+  , RoutingSettings
+  , RoutingSettingsR
+  , ServerM
   , serve
-  , serve'
-  , serveSecure
-  , serveSecure'
   ) where
 
 import Prelude
 
-import Data.Maybe (Maybe(Nothing), maybe)
-import Data.Options (Options, (:=))
+import Data.Maybe (Maybe(..), fromMaybe)
+import Data.Options ((:=))
+import Data.Posix.Signal (Signal(..))
 import Data.Profunctor.Choice ((|||))
 import Effect (Effect)
 import Effect.Aff (catchError, message, runAff)
 import Effect.Class (liftEffect)
+import Effect.Class.Console (log)
 import Effect.Console (error)
 import HTTPurple.Request (Request, fromHTTPRequest)
 import HTTPurple.Response (ResponseM, internalServerError, notFound, send)
+import Justifill (justifill)
+import Justifill.Fillable (class FillableFields)
+import Justifill.Justifiable (class JustifiableFields)
 import Node.Encoding (Encoding(UTF8))
 import Node.FS.Sync (readTextFile)
-import Node.HTTP (ListenOptions, close, listen)
-import Node.HTTP (Request, Response, createServer) as HTTP
-import Node.HTTP.Secure (SSLOptions, cert, certString, key, keyString)
+import Node.HTTP (ListenOptions, Request, Response, createServer) as HTTP
+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.RowList (class RowToList)
 import Routing.Duplex as RD
 
 -- | The `ServerM` is just an `Effect` containing a callback to close the
@@ -30,11 +40,27 @@ import Routing.Duplex as RD
 -- | methods.
 type ServerM = Effect (Effect Unit -> Effect Unit)
 
-type RoutingSettings route =
-  { route :: RD.RouteDuplex' route
-  , router :: Request route -> ResponseM
+data ClosingHandler = DefaultClosingHandler | NoClosingHandler
+
+type ListenOptionsR =
+  ( hostname :: Maybe String
+  , port :: Maybe Int
+  , backlog :: Maybe Int
+  , closingHandler :: Maybe ClosingHandler
   , notFoundHandler :: Maybe (Request Unit -> ResponseM)
-  }
+  , onStarted :: Maybe (Effect Unit)
+  , certFile :: Maybe String
+  , keyFile :: Maybe String
+  )
+
+type ListenOptions = { | ListenOptionsR }
+
+type RoutingSettingsR route =
+  ( route :: RD.RouteDuplex' route
+  , router :: Request route -> ResponseM
+  )
+
+type RoutingSettings route = { | RoutingSettingsR route }
 
 -- | Given a router, handle unhandled exceptions it raises by
 -- | responding with 500 Internal Server Error.
@@ -65,74 +91,74 @@ handleRequest { route, router, notFoundHandler } request httpresponse =
 defaultNotFoundHandler :: forall route. Request route -> ResponseM
 defaultNotFoundHandler = const notFound
 
--- | Given a `ListenOptions` object, a function mapping `Request` to
--- | `ResponseM`, and a `ServerM` containing effects to run on boot, creates and
--- | runs a HTTPurple server without SSL.
-serve' ::
-  forall route.
-  ListenOptions ->
-  RoutingSettings route ->
-  Effect Unit ->
-  ServerM
-serve' options { route, router, notFoundHandler } onStarted = do
-  server <- HTTP.createServer (handleRequest { route, router, notFoundHandler: maybe defaultNotFoundHandler identity notFoundHandler })
-  listen server options onStarted
-  pure $ close server
+justifillListenOptions ::
+  forall from fromRL via missing missingList.
+  RowToList missing missingList =>
+  FillableFields missingList () missing =>
+  Union via missing (ListenOptionsR) =>
+  RowToList from fromRL =>
+  JustifiableFields fromRL from () via =>
+  { | from } ->
+  ListenOptions
+justifillListenOptions = justifill
 
--- | Given a `Options HTTPS.SSLOptions` object and a `HTTP.ListenOptions`
--- | object, a function mapping `Request` to `ResponseM`, and a `ServerM`
--- | containing effects to run on boot, creates and runs a HTTPurple server with
--- | SSL.
-serveSecure' ::
-  forall route.
-  Options SSLOptions ->
-  ListenOptions ->
+-- | Given a `ListenOptions` and a `RoutingSettings`, creates and
+-- | runs a HTTPurple server.
+serve ::
+  forall route from fromRL via missing missingList.
+  RowToList missing missingList =>
+  FillableFields missingList () missing =>
+  Union via missing (ListenOptionsR) =>
+  RowToList from fromRL =>
+  JustifiableFields fromRL from () via =>
+  { | from } ->
   RoutingSettings route ->
-  Effect Unit ->
   ServerM
-serveSecure' sslOptions options { route, router, notFoundHandler } onStarted = do
-  server <- HTTPS.createServer sslOptions (handleRequest { route, router, notFoundHandler: maybe defaultNotFoundHandler identity notFoundHandler })
-  listen server options onStarted
-  pure $ close server
+serve inputOptions { route, router } = do
+  let
+    filledOptions :: ListenOptions
+    filledOptions = justifillListenOptions inputOptions
 
--- | Given a port number, return a `HTTP.ListenOptions` `Record`.
-listenOptions :: Int -> ListenOptions
-listenOptions port =
-  { hostname: "0.0.0.0"
+    hostname = fromMaybe defaultHostname filledOptions.hostname
+    port = fromMaybe defaultPort filledOptions.port
+    onStarted = fromMaybe (defaultOnStart hostname port) filledOptions.onStarted
+
+    options :: HTTP.ListenOptions
+    options =
+      { hostname
       , port
-  , backlog: Nothing
+      , backlog: filledOptions.backlog
       }
 
--- | Create and start a server. This is the main entry point for HTTPurple. Takes
--- | a port number on which to listen, a function mapping `Request` to
--- | `ResponseM`, and a `ServerM` containing effects to run after the server has
--- | booted (usually logging). Returns an `ServerM` containing the server's
--- | effects.
-serve ::
-  forall route.
-  Int ->
-  RoutingSettings route ->
-  Effect Unit ->
-  ServerM
-serve = serve' <<< listenOptions
+    routingSettings =
+      { route
+      , router
+      , notFoundHandler: fromMaybe defaultNotFoundHandler filledOptions.notFoundHandler
+      }
 
--- | Create and start an SSL server. This method is the same as `serve`, but
--- | takes additional SSL arguments.  The arguments in order are:
--- | 1. A port number
--- | 2. A path to a cert file
--- | 3. A path to a private key file
--- | 4. A handler method which maps `Request` to `ResponseM`
--- | 5. A callback to call when the server is up
-serveSecure ::
-  forall route.
-  Int ->
-  String ->
-  String ->
-  RoutingSettings route ->
-  Effect Unit ->
-  ServerM
-serveSecure port certFile keyFile routingSettings onStarted = do
+    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'
-  serveSecure' sslOpts (listenOptions port) routingSettings onStarted
+        HTTPS.createServer sslOpts (handleRequest routingSettings)
+    Nothing -> HTTP.createServer (handleRequest routingSettings)
+  listen server options onStarted
+  let closingHandler = close server
+  case filledOptions.closingHandler of
+    Just NoClosingHandler -> pure closingHandler
+    _ -> do
+      onSignal SIGINT $ closingHandler $ log "Received SIGINT, stopping service now."
+      onSignal SIGTERM $ closingHandler $ log "Received SIGTERM, stopping service now."
+      pure closingHandler
+
+defaultHostname :: String
+defaultHostname = "0.0.0.0"
+
+defaultPort :: Int
+defaultPort = 8080
+
+defaultOnStart :: String -> Int -> Effect Unit
+defaultOnStart hostname port = log $ "HTTPurple 🪁 up and running on http://" <> hostname <> ":" <> show port

test/Test/HTTPurple/ServerSpec.purs

@@ -12,7 +12,8 @@ import Effect.Exception (error)
 import Foreign.Object (empty)
 import HTTPurple.Request (Request)
 import HTTPurple.Response (ResponseM, notFound, ok)
-import HTTPurple.Server (serve, serve', serveSecure, serveSecure')
+import HTTPurple.Server (serve)
+import HTTPurple.Server as Server
 import Node.Encoding (Encoding(UTF8))
 import Node.FS.Sync (readTextFile)
 import Node.HTTP.Secure (key, keyString, cert, certString)
@@ -40,13 +41,13 @@ serveSpec :: Test
 serveSpec =
   describe "serve" do
     it "boots a server on the given port" do
-      close <- liftEffect $ serve 8080 { route, router: mockRouter, notFoundHandler: Nothing } $ pure unit
+      close <- liftEffect $ serve { port: 8080 } { route, router: mockRouter }
       out <- get 8080 empty "/test"
       liftEffect $ close $ pure unit
       out ?= "/test"
     it "responds with a 500 upon unhandled exceptions" do
       let router _ = throwError $ error "fail!"
-      close <- liftEffect $ serve 8080 { route, router, notFoundHandler: Nothing } $ pure unit
+      close <- liftEffect $ serve { port: 8080 } { route, router }
       status <- getStatus 8080 empty "/test"
       liftEffect $ close $ pure unit
       status ?= 500
@@ -55,11 +56,9 @@ serve'Spec :: Test
 serve'Spec =
   describe "serve'" do
     it "boots a server with the given options" do
-      let options = { hostname: "localhost", port: 8080, backlog: Nothing }
       close <-
         liftEffect
-          $ serve' options { route, router: mockRouter, notFoundHandler: Nothing }
-          $ pure unit
+          $ serve { hostname: "localhost", port: 8080 } { route, router: mockRouter }
       out <- get 8080 empty "/test"
       liftEffect $ close $ pure unit
       out ?= "/test"
@@ -71,16 +70,14 @@ serveSecureSpec =
       it "boots a server on the given port" do
         close <-
           liftEffect
-            $ serveSecure 8080 "./test/Mocks/Certificate.cer" "./test/Mocks/Key.key" { route, router: mockRouter, notFoundHandler: Nothing }
-            $ pure unit
+            $ serve { port: 8080, certFile: "./test/Mocks/Certificate.cer", keyFile: "./test/Mocks/Key.key" } { route, router: mockRouter }
         out <- get' 8080 empty "/test"
         liftEffect $ close $ pure unit
         out ?= "/test"
     describe "with invalid key and cert files" do
       it "throws" do
         expectError $ liftEffect
-          $ serveSecure 8080 "" "" { route, router: mockRouter, notFoundHandler: Nothing }
-          $ pure unit
+          $ serve { port: 8080, certFile: "", keyFile: "" } { route, router: mockRouter }
 
 serveSecure'Spec :: Test
 serveSecure'Spec =
@@ -88,16 +85,10 @@ serveSecure'Spec =
     describe "with valid key and cert files" do
       it "boots a server on the given port" do
         let
-          options = { hostname: "localhost", port: 8080, backlog: Nothing }
-          sslOptions = do
-            cert' <- readTextFile UTF8 "./test/Mocks/Certificate.cer"
-            key' <- readTextFile UTF8 "./test/Mocks/Key.key"
-            pure $ key := keyString key' <> cert := certString cert'
-        sslOpts <- liftEffect $ sslOptions
+          options = { hostname: "localhost", port: 8080, certFile: "./test/Mocks/Certificate.cer", keyFile: "./test/Mocks/Key.key" }
         close <-
           liftEffect
-            $ serveSecure' sslOpts options { route, router: mockRouter, notFoundHandler: Nothing }
-            $ pure unit
+            $ serve options { route, router: mockRouter }
         out <- get' 8080 empty "/test"
         liftEffect $ close $ pure unit
         out ?= "/test"