git.iko.soy/purestack-dev/purescript-purestack-server
on a6a87a1 help sign in
599c6d5
swap
0 ahead, 2 behind
11 files changed+172−702
since splitsnapshots
unifiedsplit
spago.dhall−7 src/Bun/Request.js−4 src/Bun/Request.purs−4 src/Main.purs+7−10 src/PureStack/Cookie.purs−57 src/PureStack/Cookie/Formatter.purs−65 src/PureStack/Cookie/Generator.purs−62 src/PureStack/Cookie/Parser.purs−128 src/PureStack/Cookie/Types.purs−189 src/PureStack/Route.purs+11−31 src/PureStack/Server.purs+154−145
spago.dhall−7
@@ -6,21 +6,14 @@
66 , "arrays"
77 , "console"
88 , "control"
9− , "datetime"
109 , "effect"
1110 , "either"
1211 , "foldable-traversable"
13− , "foreign-object"
14− , "formatters"
1512 , "integers"
16− , "lists"
1713 , "maybe"
18− , "now"
1914 , "numbers"
2015 , "ordered-collections"
21− , "parsing"
2216 , "prelude"
23− , "profunctor-lenses"
2417 , "record"
2518 , "run"
2619 , "strings"
src/Bun/Request.js−4
@@ -9,7 +9,3 @@ export function method(req) {
99export function url(req) {
1010 return req.url
1111}
12−
13−export function headers(req) {
14− return Object.fromEntries(req.headers.entries());
15−}
src/Bun/Request.purs−4
@@ -3,7 +3,6 @@ module Bun.Request
33 , method
44 , url
55 , json
6− , headers
76 ) where
87
98import Prelude
@@ -12,7 +11,6 @@ import Control.Promise (Promise)
1211import Control.Promise as Promise
1312import Data.Argonaut (Json)
1413import Effect.Aff (Aff)
15−import Foreign.Object (Object)
1614
1715foreign import data Request :: Type
1816
@@ -24,5 +22,3 @@ json = jsonPromise >>> Promise.toAff
2422foreign import method :: Request -> String
2523
2624foreign import url :: Request -> String
27−
28−foreign import headers :: Request -> Object String
src/Main.purs+7−10
@@ -7,7 +7,7 @@ import Data.Maybe (Maybe)
77import Effect (Effect)
88import Effect.Aff (Aff)
99import Effect.Console (log)
10−import PureStack.Route (type (/), GET, Headers(..), Middleware, POST)
10+import PureStack.Route (type (/), GET, POST)
1111import PureStack.Route as Router
1212import PureStack.Server as Server
1313import Run (AFF, Run(..), runBaseAff)
@@ -16,11 +16,11 @@ import Type.Row (type (+))
1616type Foo = { a :: String, b :: Maybe Int, c :: Array Number }
1717
1818type API =
19− ( foo :: "foo" / "bar" / Foo / GET Unit { a :: Int, b :: Number, c :: Foo }
20− , bar :: "foo" / Middleware "auth" / "qux" / POST (Headers { foo :: String } Unit) { a :: Int, s :: String }
19+ ( foo :: "foo" / "bar" / Foo / GET { a :: Int, b :: Number, c :: Foo }
20+ , bar :: "foo" / "qux" / POST Unit { a :: Int }
2121 , deep ::
2222 "deep" /
23− ( something :: "something" / GET Unit { a :: String }
23+ ( something :: "something" / GET { a :: String }
2424 )
2525 )
2626
@@ -28,10 +28,7 @@ main :: Effect Unit
2828main = do
2929 log "🍝"
3030 Bun.serve $ Server.run @API identity
31− { handlers:
32− { foo: \x -> pure { a: 1, b: 1.0, c: x }
33− , bar: \i (Headers x _) -> pure { a: 8, s: x.foo }
34− , deep: { something: pure { a: "something" } }
35− }
36− , middlewares: { auth: \req -> pure 1 }
31+ { foo: \x -> pure { a: 1, b: 1.0, c: x }
32+ , bar: pure { a: 8 }
33+ , deep: { something: pure { a: "something" } }
3734 }
src/PureStack/Cookie.pursdeleted−57
@@ -1,57 +0,0 @@
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.pursdeleted−65
@@ -1,65 +0,0 @@
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.pursdeleted−62
@@ -1,62 +0,0 @@
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.pursdeleted−128
@@ -1,128 +0,0 @@
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.pursdeleted−189
@@ -1,189 +0,0 @@
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+11−31
@@ -1,45 +1,27 @@
11module PureStack.Route
22 ( type (/)
33 , Slash
4− , HttpMethod
5− , class MethodName
6− , methodName
74 , GET
85 , POST
96 , PUT
107 , DELETE
118 , PATCH
12− , Headers(..)
13− , Middleware
149 ) where
1510
16−data HttpMethod
11+data GET :: Type -> Type
12+data GET resp
1713
18−-- | The `req` can only ever be `Unit`
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
14+data POST :: Type -> Type -> Type
15+data POST req resp
2416
25−class MethodName :: HttpMethod -> Constraint
26−class MethodName method where
27− methodName :: String
17+data PUT :: Type -> Type -> Type
18+data PUT req resp
2819
29−instance MethodName (GET req resp) where
30− methodName = "GET"
20+data DELETE :: Type -> Type -> Type
21+data DELETE req resp
3122
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−
41−instance MethodName (PATCH req resp) where
42− methodName = "PATCH"
23+data PATCH :: Type -> Type -> Type
24+data PATCH req resp
4325
4426data Slash :: forall k1 k2. k1 -> k2 -> Type
4527data Slash x y
@@ -50,6 +32,4 @@ data Slash x y
5032-- | Other types are captured path pieces.
5133infixr 1 type Slash as /
5234
53−data Headers headers r = Headers headers r
54−
55−data Middleware tag
35+data Headers headers r = Headers (Record headers) r
src/PureStack/Server.purs+154−145
@@ -20,17 +20,12 @@ module PureStack.Server
2020 , serveQuery
2121 , class ParsePathPiece
2222 , parsePathPiece
23− , class FromHeaders
24− , fromHeaders
25− , class FromHeader
26− , fromHeader
2723 ) where
2824
2925import Prelude
3026import PureStack.Route
3127
3228import Bun.Request (Request)
33−import Bun.Request as Bun
3429import Bun.Request as Request
3530import Bun.Response as Bun.Response
3631import Control.Alternative (class Plus, empty)
@@ -54,19 +49,12 @@ import Foreign.Object as Object
5449import Prim.Row as Row
5550import Prim.RowList (class RowToList, RowList)
5651import Prim.RowList as RowList
57−import PureStack.Cookie (Cookie)
58−import PureStack.Cookie as Cookie
5952import Record as Record
6053import Record.Builder (Builder)
6154import Record.Builder as Builder
6255import Type.Proxy (Proxy(..))
6356
64−type Route =
65− { path :: Array String
66− , verb :: String
67− , query :: Map String (Array String)
68− , originalRequest :: Bun.Request
69− }
57+type Route = { path :: Array String, verb :: String, query :: Map String (Array String) }
7058
7159routeFromRequest :: Request -> Route
7260routeFromRequest req =
@@ -83,81 +71,180 @@ routeFromRequest req =
8371 , query: case url of
8472 Nothing -> Map.empty
8573 Just u -> URL.query u
86− , originalRequest: req
8774 }
8875
8976type Server a = ExceptT Response Aff a
9077
9178newtype Nt m = Nt (forall x. m x -> Server x)
9279
93−class ServeRoute :: forall k. k -> Type -> Row Type -> (Type -> Type) -> Constraint
94−class ServeRoute route handler middlewares m | route middlewares -> handler, handler -> m where
95− serveRoute :: Route -> Maybe (Nt m -> handler -> Record middlewares -> Request -> Server Response)
80+class ServeRoute :: forall k. k -> Type -> (Type -> Type) -> Constraint
81+class ServeRoute route handler m | route -> handler, handler -> m where
82+ serveRoute :: Route -> Maybe (Nt m -> handler -> Request -> Server Response)
9683
97−instance (ServeRoute rest handler middlewares m, IsSymbol path) => ServeRoute (path / rest) handler middlewares m where
84+instance (ServeRoute rest handler m, IsSymbol path) => ServeRoute (path / rest) handler m where
9885 serveRoute route@{ path } = do
9986 { head: h, tail } <- Array.uncons path
10087 assert $ h == (reflectSymbol @path Proxy)
10188 serveRoute @rest route { path = tail }
10289
10390else instance
104− ( ServeRoute rest handler middlewares m
91+ ( ServeRoute rest handler m
10592 , ServeQuery row list
10693 , RowToList row list
10794 ) =>
108− ServeRoute (Record row / rest) (Record row -> handler) middlewares m where
95+ ServeRoute (Record row / rest) (Record row -> handler) m where
10996 serveRoute route@{ query } = do
11097 builder <- serveQuery @row @list query
11198 serveRoute @rest route <#> (\f nt handler req -> f nt (handler $ Builder.buildFromScratch builder) req)
11299
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−
126−else instance (ServeRoute rest handler middlewares m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) middlewares m where
100+else instance (ServeRoute rest handler m, ParsePathPiece t) => ServeRoute (t / rest) (t -> handler) m where
127101 serveRoute route@{ path } = do
128102 { head: h, tail } <- Array.uncons path
129103 t <- parsePathPiece @t h
130− serveRoute @rest route { path = tail } <#> (\f nt handler mws req -> f nt (handler t) mws req)
104+ serveRoute @rest route { path = tail } <#> (\f nt handler req -> f nt (handler t) req)
105+
106+else instance ToResponse resp => ServeRoute (GET resp) (m resp) m where
107+ serveRoute { path, verb } = do
108+ assert $ verb == "GET"
109+ assert $ path == []
110+ pure $ \(Nt nt) handler _req -> do
111+ resp <- nt handler
112+ pure $ toResponse resp
113+
114+else instance ServeRoute (POST Unit Unit) (m Unit) m where
115+ serveRoute { path, verb } = do
116+ assert $ verb == "POST"
117+ assert $ path == []
118+ pure $ \(Nt nt) handler _req -> do
119+ nt handler
120+ pure $ ok
121+else instance (ToResponse resp) => ServeRoute (POST Unit resp) (m resp) m where
122+ serveRoute { path, verb } = do
123+ assert $ verb == "POST"
124+ assert $ path == []
125+ pure $ \(Nt nt) handler _req -> do
126+ resp <- nt handler
127+ pure $ toResponse resp
128+else instance (FromRequest req) => ServeRoute (POST resp Unit) (req -> m Unit) m where
129+ serveRoute { path, verb } = do
130+ assert $ verb == "POST"
131+ assert $ path == []
132+ pure $ \(Nt nt) handler req -> do
133+ liftAff (fromRequest req) >>= case _ of
134+ Nothing -> pure $ badRequest
135+ Just r -> do
136+ nt $ handler r
137+ pure $ ok
138+else instance (FromRequest req, ToResponse resp) => ServeRoute (POST req resp) (req -> m resp) m where
139+ serveRoute { path, verb } = do
140+ assert $ verb == "POST"
141+ assert $ path == []
142+ pure $ \(Nt nt) handler req -> do
143+ liftAff (fromRequest req) >>= case _ of
144+ Nothing -> pure $ badRequest
145+ Just r -> do
146+ resp <- nt $ handler r
147+ pure $ toResponse resp
131148
132−else instance MethodName (meth Unit Unit) => ServeRoute (meth Unit Unit) (m Unit) middlewares m where
149+else instance ServeRoute (DELETE Unit Unit) (m Unit) m where
133150 serveRoute { path, verb } = do
134− assert $ verb == methodName @(meth Unit Unit)
151+ assert $ verb == "DELETE"
135152 assert $ path == []
136− pure $ \(Nt nt) handler _middlewares _req -> do
153+ pure $ \(Nt nt) handler _req -> do
137154 nt handler
138155 pure $ ok
139−else instance (ToResponse resp, MethodName (meth Unit resp)) => ServeRoute (meth Unit resp) (m resp) middlewares m where
156+else instance (ToResponse resp) => ServeRoute (DELETE Unit resp) (m resp) m where
140157 serveRoute { path, verb } = do
141− assert $ verb == methodName @(meth Unit resp)
158+ assert $ verb == "DELETE"
142159 assert $ path == []
143− pure $ \(Nt nt) handler _middlewares _req -> do
160+ pure $ \(Nt nt) handler _req -> do
144161 resp <- nt handler
145162 pure $ toResponse resp
146−else instance (FromRequest req, MethodName (meth resp Unit)) => ServeRoute (meth resp Unit) (req -> m Unit) middlewares m where
163+else instance (FromRequest req) => ServeRoute (DELETE resp Unit) (req -> m Unit) m where
147164 serveRoute { path, verb } = do
148− assert $ verb == methodName @(meth resp Unit)
165+ assert $ verb == "DELETE"
149166 assert $ path == []
150− pure $ \(Nt nt) handler _middlewares req -> do
167+ pure $ \(Nt nt) handler req -> do
151168 liftAff (fromRequest req) >>= case _ of
152169 Nothing -> pure $ badRequest
153170 Just r -> do
154171 nt $ handler r
155172 pure $ ok
156−else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) => ServeRoute (meth req resp) (req -> m resp) middlewares m where
173+else instance (FromRequest req, ToResponse resp) => ServeRoute (DELETE req resp) (req -> m resp) m where
157174 serveRoute { path, verb } = do
158− assert $ verb == methodName @(meth req resp)
175+ assert $ verb == "DELETE"
159176 assert $ path == []
160− pure $ \(Nt nt) handler _middlewares req -> do
177+ pure $ \(Nt nt) handler req -> do
178+ liftAff (fromRequest req) >>= case _ of
179+ Nothing -> pure $ badRequest
180+ Just r -> do
181+ resp <- nt $ handler r
182+ pure $ toResponse resp
183+
184+else instance ServeRoute (PUT Unit Unit) (m Unit) m where
185+ serveRoute { path, verb } = do
186+ assert $ verb == "PUT"
187+ assert $ path == []
188+ pure $ \(Nt nt) handler _req -> do
189+ nt handler
190+ pure $ ok
191+else instance (ToResponse resp) => ServeRoute (PUT Unit resp) (m resp) m where
192+ serveRoute { path, verb } = do
193+ assert $ verb == "PUT"
194+ assert $ path == []
195+ pure $ \(Nt nt) handler _req -> do
196+ resp <- nt handler
197+ pure $ toResponse resp
198+else instance (FromRequest req) => ServeRoute (PUT resp Unit) (req -> m Unit) m where
199+ serveRoute { path, verb } = do
200+ assert $ verb == "PUT"
201+ assert $ path == []
202+ pure $ \(Nt nt) handler req -> do
203+ liftAff (fromRequest req) >>= case _ of
204+ Nothing -> pure $ badRequest
205+ Just r -> do
206+ nt $ handler r
207+ pure $ ok
208+else instance (FromRequest req, ToResponse resp) => ServeRoute (PUT req resp) (req -> m resp) m where
209+ serveRoute { path, verb } = do
210+ assert $ verb == "PUT"
211+ assert $ path == []
212+ pure $ \(Nt nt) handler req -> do
213+ liftAff (fromRequest req) >>= case _ of
214+ Nothing -> pure $ badRequest
215+ Just r -> do
216+ resp <- nt $ handler r
217+ pure $ toResponse resp
218+
219+else instance ServeRoute (PATCH Unit Unit) (m Unit) m where
220+ serveRoute { path, verb } = do
221+ assert $ verb == "PATCH"
222+ assert $ path == []
223+ pure $ \(Nt nt) handler _req -> do
224+ nt handler
225+ pure $ ok
226+else instance (ToResponse resp) => ServeRoute (PATCH Unit resp) (m resp) m where
227+ serveRoute { path, verb } = do
228+ assert $ verb == "PATCH"
229+ assert $ path == []
230+ pure $ \(Nt nt) handler _req -> do
231+ resp <- nt handler
232+ pure $ toResponse resp
233+else instance (FromRequest req) => ServeRoute (PATCH resp Unit) (req -> m Unit) m where
234+ serveRoute { path, verb } = do
235+ assert $ verb == "PATCH"
236+ assert $ path == []
237+ pure $ \(Nt nt) handler req -> do
238+ liftAff (fromRequest req) >>= case _ of
239+ Nothing -> pure $ badRequest
240+ Just r -> do
241+ nt $ handler r
242+ pure $ ok
243+else instance (FromRequest req, ToResponse resp) => ServeRoute (PATCH req resp) (req -> m resp) m where
244+ serveRoute { path, verb } = do
245+ assert $ verb == "PATCH"
246+ assert $ path == []
247+ pure $ \(Nt nt) handler req -> do
161248 liftAff (fromRequest req) >>= case _ of
162249 Nothing -> pure $ badRequest
163250 Just r -> do
@@ -165,12 +252,12 @@ else instance (FromRequest req, ToResponse resp, MethodName (meth req resp)) =>
165252 pure $ toResponse resp
166253
167254else instance
168− ( ServeAPI routes list handlers middlewares m
255+ ( ServeAPI routes list handlers m
169256 , RowToList routes list
170257 ) =>
171− ServeRoute routes (Record handlers) middlewares m where
172− serveRoute route = pure $ \nt handlers middlewares req ->
173− serveAPI @routes @list nt handlers middlewares route req
258+ ServeRoute routes (Record handlers) m where
259+ serveRoute route = pure $ \nt handlers req ->
260+ serveAPI @routes @list nt handlers route req
174261
175262class ServeQuery :: Row Type -> RowList Type -> Constraint
176263class ServeQuery row list | list -> row where
@@ -255,84 +342,6 @@ instance DecodeJson (Record row) => FromRequest (Record row) where
255342instance FromRequest Request where
256343 fromRequest req = pure $ Just req
257344
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−
336345class ParsePathPiece t where
337346 parsePathPiece :: String -> Maybe t
338347
@@ -357,26 +366,26 @@ assert :: forall m. Applicative m => Plus m => Boolean -> m Unit
357366assert true = pure unit
358367assert false = empty
359368
360−class ServeAPI :: Row Type -> RowList Type -> Row Type -> Row Type -> (Type -> Type) -> Constraint
361−class ServeAPI row list handlers middlewares m | row -> handlers, handlers -> m where
362− serveAPI :: Nt m -> Record handlers -> Record middlewares -> Route -> Request -> Server Response
369+class ServeAPI :: Row Type -> RowList Type -> Row Type -> (Type -> Type) -> Constraint
370+class ServeAPI row list handlers m | row -> handlers, handlers -> m where
371+ serveAPI :: Nt m -> Record handlers -> Route -> Request -> Server Response
363372
364−instance ServeAPI row RowList.Nil () middlewares m where
365− serveAPI _ _ _ _ _ = pure notFound
373+instance ServeAPI row RowList.Nil () m where
374+ serveAPI _ _ _ _ = pure notFound
366375
367376instance
368− ( ServeRoute t handler middlewares m
377+ ( ServeRoute t handler m
369378 , Row.Cons field t tail row
370− , ServeAPI row rest restHandlers middlewares m
379+ , ServeAPI row rest restHandlers m
371380 , IsSymbol field
372381 , Row.Cons field handler restHandlers handlers
373382 , Row.Lacks field restHandlers
374383 ) =>
375− ServeAPI row (RowList.Cons field t rest) handlers middlewares m where
376− serveAPI nt handlers middlewares route req =
384+ ServeAPI row (RowList.Cons field t rest) handlers m where
385+ serveAPI nt handlers route req =
377386 case serveRoute @t route of
378− Nothing -> serveAPI @row @rest @restHandlers @middlewares nt (Record.delete (Proxy @field) handlers) middlewares route req
379− Just f -> f nt (Record.get (Proxy @field) handlers) middlewares req
387+ Nothing -> serveAPI @row @rest @restHandlers nt (Record.delete (Proxy @field) handlers) route req
388+ Just f -> f nt (Record.get (Proxy @field) handlers) req
380389
381390notFound :: Response
382391notFound = Response { body: EmptyResponseBody, status: 404, statusText: "Not Found", headers: Object.empty }
@@ -393,16 +402,16 @@ ok = Response { body: EmptyResponseBody, status: 200, statusText: "OK", headers:
393402-- | The first argument is used to run an arbitrary monad in handlers. To use the 'Server' monad
394403-- | instead you can just pass `identity` as the first argument.
395404run
396− :: forall @row list handlers m middlewares
405+ :: forall @row list handlers m
397406 . RowToList row list
398− => ServeAPI row list handlers middlewares m
407+ => ServeAPI row list handlers m
399408 => (forall x. m x -> Server x)
400− -> { handlers :: Record handlers, middlewares :: Record middlewares }
409+ -> Record handlers
401410 -> Request
402411 -> Aff Bun.Response.Response
403−run nt { handlers, middlewares } req = do
412+run nt handlers req = do
404413 Response { body, headers, status, statusText } <-
405− map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers middlewares (routeFromRequest req) req
414+ map (either identity identity) $ runExceptT $ serveAPI @row @list @handlers (Nt nt) handlers (routeFromRequest req) req
406415 let opts = { headers, status, statusText }
407416 pure $ case body of
408417 EmptyResponseBody -> Bun.Response.string "" opts