Add integration tests

docs/Examples/ExtensibleMiddleware/Main.purs

@@ -0,0 +1,66 @@
+module Examples.ExtensibleMiddleware.Main where
+
+import Prelude hiding ((/))
+
+import Data.Generic.Rep (class Generic)
+import Data.JSDate (JSDate)
+import Data.JSDate as JSDate
+import Data.Maybe (Maybe(..))
+import Effect.Class (liftEffect)
+import Effect.Console (log)
+import HTTPurple (ExtRequest, Middleware, Request, RequestR, ResponseM, ServerM, ok, serve)
+import HTTPurple as Headers
+import Prim.Row (class Nub, class Union)
+import Record (merge)
+import Routing.Duplex as RD
+import Routing.Duplex.Generic as RG
+
+authenticator ::
+  forall route extIn extOut.
+  Nub (RequestR route extOut) (RequestR route extOut) =>
+  Union extIn (user :: Maybe String) extOut =>
+  Middleware route extIn extOut
+authenticator router request@{ headers } = case Headers.lookup headers "X-Token" of
+  Just token | token == "123" -> router $ merge request { user: Just "John Doe" }
+  _ -> router $ merge request { user: Nothing :: Maybe String }
+
+requestTime ::
+  forall route extIn extOut.
+  Nub (RequestR route extOut) (RequestR route extOut) =>
+  Union extIn (time :: JSDate) extOut =>
+  Middleware route extIn extOut
+requestTime router request = do
+  time <- liftEffect JSDate.now
+  router $ merge request { time }
+
+data SayHello = SayHello
+
+derive instance Generic SayHello _
+
+sayHelloRoute :: RD.RouteDuplex' SayHello
+sayHelloRoute = RD.root $ RG.sum
+  { "SayHello": RG.noArgs
+  }
+
+-- | Say 'hello <USER>' when run with X-Token, otherwise 'hello anonymous'
+sayHello :: ExtRequest SayHello (user :: Maybe String, time :: JSDate) -> ResponseM
+sayHello { user: Just user, time } = ok $ "hello " <> user <> ", it is " <> JSDate.toDateString time <> " " <> JSDate.toTimeString time
+sayHello { user: Nothing, time } = ok $ "hello " <> "anonymous, it is " <> JSDate.toDateString time <> " " <> JSDate.toTimeString time
+
+-- | The stack of middlewares to use for the server
+middlewareStack :: forall route. (ExtRequest route (user :: Maybe String, time :: JSDate) -> ResponseM) -> Request route -> ResponseM
+middlewareStack = authenticator <<< requestTime
+
+-- | Boot up the server
+main :: ServerM
+main =
+  serve { hostname: "localhost", port: 8080, onStarted } { route: sayHelloRoute, router: middlewareStack sayHello }
+  where
+  onStarted = do
+    log " ┌───────────────────────────────────────────────┐"
+    log " │ Server now up on port 8080                    │"
+    log " │                                               │"
+    log " │ To test, run:                                 │"
+    log " │  > http -v GET localhost:8080 X-Token:123     │"
+    log " │    # => hello John Doe, it is ...             │"
+    log " └───────────────────────────────────────────────┘"

docs/Examples/ExtensibleMiddleware/Readme.md

@@ -0,0 +1,9 @@
+# ExtensibleMiddleware Example
+
+HTTPurple supports extensible Middlewares that can add further data to your request record
+
+To run the example server, run:
+
+```bash
+spago -x test.dhall run --main Examples.ExtensibleMiddleware.Main
+```

docs/Examples/NodeMiddleware/Main.js

@@ -0,0 +1,13 @@
+export const logger = function (req, res, next) {
+  console.log("Got a request");
+  next();
+};
+
+export const authenticator = function (req, res, next) {
+  if (req.headers["x-token"] == "123") {
+    req.user = "John Doe";
+  } else {
+    req.user = null;
+  }
+  next();
+};

docs/Examples/NodeMiddleware/Main.purs

