Add middleware example (#73)

docs/Examples/Middleware/Main.purs

@@ -0,0 +1,75 @@
+module Middleware where
+
+import Prelude
+
+import Control.Monad.Eff.Class as EffClass
+import Control.Monad.Eff.Console as Console
+import Data.Tuple as Tuple
+import HTTPure as HTTPure
+
+-- | Serve the example server on this port
+port :: Int
+port = 8089
+
+-- | Shortcut for `show port`
+portS :: String
+portS = show port
+
+-- | A middleware that logs at the beginning and end of each request
+loggingMiddleware :: forall e.
+                     (HTTPure.Request ->
+                      HTTPure.ResponseM (console :: Console.CONSOLE | e)) ->
+                     HTTPure.Request ->
+                     HTTPure.ResponseM (console :: Console.CONSOLE | e)
+loggingMiddleware router request = do
+  EffClass.liftEff $ Console.log $ "Request starting for " <> show request.path
+  response <- router request
+  EffClass.liftEff $ Console.log $ "Request ending for " <> show request.path
+  pure response
+
+-- | A middleware that adds the X-Middleware header to the response, if it
+-- | wasn't already in the response
+headerMiddleware :: forall e.
+                    (HTTPure.Request -> HTTPure.ResponseM e) ->
+                    HTTPure.Request ->
+                    HTTPure.ResponseM e
+headerMiddleware router request = do
+  response <- router request
+  HTTPure.response response.status (header <> response.headers) response.body
+  where
+    header = HTTPure.headers [ Tuple.Tuple "X-Middleware" "middleware" ]
+
+-- | A middleware that sends the body "Middleware!" instead of running the
+-- | router when requesting /middleware
+pathMiddleware :: forall e.
+                  (HTTPure.Request -> HTTPure.ResponseM e) ->
+                  HTTPure.Request ->
+                  HTTPure.ResponseM e
+pathMiddleware _ { path: [ "middleware" ] } = HTTPure.ok "Middleware!"
+pathMiddleware router request = router request
+
+-- | Say 'hello' when run, and add a default value to the X-Middleware header
+sayHello :: forall e. HTTPure.Request -> HTTPure.ResponseM e
+sayHello _ =
+  HTTPure.ok' (HTTPure.headers [ Tuple.Tuple "X-Middleware" "router" ]) "hello"
+
+-- | Boot up the server
+main :: forall e. HTTPure.ServerM (console :: Console.CONSOLE | e)
+main = HTTPure.serve port (middlewares sayHello) do
+  Console.log $ " ┌───────────────────────────────────────┐"
+  Console.log $ " │ Server now up on port " <> portS <> "            │"
+  Console.log $ " │                                       │"
+  Console.log $ " │ To test, run:                         │"
+  Console.log $ " │  > curl -v localhost:" <> portS <> "             │"
+  Console.log $ " │    # => ...                           │"
+  Console.log $ " │    # => ...< X-Middleware: router     │"
+  Console.log $ " │    # => ...                           │"
+  Console.log $ " │    # => hello                         │"
+  Console.log $ " │  > curl -v localhost:" <> portS <> "/middleware  │"
+  Console.log $ " │    # => ...                           │"
+  Console.log $ " │    # => ...< X-Middleware: middleware │"
+  Console.log $ " │    # => ...                           │"
+  Console.log $ " │    # => Middleware!                   │"
+  Console.log $ " └───────────────────────────────────────┘"
+  where
+    middlewares = loggingMiddleware <<< headerMiddleware <<< pathMiddleware

docs/Examples/Middleware/Readme.md

@@ -0,0 +1,13 @@
+# Middleware Example
+
+HTTPure does not have a `use` function like systems such as `express.js`, but
+you can still use middlewares! This example illustrates how purely functional
+middlewares in HTTPure work. It includes an example middleware that logs to the
+console at the beginning and end of each request, one that injects a header into
+the response, and one that handles requests to a given path.
+
+To run the example server, run:
+
+```bash
+make example EXAMPLE=Middleware
+```

src/HTTPure/Headers.purs

@@ -39,6 +39,10 @@ instance showHeaders :: Show Headers where
 instance eqHeaders :: Eq Headers where
   eq (Headers a) (Headers b) = eq a b
 
+-- | Allow one `Headers` objects to be appended to another.
+instance semigroupHeaders :: Semigroup Headers where
+  append (Headers a) (Headers b) = Headers $ StrMap.union b a
+
 -- | Get the headers out of a HTTP `Request` object.
 read :: HTTP.Request -> Headers
 read = HTTP.requestHeaders >>> Headers

src/HTTPure/Request.purs

@@ -37,5 +37,5 @@ fromHTTPRequest request = do
     , path: Path.read request
     , query: Query.read request
     , headers: Headers.read request
-    , body: body
+    , body
     }

