purescript-httpurple/docs/Examples/Middleware/Main.purs

module Examples.Middleware.Main where

import Prelude hiding ((/))

import Data.Either (Either(..))
import Data.Generic.Rep (class Generic)
import Data.Maybe (Maybe(..))
import Effect.Class (liftEffect)
import Effect.Console (log)
import HTTPurple (type (<+>), Request, ResponseM, ServerM, fullPath, header, ok, ok', serve, (<+>))
import Record as Record
import Routing.Duplex as RD
import Routing.Duplex.Generic as RG
import Routing.Duplex.Generic.Syntax ((/))
import Type.Prelude (Proxy(..))

data Middleware = Middleware

derive instance Generic Middleware _

middlewareRoute :: RD.RouteDuplex' Middleware
middlewareRoute = RD.root $ RG.sum
  { "Middleware": "middleware" / RG.noArgs
  }

data SayHello = SayHello

derive instance Generic SayHello _

sayHelloRoute :: RD.RouteDuplex' SayHello
sayHelloRoute = RD.root $ RG.sum
  { "SayHello": RG.noArgs
  }

-- | A middleware that logs at the beginning and end of each request
loggingMiddleware ::
  forall route.
  (Request route -> ResponseM) ->
  Request route ->
  ResponseM
loggingMiddleware router request = do
  liftEffect $ log $ "Request starting for " <> path
  response <- router request
  liftEffect $ log $ "Request ending for " <> path
  pure response
  where
  path = fullPath request

-- | A middleware that adds the X-Middleware header to the response, if it
-- | wasn't already in the response
headerMiddleware ::
  forall route.
  (Request route -> ResponseM) ->
  Request route ->
  ResponseM
headerMiddleware router request = do
  response@{ headers } <- router request
  pure $ response { headers = header' <> headers }
  where
  header' = header "X-Middleware" "middleware"

-- | A middleware that sends the body "Middleware!" instead of running the
-- | router when requesting /middleware
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"

-- | The stack of middlewares to use for the server
middlewareStack :: forall route. (Request route -> ResponseM) -> Request (Either Middleware route) -> ResponseM
middlewareStack = loggingMiddleware <<< headerMiddleware <<< pathMiddleware

-- | Boot up the server
main :: ServerM
main =
  serve { port: 8080, onStarted } { route: middlewareRoute <+> sayHelloRoute, router: middlewareStack sayHello }
  where
  onStarted = do
    log " ┌───────────────────────────────────────┐"
    log " │ Server now up on port 8080            │"
    log " │                                       │"
    log " │ To test, run:                         │"
    log " │  > curl -v localhost:8080             │"
    log " │    # => ...                           │"
    log " │    # => ...< X-Middleware: router     │"
    log " │    # => ...                           │"
    log " │    # => hello                         │"
    log " │  > curl -v localhost:8080/middleware  │"
    log " │    # => ...                           │"
    log " │    # => ...< X-Middleware: middleware │"
    log " │    # => ...                           │"
    log " │    # => Middleware!                   │"
    log " └───────────────────────────────────────┘"