/
SimpleAPI.purs
42 lines (39 loc) · 1.39 KB
/
SimpleAPI.purs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
module Bucketchain.SimpleAPI where
import Prelude
import Bucketchain.Http (requestMethod, requestBody, requestURL, setStatusCode, setHeader)
import Bucketchain.Middleware (Middleware)
import Bucketchain.ResponseBody (body)
import Bucketchain.SimpleAPI.Class (class Servable, serve)
import Bucketchain.SimpleAPI.Response (responseHeaders, responseStatus, responseBody)
import Control.Monad.Reader (ask)
import Data.Maybe (Maybe(..))
import Data.String (drop)
import Data.TraversableWithIndex (traverseWithIndex)
import Effect.Aff.Class (liftAff)
import Effect.Class (liftEffect)
import Simple.JSON (writeJSON)
-- | SimpleAPI middleware.
-- |
-- | `ex` is any extra data. It is typically global context such as db connection and can be used in `Action`.
-- |
-- | `server` is a `Servable` instance.
withSimpleAPI
:: forall ex server
. Servable ex server
=> ex
-> server
-> Middleware
withSimpleAPI extraData server next = do
http <- ask
if requestMethod http /= "POST"
then next
else do
let path = drop 1 $ requestURL http
rawBody <- liftAff $ requestBody http
result <- liftAff $ serve server extraData { http, path, rawBody }
case result of
Nothing -> next
Just r -> liftEffect do
setStatusCode http $ responseStatus r
void $ traverseWithIndex (setHeader http) $ responseHeaders r
Just <$> (body $ writeJSON $ responseBody r)