src/HTTPure/Response.purs

@@ -1,5 +1,5 @@
 module HTTPure.Response
-  ( Response(..)
+  ( Response
   , ResponseM
   , send
   , response, response'
@@ -92,7 +92,11 @@ import HTTPure.Status as Status
 type ResponseM e = Aff.Aff (HTTPureEffects.HTTPureEffects e) Response
 
 -- | A `Response` is a status code, headers, and a body.
-data Response = Response Status.Status Headers.Headers Body.Body
+type Response =
+  { status :: Status.Status
+  , headers :: Headers.Headers
+  , body :: Body.Body
+  }
 
 -- | Given an HTTP `Response` and a HTTPure `Response`, this method will return
 -- | a monad encapsulating writing the HTTPure `Response` to the HTTP `Response`
@@ -101,7 +105,7 @@ send :: forall e.
         HTTP.Response ->
         Response ->
         Eff.Eff (HTTPureEffects.HTTPureEffects e) Unit
-send httpresponse (Response status headers body) = do
+send httpresponse { status, headers, body } = do
   Status.write httpresponse $ status
   Headers.write httpresponse $ headers
   Body.write httpresponse $ body
@@ -113,7 +117,7 @@ response :: forall e.
             Headers.Headers ->
             Body.Body ->
             ResponseM e
-response status headers body = pure $ Response status headers body
+response status headers body = pure $ { status, headers, body }
 
 -- | The same as `response` but without a body.
 response' :: forall e. Status.Status -> Headers.Headers -> ResponseM e

test/HTTPure/HeadersSpec.purs

@@ -59,6 +59,35 @@ eqSpec = Spec.describe "eq" do
         , Tuple.Tuple "Test2" "test2"
         ]
 
+appendSpec :: SpecHelpers.Test
+appendSpec = Spec.describe "append" do
+  Spec.describe "when there are multiple keys" do
+    Spec.it "appends the headers correctly" do
+      mockHeaders1 <> mockHeaders2 ?= mockHeaders3
+  Spec.describe "when there is a duplicated key" do
+    Spec.it "uses the last appended value" do
+      mockHeadersDupe1 <> mockHeadersDupe2 ?= mockHeadersDupe2
+  where
+    mockHeadersDupe1 = Headers.headers [ Tuple.Tuple "Test" "foo" ]
+    mockHeadersDupe2 = Headers.headers [ Tuple.Tuple "Test" "bar" ]
+    mockHeaders1 =
+      Headers.headers
+        [ Tuple.Tuple "Test1" "test1"
+        , Tuple.Tuple "Test2" "test2"
+        ]
+    mockHeaders2 =
+      Headers.headers
+        [ Tuple.Tuple "Test3" "test3"
+        , Tuple.Tuple "Test4" "test4"
+        ]
+    mockHeaders3 =
+      Headers.headers
+        [ Tuple.Tuple "Test1" "test1"
+        , Tuple.Tuple "Test2" "test2"
+        , Tuple.Tuple "Test3" "test3"
+        , Tuple.Tuple "Test4" "test4"
+        ]
+
 readSpec :: SpecHelpers.Test
 readSpec = Spec.describe "read" do
   Spec.describe "with no headers" do
@@ -85,5 +114,6 @@ headersSpec = Spec.describe "Headers" do
   lookupSpec
   showSpec
   eqSpec
+  appendSpec
   readSpec
   writeSpec

test/HTTPure/IntegrationSpec.purs

@@ -12,6 +12,7 @@ import HTTPure.SpecHelpers ((?=))
 import AsyncResponse as AsyncResponse
 import Headers as Headers
 import HelloWorld as HelloWorld
+import Middleware as Middleware
 import MultiRoute as MultiRoute
 import PathSegments as PathSegments
 import QueryParameters as QueryParameters
@@ -41,6 +42,19 @@ helloWorldSpec = Spec.it "runs the hello world example" do
   response ?= "hello world!"
   where port = HelloWorld.port
 
+middlewareSpec :: SpecHelpers.Test
+middlewareSpec = Spec.it "runs the middleware example" do
+  EffClass.liftEff Middleware.main
+  header <- SpecHelpers.getHeader port StrMap.empty "/" "X-Middleware"
+  header ?= "router"
+  body <- SpecHelpers.get port StrMap.empty "/"
+  body ?= "hello"
+  header' <- SpecHelpers.getHeader port StrMap.empty "/middleware" "X-Middleware"
+  header' ?= "middleware"
+  body' <- SpecHelpers.get port StrMap.empty "/middleware"
+  body' ?= "Middleware!"
+  where port = Middleware.port
+
 multiRouteSpec :: SpecHelpers.Test
 multiRouteSpec = Spec.it "runs the multi route example" do
   EffClass.liftEff MultiRoute.main
@@ -91,6 +105,7 @@ integrationSpec = Spec.describe "Integration" do
   asyncResponseSpec
   headersSpec
   helloWorldSpec
+  middlewareSpec
   multiRouteSpec
   pathSegmentsSpec
   queryParametersSpec

test/HTTPure/ResponseSpec.purs

@@ -35,19 +35,19 @@ sendSpec = Spec.describe "send" do
     body ?= "test"
   where
     mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ]
