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

72 lines
3.1 KiB
Haskell
Raw Normal View History

2017-10-26 21:19:30 +00:00
module Examples.Middleware.Main where
2017-09-27 19:34:00 +00:00
import Prelude
import Effect.Class as EffectClass
import Effect.Console as Console
2017-09-27 19:34:00 +00:00
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 :: (HTTPure.Request -> HTTPure.ResponseM) ->
2017-09-27 19:34:00 +00:00
HTTPure.Request ->
HTTPure.ResponseM
2017-09-27 19:34:00 +00:00
loggingMiddleware router request = do
EffectClass.liftEffect $ Console.log $ "Request starting for " <> path
2017-09-27 19:34:00 +00:00
response <- router request
EffectClass.liftEffect $ Console.log $ "Request ending for " <> path
2017-09-27 19:34:00 +00:00
pure response
where
path = HTTPure.fullPath request
2017-09-27 19:34:00 +00:00
-- | A middleware that adds the X-Middleware header to the response, if it
-- | wasn't already in the response
headerMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) ->
2017-09-27 19:34:00 +00:00
HTTPure.Request ->
HTTPure.ResponseM
2017-09-27 19:34:00 +00:00
headerMiddleware router request = do
response <- router request
HTTPure.response' response.status (header <> response.headers) response.body
2017-09-27 19:34:00 +00:00
where
header = HTTPure.header "X-Middleware" "middleware"
2017-09-27 19:34:00 +00:00
-- | A middleware that sends the body "Middleware!" instead of running the
-- | router when requesting /middleware
pathMiddleware :: (HTTPure.Request -> HTTPure.ResponseM) ->
2017-09-27 19:34:00 +00:00
HTTPure.Request ->
HTTPure.ResponseM
2017-09-27 19:34:00 +00:00
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 :: HTTPure.Request -> HTTPure.ResponseM
sayHello _ = HTTPure.ok' (HTTPure.header "X-Middleware" "router") "hello"
2017-09-27 19:34:00 +00:00
-- | Boot up the server
main :: HTTPure.ServerM
2017-09-27 19:34:00 +00:00
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