From 345675d5bd7c99678359d2c79559cddbedcc0d88 Mon Sep 17 00:00:00 2001 From: sigma-andex <77549848+sigma-andex@users.noreply.github.com> Date: Sun, 22 May 2022 17:36:08 +0100 Subject: [PATCH] Make settings optional - Add default onStarted and closingHandler - Use justifill to easily add options - Remove multiple serve options --- docs/Examples/AsyncResponse/Main.purs | 4 +- docs/Examples/BinaryRequest/Main.purs | 4 +- docs/Examples/BinaryResponse/Main.purs | 4 +- docs/Examples/Chunked/Main.purs | 4 +- docs/Examples/CustomStack/Main.purs | 4 +- docs/Examples/Headers/Main.purs | 5 +- docs/Examples/HelloWorld/Main.purs | 4 +- docs/Examples/Middleware/Main.purs | 17 ++- docs/Examples/MultiRoute/Main.purs | 4 +- docs/Examples/PathSegments/Main.purs | 4 +- docs/Examples/Post/Main.purs | 4 +- docs/Examples/QueryParameters/Main.purs | 6 +- docs/Examples/SSL/Main.purs | 21 +-- spago.dhall | 4 + src/HTTPure.purs | 4 +- src/HTTPurple/Server.purs | 184 ++++++++++++++---------- test/Test/HTTPurple/ServerSpec.purs | 27 ++-- 17 files changed, 177 insertions(+), 127 deletions(-) diff --git a/docs/Examples/AsyncResponse/Main.purs b/docs/Examples/AsyncResponse/Main.purs index 4f52b35..9a0143d 100644 --- a/docs/Examples/AsyncResponse/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/BinaryRequest/Main.purs b/docs/Examples/BinaryRequest/Main.purs index 8fd8aad..625bfb8 100644 --- a/docs/Examples/BinaryRequest/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/BinaryResponse/Main.purs b/docs/Examples/BinaryResponse/Main.purs index 632fa9d..4cf48b7 100644 --- a/docs/Examples/BinaryResponse/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/Chunked/Main.purs b/docs/Examples/Chunked/Main.purs index dde78ed..a643bd9 100644 --- a/docs/Examples/Chunked/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/CustomStack/Main.purs b/docs/Examples/CustomStack/Main.purs index a88ecdb..be52be1 100644 --- a/docs/Examples/CustomStack/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/Headers/Main.purs b/docs/Examples/Headers/Main.purs index 639c3a1..c4afc16 100644 --- a/docs/Examples/Headers/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/HelloWorld/Main.purs b/docs/Examples/HelloWorld/Main.purs index 8acbfe7..6fa7cf3 100644 --- a/docs/Examples/HelloWorld/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/Middleware/Main.purs b/docs/Examples/Middleware/Main.purs index ab938b7..70b4e8f 100644 --- a/docs/Examples/Middleware/Main.purs +++ b/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 ) -> + 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 " │ │" diff --git a/docs/Examples/MultiRoute/Main.purs b/docs/Examples/MultiRoute/Main.purs index 7c8cc9c..e8bb0b6 100644 --- a/docs/Examples/MultiRoute/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/PathSegments/Main.purs b/docs/Examples/PathSegments/Main.purs index 43e3f1e..94e7b46 100644 --- a/docs/Examples/PathSegments/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/Post/Main.purs b/docs/Examples/Post/Main.purs index 7d6c81e..5a1374f 100644 --- a/docs/Examples/Post/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/QueryParameters/Main.purs b/docs/Examples/QueryParameters/Main.purs index 6c44947..9405602 100644 --- a/docs/Examples/QueryParameters/Main.purs +++ b/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 " │ │" diff --git a/docs/Examples/SSL/Main.purs b/docs/Examples/SSL/Main.purs index 7ff57a7..f986d6c 100644 --- a/docs/Examples/SSL/Main.purs +++ b/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,11 +35,14 @@ sayHello _ = ok "hello world!" -- | Boot up the server main :: ServerM main = - serveSecure 8080 cert key { route, router: sayHello, notFoundHandler: Nothing } do - log " ┌───────────────────────────────────────────┐" - log " │ Server now up on port 8080 │" - log " │ │" - log " │ To test, run: │" - log " │ > curl --insecure https://localhost:8080 │" - log " │ # => hello world! │" - log " └───────────────────────────────────────────┘" + serve { port: 8080, certFile: cert, keyFile: key, onStarted } { route, router: sayHello } + where + onStarted = + do + log " ┌───────────────────────────────────────────┐" + log " │ Server now up on port 8080 │" + log " │ │" + log " │ To test, run: │" + log " │ > curl --insecure https://localhost:8080 │" + log " │ # => hello world! │" + log " └───────────────────────────────────────────┘" diff --git a/spago.dhall b/spago.dhall index 40acc5f..8583238 100644 --- a/spago.dhall +++ b/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" diff --git a/src/HTTPure.purs b/src/HTTPure.purs index 0616099..721b24b 100644 --- a/src/HTTPure.purs +++ b/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) diff --git a/src/HTTPurple/Server.purs b/src/HTTPurple/Server.purs index 0124e59..9c079f0 100644 --- a/src/HTTPurple/Server.purs +++ b/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 -> - 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 - --- | Given a port number, return a `HTTP.ListenOptions` `Record`. -listenOptions :: Int -> ListenOptions -listenOptions port = - { hostname: "0.0.0.0" - , port - , backlog: Nothing - } - --- | 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. +-- | Given a `ListenOptions` and a `RoutingSettings`, creates and +-- | runs a HTTPurple server. serve :: - forall route. - Int -> + 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 -serve = serve' <<< listenOptions +serve inputOptions { route, router } = do + let + filledOptions :: ListenOptions + filledOptions = justifillListenOptions inputOptions --- | 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 - cert' <- readTextFile UTF8 certFile - key' <- readTextFile UTF8 keyFile - let sslOpts = key := keyString key' <> cert := certString cert' - serveSecure' sslOpts (listenOptions port) routingSettings onStarted + 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 + , router + , 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 (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 diff --git a/test/Test/HTTPurple/ServerSpec.purs b/test/Test/HTTPurple/ServerSpec.purs index f027c7e..bba40f2 100644 --- a/test/Test/HTTPurple/ServerSpec.purs +++ b/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"