@@ -0,0 +1,50 @@
+module Examples.NodeMiddleware.Main where
+
+import Prelude hiding ((/))
+
+import Data.Generic.Rep (class Generic)
+import Data.Maybe (Maybe(..))
+import Data.Nullable (Nullable)
+import Data.Nullable as Nullable
+import Effect.Console (log)
+import HTTPurple (ExtRequest, NodeMiddleware, NodeMiddlewareStack(..), ResponseM, ServerM, ok, serveNodeMiddleware, usingMiddleware)
+import Routing.Duplex as RD
+import Routing.Duplex.Generic as RG
+
+foreign import logger :: NodeMiddleware ()
+
+type AuthenticatorR = (user :: Nullable String)
+
+foreign import authenticator :: NodeMiddleware (user :: Nullable String)
+
+nodeMiddleware :: NodeMiddlewareStack () AuthenticatorR
+nodeMiddleware = NodeMiddlewareStack $ usingMiddleware logger >=> usingMiddleware authenticator
+
+data SayHello = SayHello
+
+derive instance Generic SayHello _
+
+sayHelloRoute :: RD.RouteDuplex' SayHello
+sayHelloRoute = RD.root $ RG.sum
+  { "SayHello": RG.noArgs
+  }
+
+-- | Say 'hello <USER>' when run with X-Token, otherwise 'hello anonymous'
+sayHello :: ExtRequest SayHello AuthenticatorR -> ResponseM
+sayHello { user } = case Nullable.toMaybe user of
+  Just u -> ok $ "hello " <> u
+  Nothing -> ok $ "hello " <> "anonymous"
+
+-- | Boot up the server
+main :: ServerM
+main =
+  serveNodeMiddleware { hostname: "localhost", port: 8080, onStarted } { route: sayHelloRoute, router: sayHello, nodeMiddleware }
+  where
+  onStarted = do
+    log " ┌───────────────────────────────────────────────┐"
+    log " │ Server now up on port 8080                    │"
+    log " │                                               │"
+    log " │ To test, run:                                 │"
+    log " │  > http -v GET localhost:8080 X-Token:123     │"
+    log " │    # => hello John Doe                        │"
+    log " └───────────────────────────────────────────────┘"

docs/Examples/NodeMiddleware/Readme.md

@@ -0,0 +1,9 @@
+# NodeMiddleware Example
+
+HTTPurple now supports node.js / express middlewares.
+
+To run the example server, run:
+
+```bash
+spago -x test.dhall run --main Examples.NodeMiddleware.Main
+```

test.dhall

@@ -12,5 +12,7 @@ in conf // {
   , "transformers"
   , "unsafe-coerce" 
   , "typelevel-prelude"
+  , "js-date"
+  , "nullable"
   ]
 }

test/Test/HTTPurple/IntegrationSpec.purs

@@ -2,26 +2,32 @@ module Test.HTTPurple.IntegrationSpec where
 
 import Prelude
 
+import Control.Monad.Trans.Class (lift)
+import Effect.Aff (Milliseconds(..), delay)
 import Effect.Class (liftEffect)
 import Examples.AsyncResponse.Main as AsyncResponse
 import Examples.BinaryRequest.Main as BinaryRequest
 import Examples.BinaryResponse.Main as BinaryResponse
 import Examples.Chunked.Main as Chunked
 import Examples.CustomStack.Main as CustomStack
+import Examples.ExtensibleMiddleware.Main as ExtensibleMiddleware
 import Examples.Headers.Main as Headers
 import Examples.HelloWorld.Main as HelloWorld
 import Examples.JsonParsing.Main as JsonParsing
 import Examples.Middleware.Main as Middleware
 import Examples.MultiRoute.Main as MultiRoute
+import Examples.NodeMiddleware.Main as NodeMiddleware
 import Examples.PathSegments.Main as PathSegments
 import Examples.Post.Main as Post
 import Examples.QueryParameters.Main as QueryParameters
 import Examples.SSL.Main as SSL
 import Foreign.Object (empty, singleton)
+import Foreign.Object as Object
 import Node.Buffer (toArray)
 import Node.FS.Aff (readFile)
 import Test.HTTPurple.TestHelpers (Test, get, get', getBinary, getHeader, post, postBinary, (?=))
-import Test.Spec (describe, it)
+import Test.Spec (Tree(..), describe, it)
+import Test.Spec.Assertions.String (shouldStartWith)
 
 asyncResponseSpec :: Test
 asyncResponseSpec =
@@ -159,6 +165,28 @@ sslSpec =
     liftEffect $ close $ pure unit
     response ?= "hello world!"
 
+extensibleMiddlewareSpec :: Test
+extensibleMiddlewareSpec =
+  it "runs the middleware example" do
+    close <- liftEffect ExtensibleMiddleware.main
+    let headers = Object.singleton "X-Token" "123"
+    body <- get 8080 headers "/"
+    body' <- get 8080 empty "/"
+    liftEffect $ close $ pure unit
+    body `shouldStartWith` "hello John Doe, it is"
+    body' `shouldStartWith` "hello anonymous, it is"
+
+nodeMiddlewareSpec :: Test
+nodeMiddlewareSpec =
+  it "runs the middleware example" do
+    close <- liftEffect NodeMiddleware.main
+    let headers = Object.singleton "X-Token" "123"
+    body <- get 8080 headers "/"
+    body' <- get 8080 empty "/"
+    liftEffect $ close $ pure unit
+    body `shouldStartWith` "hello John Doe"
+    body' `shouldStartWith` "hello anonymous"
+
 integrationSpec :: Test
 integrationSpec =
   describe "Integration" do
@@ -176,3 +204,5 @@ integrationSpec =
     queryParametersSpec
     sslSpec
     jsonParsingSpec
+    extensibleMiddlewareSpec
+    nodeMiddlewareSpec