-    mockResponse = Response.Response 123 mockHeaders "test"
+    mockResponse = { status: 123, headers: mockHeaders, body: "test" }
 
 responseFunctionSpec :: SpecHelpers.Test
 responseFunctionSpec = Spec.describe "response" do
   Spec.it "has the right status" do
     resp <- mockResponse
-    case resp of (Response.Response status _ _) -> status ?= 123
+    resp.status ?= 123
   Spec.it "has the right headers" do
     resp <- mockResponse
-    case resp of (Response.Response _ headers _) -> headers ?= mockHeaders
+    resp.headers ?= mockHeaders
   Spec.it "has the right body" do
     resp <- mockResponse
-    case resp of (Response.Response _ _ body) -> body ?= "test"
+    resp.body ?= "test"
   where
     mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ]
     mockResponse = Response.response 123 mockHeaders "test"
@@ -56,13 +56,13 @@ response'Spec :: SpecHelpers.Test
 response'Spec = Spec.describe "response'" do
   Spec.it "has the right status" do
     resp <- mockResponse
-    case resp of (Response.Response status _ _) -> status ?= 123
+    resp.status ?= 123
   Spec.it "has the right headers" do
     resp <- mockResponse
-    case resp of (Response.Response _ headers _) -> headers ?= mockHeaders
+    resp.headers ?= mockHeaders
   Spec.it "has an empty body" do
     resp <- mockResponse
-    case resp of (Response.Response _ _ body) -> body ?= ""
+    resp.body ?= ""
   where
     mockHeaders = Headers.headers [ Tuple.Tuple "Test" "test" ]
     mockResponse = Response.response' 123 mockHeaders