git.iko.soy/purestack-dev/purescript-purestack-server
on master help sign in
spago.dhall+8
since splitsnapshots
unifiedsplit
@@ -6,16 +6,24 @@
6 , "arrays"
6 , "arrays"
7 , "console"
7 , "console"
8 , "control"
8 , "control"
9+ , "datetime"
9 , "effect"
10 , "effect"
10 , "either"
11 , "either"
11 , "foldable-traversable"
12 , "foldable-traversable"
13+ , "foreign-object"
14+ , "formatters"
12 , "integers"
15 , "integers"
16+ , "lists"
13 , "maybe"
17 , "maybe"
18+ , "now"
14 , "numbers"
19 , "numbers"
15 , "ordered-collections"
20 , "ordered-collections"
21+ , "parsing"
16 , "prelude"
22 , "prelude"
23+ , "profunctor-lenses"
17 , "record"
24 , "record"
18 , "run"
25 , "run"
26+ , "strings"
19 , "transformers"
27 , "transformers"
20 , "tuples"
28 , "tuples"
21 , "typelevel-prelude"
29 , "typelevel-prelude"
src/Bun/Request.js+4
@@ -9,3 +9,7 @@ export function method(req) {
9export function url(req) {
9export function url(req) {
10 return req.url
10 return req.url
11}
11}
12+
13+export function headers(req) {
14+ return Object.fromEntries(req.headers.entries());
15+}
src/Bun/Request.purs+4
@@ -3,6 +3,7 @@ module Bun.Request
3 , method
3 , method
4 , url
4 , url
5 , json
5 , json
6+ , headers
6 ) where
7 ) where
7
8
8import Prelude
9import Prelude
@@ -11,6 +12,7 @@ import Control.Promise (Promise)
11import Control.Promise as Promise
12import Control.Promise as Promise
12import Data.Argonaut (Json)
13import Data.Argonaut (Json)
13import Effect.Aff (Aff)
14import Effect.Aff (Aff)
15+import Foreign.Object (Object)
14
16
15foreign import data Request :: Type
17foreign import data Request :: Type
16
18
@@ -22,3 +24,5 @@ json = jsonPromise >>> Promise.toAff
22foreign import method :: Request -> String
24foreign import method :: Request -> String
23
25
24foreign import url :: Request -> String
26foreign import url :: Request -> String
27+
28+foreign import headers :: Request -> Object String
src/Bun/Response.js+23
@@ -10,3 +10,26 @@ export function string(s) {
10 return new Response(s, options)
10 return new Response(s, options)
11 }
11 }
12}
12}
13+
14+
15+export function stream(s) {
16+ return function(options) {
17+ return new Response(s, options)
18+ }
19+}
20+
21+export function body(resp) {
22+ return resp.body
23+}
24+
25+export function status(resp) {
26+ return resp.status
27+}
28+
29+export function statusText(resp) {
30+ return resp.statusText
31+}
32+
33+export function headers(resp) {
34+ return Object.fromEntries(resp.headers.entries());
35+}
src/Bun/Response.purs+9−3
@@ -1,12 +1,18 @@
1module Bun.Response where
1module Bun.Response where
2
2
3import Data.Argonaut (Json)
3import Data.Argonaut (Json)
4−import Data.Tuple.Nested (type (/\))
4+import Foreign.Object (Object)
5−import Effect (Effect)
6
5
7foreign import data Response :: Type
6foreign import data Response :: Type
7+foreign import data ReadableStream :: Type
8
8
9−type Options = { status :: Int, statusText :: String, headers :: Array (String /\ String) }
9+type Options = { status :: Int, statusText :: String, headers :: Object String }
10
10
11foreign import json :: Json -> Options -> Response
11foreign import json :: Json -> Options -> Response
12foreign import string :: String -> Options -> Response
12foreign import string :: String -> Options -> Response
13+foreign import stream :: ReadableStream -> Options -> Response
14+foreign import body :: Response -> ReadableStream
15+foreign import headers :: Response -> Object String
16+foreign import status :: Response -> Int
17+foreign import statusText :: Response -> String
18+
src/Main.purs+13−5
@@ -7,7 +7,7 @@ import Data.Maybe (Maybe)
7import Effect (Effect)
7import Effect (Effect)
8import Effect.Aff (Aff)
8import Effect.Aff (Aff)
9import Effect.Console (log)
9import Effect.Console (log)
10−import PureStack.Route (type (/), GET, POST)
10+import PureStack.Route (type (/), GET, Headers(..), Middleware, POST)
11import PureStack.Route as Router
11import PureStack.Route as Router
12import PureStack.Server as Server
12import PureStack.Server as Server
13import Run (AFF, Run(..), runBaseAff)
13import Run (AFF, Run(..), runBaseAff)
@@ -16,14 +16,22 @@ import Type.Row (type (+))
16type Foo = { a :: String, b :: Maybe Int, c :: Array Number }
16type Foo = { a :: String, b :: Maybe Int, c :: Array Number }
17
17
18type API =
18type API =
19− ( foo :: "foo" / "bar" / Foo / GET { a :: Int, b :: Number, c :: Foo }
19+ ( foo :: "foo" / "bar" / Foo / GET Unit { a :: Int, b :: Number, c :: Foo }
20− , bar :: "foo" / "qux" / POST Unit { a :: Int }
20+ , bar :: "foo" / Middleware "auth" / "qux" / POST (Headers { foo :: String } Unit) { a :: Int, s :: String }
21+ , deep ::
22+ "deep" /
23+ ( something :: "something" / GET Unit { a :: String }
24+ )
21 )
25 )
22
26
23main :: Effect Unit
27main :: Effect Unit
24main = do
28main = do
25 log "🍝"
29 log "🍝"
26 Bun.serve $ Server.run @API identity
30 Bun.serve $ Server.run @API identity
31+ { handlers:
27− { foo: \x -> pure { a: 1, b: 1.0, c: x }
32+ { foo: \x -> pure { a: 1, b: 1.0, c: x }
28− , bar: pure { a: 8 }
33+ , bar: \i (Headers x _) -> pure { a: 8, s: x.foo }
34+ , deep: { something: pure { a: "something" } }
35+ }
36+ , middlewares: { auth: \req -> pure 1 }
29 }
37 }
src/PureStack/Cookie.pursnew file+57
@@ -0,0 +1,57 @@
1+-- | This module allows parsing and generating cookie headers. You'll generally use
2+-- | the `Cookie.new` function to create a cookie from a name/value pair and the
3+-- | `Cookie.set*` functions to set attributes on a cookie.
4+-- |
5+-- | `Cookie.stringify` generates the string representation of a cookie, suitable for
6+-- | writing to an HTTP header.
7+-- |
8+-- | `Cookie.parse` parses the string representation of a cookie, returning an
9+-- | `Either ParseError Cookie`.
10+-- |
11+-- | ```purescript
12+-- | import PureStack.Cookie as Cookie
13+-- |
14+-- | > Cookie.stringify $ Cookie.setSecure $ Cookie.new "key" "value"
15+-- | key=value; Secure
16+-- |
17+-- | > Cookie.parse "key=value; Secure"
18+-- | (Right { name: "key", value: "value", secure: true, ... })
19+-- | ```
20+module PureStack.Cookie
21+ ( module PureStack.Cookie.Generator
22+ , module PureStack.Cookie.Parser
23+ , module PureStack.Cookie.Types
24+ ) where
25+
26+import PureStack.Cookie.Generator (stringify)
27+import PureStack.Cookie.Parser (parse, parseMany)
28+import PureStack.Cookie.Types
29+ ( Cookie
30+ , SameSite(..)
31+ , _domain
32+ , _expires
33+ , _httpOnly
34+ , _maxAge
35+ , _name
36+ , _path
37+ , _secure
38+ , _value
39+ , expire
40+ , fromFields
41+ , getDomain
42+ , getExpires
43+ , getHttpOnly
44+ , getMaxAge
45+ , getName
46+ , getPath
47+ , getSecure
48+ , getValue
49+ , new
50+ , setDomain
51+ , setExpires
52+ , setHttpOnly
53+ , setMaxAge
54+ , setPath
55+ , setSameSite
56+ , setSecure
57+ )
src/PureStack/Cookie/Formatter.pursnew file+65
@@ -0,0 +1,65 @@
1+-- | This module is responsible for formatting and parsing the `Expires`
2+-- | attribute of a `Cookie`.
3+module PureStack.Cookie.Formatter
4+ ( domainTag
5+ , expiresTag
6+ , formatDateTime
7+ , httpOnlyTag
8+ , maxAgeTag
9+ , pathTag
10+ , sameSiteTag
11+ , secureTag
12+ , unformatDateTime
13+ ) where
14+
15+import Data.DateTime (DateTime)
16+import Data.Either (Either)
17+import Data.Formatter.DateTime (Formatter, FormatterCommand(..))
18+import Data.Formatter.DateTime as Formatter
19+import Data.List as List
20+
21+domainTag :: String
22+domainTag = "Domain"
23+
24+expiresTag :: String
25+expiresTag = "Expires"
26+
27+httpOnlyTag :: String
28+httpOnlyTag = "HttpOnly"
29+
30+maxAgeTag :: String
31+maxAgeTag = "Max-Age"
32+
33+pathTag :: String
34+pathTag = "Path"
35+
36+secureTag :: String
37+secureTag = "Secure"
38+
39+sameSiteTag :: String
40+sameSiteTag = "SameSite"
41+
42+expiresFormatter :: Formatter
43+expiresFormatter =
44+ List.fromFoldable
45+ [ DayOfWeekNameShort
46+ , Placeholder ", "
47+ , DayOfMonthTwoDigits
48+ , Placeholder " "
49+ , MonthShort
50+ , Placeholder " "
51+ , YearFull
52+ , Placeholder " "
53+ , Hours24
54+ , Placeholder ":"
55+ , MinutesTwoDigits
56+ , Placeholder ":"
57+ , SecondsTwoDigits
58+ , Placeholder " GMT"
59+ ]
60+
61+formatDateTime :: DateTime -> String
62+formatDateTime = Formatter.format expiresFormatter
63+
64+unformatDateTime :: String -> Either String DateTime
65+unformatDateTime = Formatter.unformat expiresFormatter
src/PureStack/Cookie/Generator.pursnew file+62
@@ -0,0 +1,62 @@
1+-- | This module is responsible for generating the string representation
2+-- | of a `Cookie`.
3+module PureStack.Cookie.Generator
4+ ( stringify
5+ ) where
6+
7+import Prelude
8+import PureStack.Cookie.Formatter
9+ ( domainTag
10+ , expiresTag
11+ , formatDateTime
12+ , httpOnlyTag
13+ , maxAgeTag
14+ , pathTag
15+ , sameSiteTag
16+ , secureTag
17+ )
18+import PureStack.Cookie.Types
19+ ( Cookie
20+ , getDomain
21+ , getExpires
22+ , getHttpOnly
23+ , getMaxAge
24+ , getName
25+ , getPath
26+ , getSameSite
27+ , getSecure
28+ , getValue
29+ )
30+import Data.Array (catMaybes)
31+import Data.Foldable (intercalate)
32+import Data.Maybe (Maybe(..))
33+
34+-- | Return the `String` representation of a `Cookie`.
35+-- |
36+-- | ```purescript
37+-- | > Generator.stringify $ Cookie.setSecure $ Cookie.new "key" "value"
38+-- | key=value; Secure
39+-- | ```
40+stringify :: Cookie -> String
41+stringify cookie =
42+ intercalate "; "
43+ $ catMaybes
44+ [ attr (getName cookie) $ Just (getValue cookie)
45+ , attr domainTag $ getDomain cookie
46+ , attr pathTag $ getPath cookie
47+ , attr expiresTag $ formatDateTime <$> getExpires cookie
48+ , attr maxAgeTag $ show <$> getMaxAge cookie
49+ , attr sameSiteTag $ show <$> getSameSite cookie
50+ , flag secureTag $ getSecure cookie
51+ , flag httpOnlyTag $ getHttpOnly cookie
52+ ]
53+
54+attr :: String -> Maybe String -> Maybe String
55+attr name = case _ of
56+ Nothing -> Nothing
57+ Just value -> Just $ name <> "=" <> value
58+
59+flag :: String -> Boolean -> Maybe String
60+flag name = case _ of
61+ false -> Nothing
62+ true -> Just name
src/PureStack/Cookie/Parser.pursnew file+128
@@ -0,0 +1,128 @@
1+-- | This module is responsible for parsing a string into an
2+-- | `Either ParseError Cookie`.
3+module PureStack.Cookie.Parser
4+ ( parse
5+ , parseMany
6+ ) where
7+
8+import Prelude
9+
10+import Control.Alt ((<|>))
11+import Data.Array as Array
12+import Data.Either (Either(..))
13+import Data.Foldable (class Foldable, foldl)
14+import Data.Int as Int
15+import Data.List (List)
16+import Data.Maybe (Maybe(..))
17+import Data.String as String
18+import Parsing (ParseError, Parser, fail, runParser)
19+import Parsing.Combinators (many, sepBy)
20+import Parsing.String (eof, string)
21+import Parsing.String.Basic (noneOf)
22+import PureStack.Cookie.Formatter (domainTag, expiresTag, httpOnlyTag, maxAgeTag, pathTag, sameSiteTag, secureTag, unformatDateTime)
23+import PureStack.Cookie.Types (Cookie, SameSite(..))
24+import PureStack.Cookie.Types as Cookie
25+
26+type Attribute = Cookie -> Cookie
27+
28+dropSeperator :: Parser String Unit
29+dropSeperator = (string "; " $> unit) <|> (pure unit)
30+
31+asString :: forall f. Functor f => Foldable f => f Char -> String
32+asString = String.fromCodePointArray <<< Array.fromFoldable <<< map String.codePointFromChar
33+
34+stringWithout :: Array Char -> Parser String String
35+stringWithout = map asString <<< many <<< noneOf
36+
37+attributeValue :: Parser String String
38+attributeValue = stringWithout [ ';' ]
39+
40+whitespaceChars :: Array Char
41+whitespaceChars = [ ' ', '\n', '\r', '\t' ]
42+
43+parseDomain :: Parser String Attribute
44+parseDomain = do
45+ domain <- (string $ domainTag <> "=") *> attributeValue
46+ pure $ Cookie.setDomain domain
47+
48+parsePath :: Parser String Attribute
49+parsePath = do
50+ path <- (string $ pathTag <> "=") *> attributeValue
51+ pure $ Cookie.setPath path
52+
53+parseExpires :: Parser String Attribute
54+parseExpires = do
55+ expiresString <- (string $ expiresTag <> "=") *> attributeValue
56+ case unformatDateTime expiresString of
57+ Left e -> fail e
58+ Right expires -> pure $ Cookie.setExpires expires
59+
60+parseMaxAge :: Parser String Attribute
61+parseMaxAge = do
62+ maxAgeString <- (string $ maxAgeTag <> "=") *> attributeValue
63+ case Int.fromString maxAgeString of
64+ Nothing -> fail "invalid integer"
65+ Just maxAge -> pure $ Cookie.setMaxAge maxAge
66+
67+parseSecure :: Parser String Attribute
68+parseSecure = (string secureTag) $> Cookie.setSecure
69+
70+parseHttpOnly :: Parser String Attribute
71+parseHttpOnly = (string httpOnlyTag) $> Cookie.setHttpOnly
72+
73+parseSameSite :: Parser String Attribute
74+parseSameSite = do
75+ sameSiteString <- (string $ sameSiteTag <> "=") *> attributeValue
76+ case sameSiteString of
77+ "Strict" -> pure $ Cookie.setSameSite Strict
78+ "Lax" -> pure $ Cookie.setSameSite Lax
79+ "None" -> pure $ Cookie.setSameSite None
80+ val -> fail $ "unknown SiteSite value " <> val
81+
82+parseAttribute :: Parser String Attribute
83+parseAttribute =
84+ parseDomain
85+ <|> parsePath
86+ <|> parseExpires
87+ <|> parseMaxAge
88+ <|> parseSecure
89+ <|> parseHttpOnly
90+ <|> parseSameSite
91+
92+parseSimpleCookie :: Parser String Cookie
93+parseSimpleCookie = do
94+ name <- stringWithout ([ ';', ',', '=' ] <> whitespaceChars) <* string "="
95+ value <- stringWithout ([ ';', ',' ] <> whitespaceChars)
96+ pure $ Cookie.new name value
97+
98+parseCookie :: Parser String Cookie
99+parseCookie = do
100+ cookie <- parseSimpleCookie <* dropSeperator
101+ attributes <- sepBy parseAttribute (string "; ") <* eof
102+ pure $ foldl (#) cookie attributes
103+
104+parseCookies :: Parser String (List Cookie)
105+parseCookies = sepBy parseSimpleCookie (string "; ") <* eof
106+
107+-- | Parses a `String` into an `Either ParseError Cookie`. This
108+-- | function is primarily intended to parse the `Set-Cookie`
109+-- | header on the client.
110+-- |
111+-- | ```purescript
112+-- | > Parser.parse "key=value; Secure"
113+-- | (Right { name: "key", value: "value", secure: true, ... })
114+-- | ```
115+parse :: String -> Either ParseError Cookie
116+parse = flip runParser parseCookie
117+
118+-- | Parses a `String` into an `Either ParseError (List Cookie)`.
119+-- | HTTP requests can include multiple cookies in a single
120+-- | `Cookie` header consisting of only name/value pairs. This
121+-- | function can be used to parse this header.
122+-- |
123+-- | ```purescript
124+-- | > parseMany "key1=value1; key2=value2"
125+-- | (Right ({ name: "key1", value: "value1", ... } : { name: "key2", value: "value2", ... } : Nil))
126+-- | ```
127+parseMany :: String -> Either ParseError (List Cookie)
128+parseMany = flip runParser parseCookies
src/PureStack/Cookie/Types.pursnew file+189
@@ -0,0 +1,189 @@
1+-- | This module contains the `Cookie` type and functions for operating on data within it.
2+module PureStack.Cookie.Types
3+ ( Cookie
4+ , SameSite(..)
5+ , _domain
6+ , _expires
7+ , _httpOnly
8+ , _maxAge
9+ , _name
10+ , _path
11+ , _secure
12+ , _value
13+ , expire
14+ , fromFields
15+ , getDomain
16+ , getExpires
17+ , getHttpOnly
18+ , getMaxAge
19+ , getName
20+ , getPath
21+ , getSameSite
22+ , getSecure
23+ , getValue
24+ , new
25+ , setDomain
26+ , setExpires
27+ , setHttpOnly
28+ , setMaxAge
29+ , setPath
30+ , setSameSite
31+ , setSecure
32+ ) where
33+
34+import Prelude
35+import Data.DateTime (DateTime)
36+import Data.DateTime as DateTime
37+import Data.Either (Either(..))
38+import Data.Lens (Iso', Lens', iso)
39+import Data.Lens as Lens
40+import Data.Lens.Record (prop)
41+import Data.Maybe (Maybe(..))
42+import Data.Time.Duration (Days(..))
43+import Effect.Now (nowDateTime)
44+import Effect (Effect)
45+import Type.Prelude (Proxy(..))
46+
47+-- | Type representing a `Cookie`'s optional `SameSite` attribute.
48+data SameSite
49+ = Strict
50+ | Lax
51+ | None
52+
53+derive instance eqSameSite :: Eq SameSite
54+
55+derive instance ordSameSite :: Ord SameSite
56+
57+instance showSameSite :: Show SameSite where
58+ show :: SameSite -> String
59+ show Strict = "Strict"
60+ show Lax = "Lax"
61+ show None = "None"
62+
63+type CookieFields =
64+ { name :: String
65+ , value :: String
66+ , domain :: Maybe String
67+ , path :: Maybe String
68+ , expires :: Maybe DateTime
69+ , maxAge :: Maybe Int
70+ , sameSite :: Maybe SameSite
71+ , secure :: Boolean
72+ , httpOnly :: Boolean
73+ }
74+
75+-- | The `Cookie` type
76+newtype Cookie = Cookie CookieFields
77+
78+derive newtype instance eqCookie :: Eq Cookie
79+
80+derive newtype instance ordCookie :: Ord Cookie
81+
82+derive newtype instance showCookie :: Show Cookie
83+
84+-- | The constructor for `Cookie`
85+new :: String -> String -> Cookie
86+new name value =
87+ Cookie
88+ { name
89+ , value
90+ , domain: Nothing
91+ , path: Nothing
92+ , expires: Nothing
93+ , maxAge: Nothing
94+ , sameSite: Nothing
95+ , secure: false
96+ , httpOnly: false
97+ }
98+
99+fromFields :: CookieFields -> Cookie
100+fromFields = Cookie
101+
102+-- | Expire an existing `Cookie`. This sets the `Expires` attribute of
103+-- | the cookie to yesterday's date.
104+expire :: Cookie -> Effect (Either String Cookie)
105+expire cookie = do
106+ now <- nowDateTime
107+ let maybeDate = DateTime.adjust (Days $ -1.0) now
108+
109+ case maybeDate of
110+ Nothing -> pure $ Left "Invalid date"
111+ Just yesterday -> pure $ Right $ setExpires yesterday cookie
112+
113+getDomain :: Cookie -> Maybe String
114+getDomain = Lens.view _domain
115+
116+getExpires :: Cookie -> Maybe DateTime
117+getExpires = Lens.view _expires
118+
119+getHttpOnly :: Cookie -> Boolean
120+getHttpOnly = Lens.view _httpOnly
121+
122+getMaxAge :: Cookie -> Maybe Int
123+getMaxAge = Lens.view _maxAge
124+
125+getName :: Cookie -> String
126+getName = Lens.view _name
127+
128+getPath :: Cookie -> Maybe String
129+getPath = Lens.view _path
130+
131+getSameSite :: Cookie -> Maybe SameSite
132+getSameSite = Lens.view _sameSite
133+
134+getSecure :: Cookie -> Boolean
135+getSecure = Lens.view _secure
136+
137+getValue :: Cookie -> String
138+getValue = Lens.view _value
139+
140+setDomain :: String -> Cookie -> Cookie
141+setDomain = Lens.setJust _domain
142+
143+setExpires :: DateTime -> Cookie -> Cookie
144+setExpires = Lens.setJust _expires
145+
146+setHttpOnly :: Cookie -> Cookie
147+setHttpOnly = Lens.set _httpOnly true
148+
149+setMaxAge :: Int -> Cookie -> Cookie
150+setMaxAge = Lens.setJust _maxAge
151+
152+setPath :: String -> Cookie -> Cookie
153+setPath = Lens.setJust _path
154+
155+setSameSite :: SameSite -> Cookie -> Cookie
156+setSameSite = Lens.setJust _sameSite
157+
158+setSecure :: Cookie -> Cookie
159+setSecure = Lens.set _secure true
160+
161+_Cookie :: Iso' Cookie CookieFields
162+_Cookie = iso (\(Cookie fields) -> fields) Cookie
163+
164+_domain :: Lens' Cookie (Maybe String)
165+_domain = _Cookie <<< prop (Proxy :: Proxy "domain")
166+
167+_expires :: Lens' Cookie (Maybe DateTime)
168+_expires = _Cookie <<< prop (Proxy :: Proxy "expires")
169+
170+_httpOnly :: Lens' Cookie Boolean
171+_httpOnly = _Cookie <<< prop (Proxy :: Proxy "httpOnly")
172+
173+_maxAge :: Lens' Cookie (Maybe Int)
174+_maxAge = _Cookie <<< prop (Proxy :: Proxy "maxAge")
175+
176+_name :: Lens' Cookie String
177+_name = _Cookie <<< prop (Proxy :: Proxy "name")
178+
179+_path :: Lens' Cookie (Maybe String)
180+_path = _Cookie <<< prop (Proxy :: Proxy "path")
181+
182+_sameSite :: Lens' Cookie (Maybe SameSite)
183+_sameSite = _Cookie <<< prop (Proxy :: Proxy "sameSite")
184+
185+_secure :: Lens' Cookie Boolean
186+_secure = _Cookie <<< prop (Proxy :: Proxy "secure")
187+
188+_value :: Lens' Cookie String
189+_value = _Cookie <<< prop (Proxy :: Proxy "value")
src/PureStack/Route.purs+31−10
@@ -1,27 +1,45 @@
1module PureStack.Route
1module PureStack.Route
2 ( type (/)
2 ( type (/)
3 , Slash
3 , Slash
4+ , HttpMethod
5+ , class MethodName
6+ , methodName
4 , GET
7 , GET
5 , POST
8 , POST
6 , PUT
9 , PUT
7 , DELETE
10 , DELETE
8 , PATCH
11 , PATCH
12+ , Headers(..)
13+ , Middleware
9 ) where
14 ) where
10
15
11−data GET :: Type -> Type
16+data HttpMethod
12−data GET resp
13
17
14−data POST :: Type -> Type -> Type
18+-- | The `req` can only ever be `Unit`
15−data POST req resp
19+foreign import data GET :: Type -> Type -> HttpMethod
20+foreign import data POST :: Type -> Type -> HttpMethod
21+foreign import data PUT :: Type -> Type -> HttpMethod
22+foreign import data DELETE :: Type -> Type -> HttpMethod
23+foreign import data PATCH :: Type -> Type -> HttpMethod
16
24
17−data PUT :: Type -> Type -> Type
25+class MethodName :: HttpMethod -> Constraint
18−data PUT req resp
26+class MethodName method where
27+ methodName :: String
19
28
20−data DELETE :: Type -> Type -> Type
29+instance MethodName (GET req resp) where
21−data DELETE req resp
30+ methodName = "GET"
22
31
23−data PATCH :: Type -> Type -> Type
32+instance MethodName (POST req resp) where
33+ methodName = "POST"
34+
35+instance MethodName (PUT req resp) where
36+ methodName = "PUT"
37+
38+instance MethodName (DELETE req resp) where
39+ methodName = "DELETE"
40+
24−data PATCH req resp
41+instance MethodName (PATCH req resp) where
42+ methodName = "PATCH"
25
43
26data Slash :: forall k1 k2. k1 -> k2 -> Type
44data Slash :: forall k1 k2. k1 -> k2 -> Type
27data Slash x y
45data Slash x y
@@ -32,3 +50,6 @@ data Slash x y
32-- | Other types are captured path pieces.
50-- | Other types are captured path pieces.
33infixr 1 type Slash as /
51infixr 1 type Slash as /
34
52
53+data Headers headers r = Headers headers r
54+
55+data Middleware tag
src/PureStack/Server.purs+174−162
@@ -1,5 +1,7 @@
1module PureStack.Server
1module PureStack.Server
2 ( Server
2 ( Server
3+ , Response(..)
4+ , ResponseBody(..)
3 , class ToResponse
5 , class ToResponse
4 , toResponse
6 , toResponse
5 , class FromRequest
7 , class FromRequest
@@ -18,20 +20,24 @@ module PureStack.Server
18 , serveQuery
20 , serveQuery
19 , class ParsePathPiece
21 , class ParsePathPiece
20 , parsePathPiece
22 , parsePathPiece
23+ , class FromHeaders
24+ , fromHeaders
25+ , class FromHeader
26+ , fromHeader
21 ) where
27 ) where
22
28
23import Prelude
29import Prelude
24import PureStack.Route
30import PureStack.Route
25
31
26import Bun.Request (Request)
32import Bun.Request (Request)
33+import Bun.Request as Bun
27import Bun.Request as Request
34import Bun.Request as Request
28−import Bun.Response (Response)
35+import Bun.Response as Bun.Response
29−import Bun.Response as Response
30import Control.Alternative (class Plus, empty)
36import Control.Alternative (class Plus, empty)
31import Control.Monad.Except (ExceptT, runExceptT)
37import Control.Monad.Except (ExceptT, runExceptT)
32−import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson)
38+import Data.Argonaut (class DecodeJson, class EncodeJson, Json, decodeJson, encodeJson)
33import Data.Array as Array
39import Data.Array as Array
34−import Data.Either (Either(..))
40+import Data.Either (Either(..), either)
35import Data.Int as Int
41import Data.Int as Int
36import Data.Map (Map)
42import Data.Map (Map)
37import Data.Map as Map
43import Data.Map as Map
@@ -43,15 +49,24 @@ import Data.Traversable (traverse)
43import Data.URL as URL
49import Data.URL as URL
44import Effect.Aff (Aff)
50import Effect.Aff (Aff)
45import Effect.Aff.Class (liftAff)
51import Effect.Aff.Class (liftAff)
52+import Foreign.Object (Object)
53+import Foreign.Object as Object
46import Prim.Row as Row
54import Prim.Row as Row
47import Prim.RowList (class RowToList, RowList)
55import Prim.RowList (class RowToList, RowList)
48import Prim.RowList as RowList
56import Prim.RowList as RowList
57+import PureStack.Cookie (Cookie)
58+import PureStack.Cookie as Cookie
49import Record as Record
59import Record as Record
50import Record.Builder (Builder)
60import Record.Builder (Builder)
51import Record.Builder as Builder
61import Record.Builder as Builder
52import Type.Proxy (Proxy(..))
62import Type.Proxy (Proxy(..))
53
63
64+type Route =
65+ { path :: Array String
66+ , verb :: String
54−type Route = { path :: Array String, verb :: String, query :: Map String (Array String) }
67+ , query :: Map String (Array String)
68+ , originalRequest :: Bun.Request
69+ }
55
70
56routeFromRequest :: Request -> Route
71routeFromRequest :: Request -> Route
57routeFromRequest req =
72routeFromRequest req =
@@ -68,185 +83,94 @@ routeFromRequest req =
68 , query: case url of
83 , query: case url of
69 Nothing -> Map.empty
84 Nothing -> Map.empty
70 Just u -> URL.query u
85 Just u -> URL.query u
86+ , originalRequest: req
71 }
87 }
72
88
73type Server a = ExceptT Response Aff a
89type Server a = ExceptT Response Aff a
74
90
75newtype Nt m = Nt (forall x. m x -> Server x)
91newtype Nt m = Nt (forall x. m x -> Server x)
76
92
77−class ServeRoute :: forall k. k -> Type -> (Type -> Type) -> Constraint
93+class ServeRoute :: forall k. k -> Type -> Row Type -> (Type -> Type) -> Constraint
78−class ServeRoute route handler m | route -> handler, handler -> m where
94+class ServeRoute route handler middlewares m | route middlewares -> handler, handler -> m where
79− serveRoute :: Route -> Maybe (Nt m -> handler -> Request -> Server Response)
95+ serveRoute :: Route -> Maybe (Nt m -> handler -> Record middlewares -> Request -> Server Response)
80
96
81−instance (ServeRoute rest handler m, IsSymbol path) => ServeRoute (path / rest) handler m where
97+instance (ServeRoute rest handler middlewares m, IsSymbol path) => ServeRoute (path / rest) handler middlewares m where
82 serveRoute route@{ path } = do
98 serveRoute route@{ path } = do
83 { head: h, tail } <- Array.uncons path
99 { head: h, tail } <- Array.uncons path
84 assert $ h == (reflectSymbol @path Proxy)
100 assert $ h == (reflectSymbol @path Proxy)
85 serveRoute @rest route { path = tail }
101 serveRoute @rest route { path = tail }
86
102
87else instance
103else instance
88− ( ServeRoute rest handler m
104+ ( ServeRoute rest handler middlewares m
89 , ServeQuery row list
105 , ServeQuery row list
90 , RowToList row list
106 , RowToList row list
91 ) =>
107 ) =>
92− ServeRoute (Record row / rest) (Record row -> handler) m where
108+ ServeRoute (Record row / rest) (Record row -> handler) middlewares m where
93 serveRoute route@{ query } = do
109 serveRoute route@{ query } = do
94 builder <- serveQuery @row @list query
110 builder <- serveQuery @row @list query
95 serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)
111 serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)
96
112
113+else instance
114+ ( ServeRoute rest handler middlewares m
115+ , IsSymbol field
116+ , Row.Cons field (Bun.Request -> m x) tail middlewares
117+ ) =>
118+ ServeRoute (Middleware field / rest) (x -> handler) middlewares m where
119+ serveRoute route@{ originalRequest } = do
120+ serveRoute @rest route <#>
121+ ( \f nt@(Nt ntf) handler middlewares req -> do
122+ x <- ntf $ Record.get (Proxy @field) middlewares originalRequest
123+ f nt (handler x) middlewares req
124+ )
125+
97−else instance (ServeRoute rest handler m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) m where
126+else instance (ServeRoute rest handler middlewares m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) middlewares m where
98 serveRoute route@{ path } = do
127 serveRoute route@{ path } = do
99 { head: h, tail } <- Array.uncons path
128 { head: h, tail } <- Array.uncons path
100 t <- parsePathPiece @t h
129 t <- parsePathPiece @t h
101− serveRoute @rest route { path = tail } <#> (\f nt handler req -> f nt (handler t) req)
130+ serveRoute @rest route { path = tail } <#> (\f nt handler mws req -> f nt (handler t) mws req)
102−
103−else instance ToResponse resp => ServeRoute (GET resp) (m resp) m where
104− serveRoute { path, verb } = do
105− assert $ verb == "GET"
106− assert $ path == []
107− pure $ \(Nt nt) handler _req -> do
108− resp <- nt handler
109− pure $ toResponse resp
110−
111−else instance ServeRoute (POST Unit Unit) (m Unit) m where
112− serveRoute { path, verb } = do
113− assert $ verb == "POST"
114− assert $ path == []
115− pure $ \(Nt nt) handler _req -> do
116− nt handler
117− pure $ ok
118−else instance (ToResponse resp) => ServeRoute (POST Unit resp) (m resp) m where
119− serveRoute { path, verb } = do
120− assert $ verb == "POST"
121− assert $ path == []
122− pure $ \(Nt nt) handler _req -> do
123− resp <- nt handler
124− pure $ toResponse resp
125−else instance (FromRequest req) => ServeRoute (POST resp Unit) (req -> m Unit) m where
126− serveRoute { path, verb } = do
127− assert $ verb == "POST"
128− assert $ path == []
129− pure $ \(Nt nt) handler req -> do
130− liftAff (fromRequest req) >>= case _ of
131− Nothing -> pure $ badRequest
132− Just r -> do
133− nt $ handler r
134− pure $ ok
135−else instance (FromRequest req, ToResponse resp) => ServeRoute (POST req resp) (req -> m resp) m where
136− serveRoute { path, verb } = do
137− assert $ verb == "POST"
138− assert $ path == []
139− pure $ \(Nt nt) handler req -> do
140− liftAff (fromRequest req) >>= case _ of
141− Nothing -> pure $ badRequest
142− Just r -> do
143− resp <- nt $ handler r
144− pure $ toResponse resp
145−
146−else instance ServeRoute (DELETE Unit Unit) (m Unit) m where
147− serveRoute { path, verb } = do
148− assert $ verb == "DELETE"
149− assert $ path == []
150− pure $ \(Nt nt) handler _req -> do
151− nt handler
152− pure $ ok
153−else instance (ToResponse resp) => ServeRoute (DELETE Unit resp) (m resp) m where
154− serveRoute { path, verb } = do
155− assert $ verb == "DELETE"
156− assert $ path == []
157− pure $ \(Nt nt) handler _req -> do
158− resp <- nt handler
159− pure $ toResponse resp
160−else instance (FromRequest req) => ServeRoute (DELETE resp Unit) (req -> m Unit) m where
161− serveRoute { path, verb } = do
162− assert $ verb == "DELETE"
163− assert $ path == []
164− pure $ \(Nt nt) handler req -> do
165− liftAff (fromRequest req) >>= case _ of
166− Nothing -> pure $ badRequest
167− Just r -> do
168− nt $ handler r
169− pure $ ok
170−else instance (FromRequest req, ToResponse resp) => ServeRoute (DELETE req resp) (req -> m resp) m where
171− serveRoute { path, verb } = do
172− assert $ verb == "DELETE"
173− assert $ path == []
174− pure $ \(Nt nt) handler req -> do
175− liftAff (fromRequest req) >>= case _ of
176− Nothing -> pure $ badRequest
177− Just r -> do
178− resp <- nt $ handler r
179− pure $ toResponse resp
180
131
181−else instance ServeRoute (PUT Unit Unit) (m Unit) m where
132+else instance MethodName (meth Unit Unit) => ServeRoute (meth Unit Unit) (m Unit) middlewares m where
182 serveRoute { path, verb } = do
133 serveRoute { path, verb } = do
183− assert $ verb == "PUT"
134+ assert $ verb == methodName @(meth Unit Unit)
184 assert $ path == []
135 assert $ path == []
185− pure $ \(Nt nt) handler _req -> do
136+ pure $ \(Nt nt) handler _middlewares _req -> do
186 nt handler
137 nt handler
187 pure $ ok
138 pure $ ok
188−else instance (ToResponse resp) => ServeRoute (PUT Unit resp) (m resp) m where
139+else instance (ToResponse resp, MethodName (meth Unit resp)) => ServeRoute (meth Unit resp) (m resp) middlewares m where
189 serveRoute { path, verb } = do
140 serveRoute { path, verb } = do
190− assert $ verb == "PUT"
141+ assert $ verb == methodName @(meth Unit resp)
191 assert $ path == []
142 assert $ path == []
192− pure $ \(Nt nt) handler _req -> do
143+ pure $ \(Nt nt) handler _middlewares _req -> do
193 resp <- nt handler
144 resp <- nt handler
194 pure $ toResponse resp
145 pure $ toResponse resp
195−else instance (FromRequest req) => ServeRoute (PUT resp Unit) (req -> m Unit) m where
146+else instance (FromRequest req, MethodName (meth resp Unit)) => ServeRoute (meth resp Unit) (req -> m Unit) middlewares m where
196 serveRoute { path, verb } = do
147 serveRoute { path, verb } = do
197− assert $ verb == "PUT"
148+ assert $ verb == methodName @(meth resp Unit)
198 assert $ path == []
149 assert $ path == []
199− pure $ \(Nt nt) handler req -> do
150+ pure $ \(Nt nt) handler _middlewares req -> do
200 liftAff (fromRequest req) >>= case _ of
151 liftAff (fromRequest req) >>= case _ of
201 Nothing -> pure $ badRequest
152 Nothing -> pure $ badRequest
202 Just r -> do
153 Just r -> do
203 nt $ handler r
154 nt $ handler r
204 pure $ ok
155 pure $ ok
205−else instance (FromRequest req, ToResponse resp) => ServeRoute (PUT req resp) (req -> m resp) m where
156+else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) => ServeRoute (meth req resp) (req -> m resp) middlewares m where
206 serveRoute { path, verb } = do
157 serveRoute { path, verb } = do
207− assert $ verb == "PUT"
158+ assert $ verb == methodName @(meth req resp)
208 assert $ path == []
159 assert $ path == []
209− pure $ \(Nt nt) handler req -> do
160+ pure $ \(Nt nt) handler _middlewares req -> do
210 liftAff (fromRequest req) >>= case _ of
161 liftAff (fromRequest req) >>= case _ of
211 Nothing -> pure $ badRequest
162 Nothing -> pure $ badRequest
212 Just r -> do
163 Just r -> do
213 resp <- nt $ handler r
164 resp <- nt $ handler r
214 pure $ toResponse resp
165 pure $ toResponse resp
215
166
216−else instance ServeRoute (PATCH Unit Unit) (m Unit) m where
167+else instance
217− serveRoute { path, verb } = do
168+ ( ServeAPI routes list handlers middlewares m
218− assert $ verb == "PATCH"
169+ , RowToList routes list
219− assert $ path == []
170+ ) =>
220− pure $ \(Nt nt) handler _req -> do
171+ ServeRoute routes (Record handlers) middlewares m where
221− nt handler
172+ serveRoute route = pure $ \nt handlers middlewares req ->
222− pure $ ok
173+ serveAPI @routes @list nt handlers middlewares route req
223−else instance (ToResponse resp) => ServeRoute (PATCH Unit resp) (m resp) m where
224− serveRoute { path, verb } = do
225− assert $ verb == "PATCH"
226− assert $ path == []
227− pure $ \(Nt nt) handler _req -> do
228− resp <- nt handler
229− pure $ toResponse resp
230−else instance (FromRequest req) => ServeRoute (PATCH resp Unit) (req -> m Unit) m where
231− serveRoute { path, verb } = do
232− assert $ verb == "PATCH"
233− assert $ path == []
234− pure $ \(Nt nt) handler req -> do
235− liftAff (fromRequest req) >>= case _ of
236− Nothing -> pure $ badRequest
237− Just r -> do
238− nt $ handler r
239− pure $ ok
240−else instance (FromRequest req, ToResponse resp) => ServeRoute (PATCH req resp) (req -> m resp) m where
241− serveRoute { path, verb } = do
242− assert $ verb == "PATCH"
243− assert $ path == []
244− pure $ \(Nt nt) handler req -> do
245− liftAff (fromRequest req) >>= case _ of
246− Nothing -> pure $ badRequest
247− Just r -> do
248− resp <- nt $ handler r
249− pure $ toResponse resp
250
174
251class ServeQuery :: Row Type -> RowList Type -> Constraint
175class ServeQuery :: Row Type -> RowList Type -> Constraint
252class ServeQuery row list | list -> row where
176class ServeQuery row list | list -> row where
@@ -304,11 +228,18 @@ else instance
304 r <- serveQuery @tail @rest m
228 r <- serveQuery @tail @rest m
305 pure $ Builder.insert (Proxy @field) v <<< r
229 pure $ Builder.insert (Proxy @field) v <<< r
306
230
231+data ResponseBody
232+ = JsonResponseBody Json
233+ | EmptyResponseBody
234+ | StringResponseBody String
235+
236+newtype Response = Response { body :: ResponseBody, status :: Int, statusText :: String, headers :: Object String }
237+
307class ToResponse r where
238class ToResponse r where
308 toResponse :: r -> Response
239 toResponse :: r -> Response
309
240
310instance EncodeJson (Record row) => ToResponse (Record row) where
241instance EncodeJson (Record row) => ToResponse (Record row) where
311− toResponse rec = Response.json (encodeJson rec) { status: 200, statusText: "OK", headers: [] }
242+ toResponse rec = Response { body: JsonResponseBody $ encodeJson rec, status: 200, statusText: "OK", headers: Object.empty }
312
243
313instance ToResponse Response where
244instance ToResponse Response where
314 toResponse resp = resp
245 toResponse resp = resp
@@ -324,6 +255,84 @@ instance DecodeJson (Record row) => FromRequest (Record row) where
324instance FromRequest Request where
255instance FromRequest Request where
325 fromRequest req = pure $ Just req
256 fromRequest req = pure $ Just req
326
257
258+instance FromRequest Unit where
259+ fromRequest _ = pure $ Just unit
260+
261+instance
262+ ( FromRequest req
263+ , FromHeader header
264+ ) =>
265+ FromRequest (Headers (Object header) req) where
266+ fromRequest req = do
267+ r <- fromRequest req
268+ pure $ do
269+ headers <- traverse fromHeader (Request.headers req)
270+ r' <- r
271+ pure $ Headers headers r'
272+
273+instance
274+ ( RowToList headers headersList
275+ , FromRequest req
276+ , FromHeaders headers headersList
277+ ) =>
278+ FromRequest (Headers (Record headers) req) where
279+ fromRequest req = do
280+ r <- fromRequest req
281+ pure $ do
282+ headers <- fromHeaders @headers @headersList (Request.headers req)
283+ r' <- r
284+ pure $ Headers (Builder.buildFromScratch headers) r'
285+
286+class FromHeader t where
287+ fromHeader :: String -> Maybe t
288+
289+instance FromHeader Cookie where
290+ fromHeader = Cookie.parse >>> case _ of
291+ Left _ -> Nothing
292+ Right x -> Just x
293+
294+instance FromHeader String where
295+ fromHeader = Just
296+
297+instance FromHeader Int where
298+ fromHeader = Int.fromString
299+
300+class FromHeaders :: Row Type -> RowList Type -> Constraint
301+class FromHeaders row list | list -> row where
302+ fromHeaders :: Object String -> Maybe (Builder {} (Record row))
303+
304+instance FromHeaders () RowList.Nil where
305+ fromHeaders _ = Just $ identity
306+
307+instance
308+ ( FromHeader t
309+ , IsSymbol field
310+ , FromHeaders tail rest
311+ , Row.Cons field (Maybe t) tail row
312+ , Row.Lacks field tail
313+ ) =>
314+ FromHeaders row (RowList.Cons field (Maybe t) rest) where
315+ fromHeaders headers = do
316+ r <- fromHeaders @tail @rest headers
317+ case Object.lookup (reflectSymbol @field Proxy) headers of
318+ Nothing -> pure $ Builder.insert (Proxy @field) Nothing <<< r
319+ Just t -> do
320+ v <- fromHeader t
321+ pure $ Builder.insert (Proxy @field) (Just v) <<< r
322+
323+else instance
324+ ( FromHeader t
325+ , IsSymbol field
326+ , FromHeaders tail rest
327+ , Row.Cons field t tail row
328+ , Row.Lacks field tail
329+ ) =>
330+ FromHeaders row (RowList.Cons field t rest) where
331+ fromHeaders headers = do
332+ t <- Object.lookup (reflectSymbol @field Proxy) headers >>= fromHeader
333+ r <- fromHeaders @tail @rest headers
334+ pure $ Builder.insert (Proxy @field) t <<< r
335+
327class ParsePathPiece t where
336class ParsePathPiece t where
328 parsePathPiece :: String -> Maybe t
337 parsePathPiece :: String -> Maybe t
329
338
@@ -348,51 +357,54 @@ assert :: forall m. Applicative m => Plus m => Boolean -> m Unit
348assert true = pure unit
357assert true = pure unit
349assert false = empty
358assert false = empty
350
359
351−class ServeAPI :: Row Type -> RowList Type -> Row Type -> (Type -> Type) -> Constraint
360+class ServeAPI :: Row Type -> RowList Type -> Row Type -> Row Type -> (Type -> Type) -> Constraint
352−class ServeAPI row list handlers m | row -> handlers, handlers -> m where
361+class ServeAPI row list handlers middlewares m | row -> handlers, handlers -> m where
353− serveAPI :: Nt m -> Record handlers -> Route -> Request -> Server Response
362+ serveAPI :: Nt m -> Record handlers -> Record middlewares -> Route -> Request -> Server Response
354
363
355−instance ServeAPI row RowList.Nil () m where
364+instance ServeAPI row RowList.Nil () middlewares m where
356− serveAPI _ _ _ _ = pure notFound
365+ serveAPI _ _ _ _ _ = pure notFound
357
366
358instance
367instance
359− ( ServeRoute t handler m
368+ ( ServeRoute t handler middlewares m
360 , Row.Cons field t tail row
369 , Row.Cons field t tail row
361− , ServeAPI row rest restHandlers m
370+ , ServeAPI row rest restHandlers middlewares m
362 , IsSymbol field
371 , IsSymbol field
363 , Row.Cons field handler restHandlers handlers
372 , Row.Cons field handler restHandlers handlers
364 , Row.Lacks field restHandlers
373 , Row.Lacks field restHandlers
365 ) =>
374 ) =>
366− ServeAPI row (RowList.Cons field t rest) handlers m where
375+ ServeAPI row (RowList.Cons field t rest) handlers middlewares m where
367− serveAPI nt handlers route req =
376+ serveAPI nt handlers middlewares route req =
368 case serveRoute @t route of
377 case serveRoute @t route of
369− Nothing -> serveAPI @row @rest @restHandlers nt (Record.delete (Proxy @field) handlers) route req
378+ Nothing -> serveAPI @row @rest @restHandlers @middlewares nt (Record.delete (Proxy @field) handlers) middlewares route req
370− Just f -> f nt (Record.get (Proxy @field) handlers) req
379+ Just f -> f nt (Record.get (Proxy @field) handlers) middlewares req
371
380
372notFound :: Response
381notFound :: Response
373−notFound = Response.string "" { status: 404, statusText: "Not Found", headers: [] }
382+notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }
374
383
375internalServerError :: Response
384internalServerError :: Response
376−internalServerError = Response.string "" { status: 500, statusText: "Internal Server Error", headers: [] }
385+internalServerError = Response { body: EmptyResponseBody, status: 500, statusText: "Internal Server Error", headers: Object.empty }
377
386
378badRequest :: Response
387badRequest :: Response
379−badRequest = Response.string "" { status: 400, statusText: "Bad Request", headers: [] }
388+badRequest = Response { body: EmptyResponseBody, status: 400, statusText: "Bad Request", headers: Object.empty }
380
389
381ok :: Response
390ok :: Response
382−ok = Response.string "" { status: 200, statusText: "OK", headers: [] }
391+ok = Response { body: EmptyResponseBody, status: 200, statusText: "OK", headers: Object.empty }
383
392
384-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
393-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
385-- | instead you can just pass `identity` as the first argument.
394-- | instead you can just pass `identity` as the first argument.
386run
395run
387− :: forall @row list handlers m
396+ :: forall @row list handlers m middlewares
388 . RowToList row list
397 . RowToList row list
389− => ServeAPI row list handlers m
398+ => ServeAPI row list handlers middlewares m
390 => (forall x. m x -> Server x)
399 => (forall x. m x -> Server x)
391− -> Record handlers
400+ -> { handlers :: Record handlers, middlewares :: Record middlewares }
392 -> Request
401 -> Request
393− -> Aff Response
402+ -> Aff Bun.Response.Response
394−run nt handlers req = do
403+run nt { handlers, middlewares } req = do
404+ Response { body, headers, status, statusText } <-
395− res <- runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers (routeFromRequest req) req
405+ map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers middlewares (routeFromRequest req) req
406+ let opts = { headers, status, statusText }
396− pure case res of
407+ pure $ case body of
397− Left resp -> resp
408+ EmptyResponseBody -> Bun.Response.string "" opts
398− Right resp -> resp
409+ JsonResponseBody json -> Bun.Response.json json opts
410+ StringResponseBody string -> Bun.Response.string string opts