orion/purescript-axon
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

wip2 typed headers

Browse Source
This commit is contained in:
Orion Kindel
2024-12-02 15:54:35 -06:00
parent 96eacc3ba0
commit 7f5c022356
5 changed files with 325 additions and 276 deletions
Download Patch File Download Diff File Expand all files Collapse all files

29
.spec-results
View File

@@ -2,70 +2,70 @@
[ [
"Axon Request Parts Body extracts a JSON body", "Axon Request Parts Body extracts a JSON body",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Body extracts a string body from a buffer", "Axon Request Parts Body extracts a string body from a buffer",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Body extracts a string body from a cached string", "Axon Request Parts Body extracts a string body from a cached string",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Body extracts a string body from a readable stream", "Axon Request Parts Body extracts a string body from a readable stream",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Path ... but does if ends in IgnoreRest", "Axon Request Parts Path ... but does if ends in IgnoreRest",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Path does not partially match a route ...", "Axon Request Parts Path does not partially match a route ...",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Path extracts an int", "Axon Request Parts Path extracts an int",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Path extracts an int and a string", "Axon Request Parts Path extracts an int and a string",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Path matches a route matching literal", "Axon Request Parts Path matches a route matching literal",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
[ [
"Axon Request Parts Path matches a route matching multiple literals", "Axon Request Parts Path matches a route matching multiple literals",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],
@@ -97,6 +97,13 @@
"success": true "success": true
} }
], ],
[
"Axon Request Parts extracts header, method, path, JSON body",
{
"timestamp": "1733176427760.0",
"success": true
}
],
[ [
"Axon Request Parts extracts method, path, JSON body", "Axon Request Parts extracts method, path, JSON body",
{ {
@@ -107,7 +114,7 @@
[ [
"Axon Request Parts extracts the whole request", "Axon Request Parts extracts the whole request",
{ {
"timestamp": "1733095274452.0", "timestamp": "1733176427760.0",
"success": true "success": true
} }
], ],

211
src/.Axon.Request.purs.kak.E6dWQg
View File

@@ -1,211 +0,0 @@
module Axon.Request (Request, Body(..), BodyReadableError(..), BodyStringError(..), BodyJSONError(..), BodyBufferError(..), bodyReadable, bodyString, bodyJSON, bodyBuffer, headers, method, address, url, contentType, accept, contentLength, lookupHeader, make) where
import Prelude
import Axon.Request.Method (Method)
import Control.Monad.Error.Class (throwError, try)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Control.Monad.Trans.Class (lift)
import Data.Argonaut.Core (Json)
import Data.Argonaut.Core (stringify) as JSON
import Data.Argonaut.Parser (jsonParser) as JSON
import Data.Bifunctor (lmap)
import Data.Either (Either)
import Data.FoldableWithIndex (foldlWithIndex)
import Data.Generic.Rep (class Generic)
import Data.Int as Int
import Data.MIME (MIME)
import Data.MIME as MIME
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (Maybe)
import Data.Show.Generic (genericShow)
import Data.String.Lower (StringLower)
import Data.String.Lower as String.Lower
import Data.URL (URL)
import Effect (Effect)
import Effect.Aff (Aff)
import Effect.Aff.Class (liftAff)
import Effect.Class (liftEffect)
import Effect.Exception (Error)
import Effect.Exception as Error
import Effect.Ref (Ref) as Effect
import Effect.Ref as Ref
import Node.Buffer (Buffer)
import Node.Buffer as Buffer
import Node.Encoding (Encoding(..))
import Node.Net.Types (IPv4, IPv6, SocketAddress)
import Node.Stream as Stream
import Node.Stream.Aff as Stream.Aff
data BodyReadableError
= BodyReadableErrorHasBeenConsumed
| BodyReadableErrorEmpty
derive instance Generic BodyReadableError _
derive instance Eq BodyReadableError
instance Show BodyReadableError where
show = genericShow
data BodyBufferError
= BodyBufferErrorReadable BodyReadableError
| BodyBufferErrorReading Error
derive instance Generic BodyBufferError _
instance Eq BodyBufferError where
eq (BodyBufferErrorReadable a) (BodyBufferErrorReadable b) = a == b
eq (BodyBufferErrorReading a) (BodyBufferErrorReading b) = Error.message a == Error.message b
eq _ _ = false
instance Show BodyBufferError where
show = genericShow
data BodyStringError
= BodyStringErrorBuffer BodyBufferError
| BodyStringErrorNotUTF8
derive instance Generic BodyStringError _
derive instance Eq BodyStringError
instance Show BodyStringError where
show = genericShow
data BodyJSONError
= BodyJSONErrorString BodyStringError
| BodyJSONErrorParsing String
derive instance Generic BodyJSONError _
derive instance Eq BodyJSONError
instance Show BodyJSONError where
show = genericShow
data Body
= BodyEmpty
| BodyReadable (Stream.Readable ())
| BodyReadableConsumed
| BodyCached Buffer
| BodyCachedString String
| BodyCachedJSON Json
data Request =
Request
{ headers :: Map StringLower String
, address :: Either (SocketAddress IPv4) (SocketAddress IPv6)
, url :: URL
, method :: Method
, bodyRef :: Effect.Ref Body
}
make :: { headers :: Map String String
, address :: Either (SocketAddress IPv4) (SocketAddress IPv6)
, url :: URL
, method :: Method
, body :: Body
} -> Effect Request
make a = do
bodyRef <- Ref.new a.body
pure $ Request {bodyRef: bodyRef, headers: foldlWithIndex (\k m v -> Map.insert (String.Lower.fromString k) v m) Map.empty a.headers, address: a.address, url: a.url, method: a.method}
headers :: Request -> Map StringLower String
headers (Request a) = a.headers
lookupHeader :: String -> Request -> Maybe String
lookupHeader k (Request a) = Map.lookup (String.Lower.fromString k) a.headers
contentType :: Request -> Maybe MIME
contentType = lookupHeader "content-type" >>> map MIME.fromString
accept :: Request -> Maybe MIME
accept = lookupHeader "accept" >>> map MIME.fromString
contentLength :: Request -> Maybe Int
contentLength = lookupHeader "content-length" >=> Int.fromString
method :: Request -> Method
method (Request a) = a.method
address :: Request -> Either (SocketAddress IPv4) (SocketAddress IPv6)
address (Request a) = a.address
url :: Request -> URL
url (Request a) = a.url
bodyReadable :: Request -> Effect (Either BodyReadableError (Stream.Readable ()))
bodyReadable (Request {bodyRef}) = runExceptT do
body <- liftEffect $ Ref.read bodyRef
case body of
BodyEmpty -> throwError BodyReadableErrorEmpty
BodyReadableConsumed -> throwError BodyReadableErrorHasBeenConsumed
BodyReadable r ->
Ref.write BodyReadableConsumed bodyRef $> r # lift
BodyCached buf -> Stream.readableFromBuffer buf # lift
BodyCachedString str -> Stream.readableFromString str UTF8 # lift
BodyCachedJSON json -> json # JSON.stringify # flip Buffer.fromString UTF8 >>= Stream.readableFromBuffer # lift
bodyBuffer :: Request -> Aff (Either BodyBufferError Buffer)
bodyBuffer r@(Request {bodyRef}) =
let
stream =
bodyReadable r
# liftEffect
<#> lmap BodyBufferErrorReadable
# ExceptT
readAll s =
Stream.Aff.readAll s
# liftAff
# try
<#> lmap BodyBufferErrorReading
# ExceptT
>>= (liftEffect <<< Buffer.concat)
in
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCached buf -> pure buf
BodyCachedString str -> Buffer.fromString str UTF8 # liftEffect
BodyCachedJSON json -> Buffer.fromString (JSON.stringify json) UTF8 # liftEffect
_ -> do
buf <- stream >>= readAll
Ref.write (BodyCached buf) bodyRef $> buf # liftEffect
bodyString :: Request -> Aff (Either BodyStringError String)
bodyString r@(Request {bodyRef}) =
let
buf =
bodyBuffer r
<#> lmap BodyStringErrorBuffer
# ExceptT
bufString b =
Buffer.toString UTF8 b
# liftEffect
# try
<#> lmap (const BodyStringErrorNotUTF8)
# ExceptT
in
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCachedString str -> pure str
BodyCachedJSON json -> JSON.stringify json # pure
_ -> do
str <- buf >>= bufString
Ref.write (BodyCachedString str) bodyRef $> str # liftEffect
bodyJSON :: Request -> Aff (Either BodyJSONError Json)
bodyJSON r@(Request {bodyRef}) =
let
str =
bodyString r
<#> lmap BodyJSONErrorString
# ExceptT
parse s =
JSON.jsonParser s
# lmap BodyJSONErrorParsing
# pure
# ExceptT
in
runExceptT do
body <- Ref.read bodyRef # liftEffect
case body of
BodyCachedJSON j -> pure j
_ -> do
j <- str >>= parse
Ref.write (BodyCachedJSON j) bodyRef $> j # liftEffect

291
src/Axon.Header.Typed.purs
View File

@@ -9,21 +9,28 @@ import Data.Array as Array
import Data.Array.NonEmpty (NonEmptyArray) import Data.Array.NonEmpty (NonEmptyArray)
import Data.Array.NonEmpty as Array.NonEmpty import Data.Array.NonEmpty as Array.NonEmpty
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
import Data.DateTime (DateTime) import Data.Date as Date
import Data.Date.Component (Month(..), Weekday(..))
import Data.DateTime (DateTime(..))
import Data.DateTime as DateTime
import Data.Either (Either(..)) import Data.Either (Either(..))
import Data.Either.Nested (type (\/)) import Data.Either.Nested (type (\/))
import Data.Either.Nested as Either.Nested import Data.Either.Nested as Either.Nested
import Data.Enum (fromEnum, toEnum)
import Data.Generic.Rep (class Generic)
import Data.Int as Int import Data.Int as Int
import Data.MIME as MIME import Data.MIME as MIME
import Data.Map as Map import Data.Map as Map
import Data.Maybe (Maybe(..), fromMaybe, isJust) import Data.Maybe (Maybe(..), isJust)
import Data.Newtype (class Newtype, unwrap, wrap) import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Show.Generic (genericShow)
import Data.String as String import Data.String as String
import Data.String.Base64 as String.Base64 import Data.String.Base64 as String.Base64
import Data.String.CodeUnits as String.CodeUnit import Data.String.CodeUnits as String.CodeUnit
import Data.String.Lower (StringLower) import Data.String.Lower (StringLower)
import Data.String.Lower as String.Lower import Data.String.Lower as String.Lower
import Data.String.Regex.Flags as Regex.Flags import Data.String.Regex.Flags as Regex.Flags
import Data.Time as Time
import Data.Tuple (fst) import Data.Tuple (fst)
import Data.Tuple.Nested (type (/\), (/\)) import Data.Tuple.Nested (type (/\), (/\))
import Effect.Exception as Error import Effect.Exception as Error
@@ -38,6 +45,76 @@ import Record as Record
import Type.MIME as Type.MIME import Type.MIME as Type.MIME
data Wildcard = Wildcard data Wildcard = Wildcard
derive instance Eq Wildcard
datetimeParser :: Parser String DateTime
datetimeParser =
let
as :: forall a. String -> a -> Parser String a
as s a = Parse.String.string s $> a
weekday = Parse.Combine.choice [as "Mon" Monday, as "Tue" Tuesday, as "Wed" Wednesday, as "Thu" Thursday, as "Fri" Friday, as "Sat" Saturday, as "Sun" Sunday]
month = Parse.Combine.choice [as "Jan" January, as "Feb" February, as "Mar" March, as "Apr" April, as "May" May, as "Jun" June, as "Jul" July, as "Aug" August, as "Sep" September, as "Oct" October, as "Nov" November, as "Dec" December]
day = Parse.String.Basic.intDecimal <#> toEnum >>= Parse.liftMaybe (const "invalid day")
year = Parse.String.Basic.intDecimal <#> toEnum >>= Parse.liftMaybe (const "invalid year")
date =
( pure (\d m y -> Date.exactDate y m d)
<*> (weekday *> Parse.String.Basic.whiteSpace *> day)
<*> (Parse.String.Basic.whiteSpace *> month) <*> (Parse.String.Basic.whiteSpace *> year)
)
>>= Parse.liftMaybe (const "invalid date")
time =
( pure (\h m s ms -> Time.Time h m s ms)
<*> ((Parse.String.Basic.intDecimal <#> toEnum >>= Parse.liftMaybe (const "invalid hour")))
<*> (Parse.String.string ":" *> (Parse.String.Basic.intDecimal <#> toEnum >>= Parse.liftMaybe (const "invalid minutes")))
<*> (Parse.String.string ":" *> (Parse.String.Basic.intDecimal <#> toEnum >>= Parse.liftMaybe (const "invalid seconds")))
<*> (toEnum 0 # Parse.liftMaybe (const "invalid milliseconds"))
)
in
pure DateTime <*> (date <* Parse.String.Basic.whiteSpace) <*> time
printDateTime :: DateTime -> String
printDateTime dt =
let
weekday = case _ of
Monday -> "Mon"
Tuesday -> "Tue"
Wednesday -> "Wed"
Thursday -> "Thu"
Friday -> "Fri"
Saturday -> "Sat"
Sunday -> "Sun"
month =
case _ of
January -> "Jan"
February -> "Feb"
March -> "Mar"
April -> "Apr"
May -> "May"
June -> "Jun"
July -> "Jul"
August -> "Aug"
September -> "Sep"
October -> "Oct"
November -> "Nov"
December -> "Dec"
time =
[ dt # DateTime.time # DateTime.hour # fromEnum # Int.toStringAs Int.decimal
, dt # DateTime.time # DateTime.minute # fromEnum # Int.toStringAs Int.decimal
, dt # DateTime.time # DateTime.second # fromEnum # Int.toStringAs Int.decimal
]
# Array.intercalate ":"
in
[ weekday (DateTime.weekday $ DateTime.date dt) <> ","
, dt # DateTime.date # DateTime.day # fromEnum # Int.toStringAs Int.decimal
, dt # DateTime.date # DateTime.month # month
, dt # DateTime.date # DateTime.year # fromEnum # Int.toStringAs Int.decimal
, time
]
# Array.intercalate " "
commas :: forall a. Parser String a -> Parser String (Array a) commas :: forall a. Parser String a -> Parser String (Array a)
commas p = Parse.Combine.sepBy p (Parse.String.Basic.whiteSpace <* Parse.String.string "," <* Parse.String.Basic.whiteSpace) <#> Array.fromFoldable commas p = Parse.Combine.sepBy p (Parse.String.Basic.whiteSpace <* Parse.String.string "," <* Parse.String.Basic.whiteSpace) <#> Array.fromFoldable
@@ -49,18 +126,21 @@ wildcardParser :: Parser String Wildcard
wildcardParser = Parse.String.string "*" $> Wildcard wildcardParser = Parse.String.string "*" $> Wildcard
mimeParser :: Parser String MIME.MIME mimeParser :: Parser String MIME.MIME
mimeParser = Parse.String.anyTill Parse.String.Basic.space <#> fst <#> MIME.fromString mimeParser = Parse.String.anyTill (void Parse.String.Basic.space <|> Parse.String.eof) <#> fst <#> MIME.fromString
headerNameRegexParser :: Parser String String headerNameRegexParser :: Parser String String
headerNameRegexParser = unsafePartial $ (\(Right a) -> a) $ Parse.String.regex "[\\w-]+" Regex.Flags.noFlags headerNameRegexParser = unsafePartial $ (\(Right a) -> a) $ Parse.String.regex "[\\w-]+" Regex.Flags.noFlags
closeRegexParser :: Parser String String
closeRegexParser = unsafePartial $ (\(Right a) -> a) $ Parse.String.regex "close" Regex.Flags.ignoreCase
headerNameParser :: Parser String StringLower headerNameParser :: Parser String StringLower
headerNameParser = headerNameRegexParser <#> String.Lower.fromString headerNameParser = headerNameRegexParser <#> String.Lower.fromString
methodParser :: Parser String Method methodParser :: Parser String Method
methodParser = Parse.Combine.many Parse.String.Basic.alphaNum <#> Array.fromFoldable <#> String.CodeUnit.fromCharArray >>= (\a -> Parse.liftMaybe (const $ "invalid method " <> a) $ Method.fromString a) methodParser = Parse.Combine.many Parse.String.Basic.alphaNum <#> Array.fromFoldable <#> String.CodeUnit.fromCharArray >>= (\a -> Parse.liftMaybe (const $ "invalid method " <> a) $ Method.fromString a)
directiveParser :: Parser String (String /\ Maybe String) directiveParser :: Parser String (StringLower /\ Maybe String)
directiveParser = directiveParser =
let let
boundary = Parse.String.string ";" <|> Parse.String.string "," <|> (Parse.String.eof *> pure "") boundary = Parse.String.string ";" <|> Parse.String.string "," <|> (Parse.String.eof *> pure "")
@@ -68,8 +148,8 @@ directiveParser =
k /\ stop <- Parse.String.anyTill (Parse.String.string "=" <|> boundary) k /\ stop <- Parse.String.anyTill (Parse.String.string "=" <|> boundary)
when (stop /= "=") $ Parse.fail "" when (stop /= "=") $ Parse.fail ""
v <- Parse.String.anyTill boundary <#> fst v <- Parse.String.anyTill boundary <#> fst
pure $ String.trim k /\ Just (String.trim v) pure $ String.Lower.fromString (String.trim k) /\ Just (String.trim v)
kParser = Parse.String.anyTill boundary <#> fst <#> String.trim <#> (\k -> k /\ Nothing) kParser = Parse.String.anyTill boundary <#> fst <#> String.trim <#> String.Lower.fromString <#> (\k -> k /\ Nothing)
in in
kvParser <|> kParser kvParser <|> kParser
@@ -79,56 +159,74 @@ class TypedHeader a where
headerValueEncode :: a -> String headerValueEncode :: a -> String
newtype Accept a = Accept a newtype Accept a = Accept a
derive instance Generic (Accept a) _
derive instance Newtype (Accept a) _ derive instance Newtype (Accept a) _
derive instance Eq a => Eq (Accept a)
instance Show a => Show (Accept a) where show = genericShow
data AccessControlAllowCredentials = AccessControlAllowCredentials data AccessControlAllowCredentials = AccessControlAllowCredentials
newtype AccessControlAllowHeaders = AccessControlAllowHeaders (Wildcard \/ NonEmptyArray StringLower) newtype AccessControlAllowHeaders = AccessControlAllowHeaders (Wildcard \/ NonEmptyArray StringLower)
derive instance Newtype (AccessControlAllowHeaders) _ derive instance Newtype (AccessControlAllowHeaders) _
derive instance Eq (AccessControlAllowHeaders)
newtype AccessControlAllowMethods = AccessControlAllowMethods (Wildcard \/ NonEmptyArray Method) newtype AccessControlAllowMethods = AccessControlAllowMethods (Wildcard \/ NonEmptyArray Method)
derive instance Newtype (AccessControlAllowMethods) _ derive instance Newtype (AccessControlAllowMethods) _
derive instance Eq (AccessControlAllowMethods)
newtype AccessControlAllowOrigin = AccessControlAllowOrigin (Wildcard \/ String) newtype AccessControlAllowOrigin = AccessControlAllowOrigin (Wildcard \/ String)
derive instance Newtype (AccessControlAllowOrigin) _ derive instance Newtype (AccessControlAllowOrigin) _
derive instance Eq (AccessControlAllowOrigin)
newtype AccessControlExposeHeaders = AccessControlExposeHeaders (Wildcard \/ Array StringLower) newtype AccessControlExposeHeaders = AccessControlExposeHeaders (Wildcard \/ Array StringLower)
derive instance Newtype (AccessControlExposeHeaders) _ derive instance Newtype (AccessControlExposeHeaders) _
derive instance Eq (AccessControlExposeHeaders)
newtype AccessControlMaxAge = AccessControlMaxAge Int newtype AccessControlMaxAge = AccessControlMaxAge Int
derive instance Newtype (AccessControlMaxAge) _ derive instance Newtype (AccessControlMaxAge) _
derive instance Eq (AccessControlMaxAge)
newtype AccessControlRequestHeaders = AccessControlRequestHeaders (NonEmptyArray StringLower) newtype AccessControlRequestHeaders = AccessControlRequestHeaders (NonEmptyArray StringLower)
derive instance Newtype (AccessControlRequestHeaders) _ derive instance Newtype (AccessControlRequestHeaders) _
derive instance Eq (AccessControlRequestHeaders)
newtype AccessControlRequestMethod = AccessControlRequestMethod Method newtype AccessControlRequestMethod = AccessControlRequestMethod Method
derive instance Newtype (AccessControlRequestMethod) _ derive instance Newtype (AccessControlRequestMethod) _
derive instance Eq (AccessControlRequestMethod)
newtype Age = Age Int newtype Age = Age Int
derive instance Newtype (Age) _ derive instance Newtype (Age) _
derive instance Eq (Age)
newtype Allow = Allow (NonEmptyArray Method) newtype Allow = Allow (NonEmptyArray Method)
derive instance Newtype (Allow) _ derive instance Newtype (Allow) _
derive instance Eq (Allow)
newtype AuthScheme = AuthScheme String newtype AuthScheme = AuthScheme String
derive instance Newtype (AuthScheme) _ derive instance Newtype (AuthScheme) _
derive instance Eq (AuthScheme)
data Authorization = Authorization AuthScheme String data Authorization = Authorization AuthScheme String
newtype BearerAuth = BearerAuth String newtype BearerAuth = BearerAuth String
derive instance Newtype (BearerAuth) _ derive instance Newtype (BearerAuth) _
derive instance Eq (BearerAuth)
newtype BasicAuth = BasicAuth {username :: String, password :: String} newtype BasicAuth = BasicAuth {username :: String, password :: String}
derive instance Newtype (BasicAuth) _ derive instance Newtype (BasicAuth) _
derive instance Eq (BasicAuth)
newtype ByteRangeStart = ByteRangeStart Int newtype ByteRangeStart = ByteRangeStart Int
derive instance Newtype (ByteRangeStart) _ derive instance Newtype (ByteRangeStart) _
derive instance Eq (ByteRangeStart)
newtype ByteRangeEnd = ByteRangeEnd Int newtype ByteRangeEnd = ByteRangeEnd Int
derive instance Newtype (ByteRangeEnd) _ derive instance Newtype (ByteRangeEnd) _
derive instance Eq (ByteRangeEnd)
newtype ByteRangeLength = ByteRangeLength Int newtype ByteRangeLength = ByteRangeLength Int
derive instance Newtype (ByteRangeLength) _ derive instance Newtype (ByteRangeLength) _
derive instance Eq (ByteRangeLength)
type CacheControl' = type CacheControl' =
( maxAge :: Maybe Int ( maxAge :: Maybe Int
@@ -151,76 +249,104 @@ type CacheControl' =
newtype CacheControl = CacheControl (Record CacheControl') newtype CacheControl = CacheControl (Record CacheControl')
derive instance Newtype (CacheControl) _ derive instance Newtype (CacheControl) _
derive instance Eq (CacheControl)
data CloseConnection = CloseConnection data ConnectionClose = ConnectionClose
derive instance Eq (ConnectionClose)
newtype Connection = Connection (CloseConnection \/ NonEmptyArray StringLower) newtype Connection = Connection (ConnectionClose \/ NonEmptyArray StringLower)
derive instance Newtype (Connection) _ derive instance Newtype (Connection) _
derive instance Eq (Connection)
newtype ContentDisposition = ContentDisposition (ContentDispositionInline \/ ContentDispositionAttachment \/ ContentDispositionFormData) newtype ContentDisposition = ContentDisposition (ContentDispositionInline \/ ContentDispositionAttachment \/ ContentDispositionFormData \/ Void)
derive instance Newtype (ContentDisposition) _ derive instance Newtype (ContentDisposition) _
derive instance Eq (ContentDisposition)
data ContentDispositionInline = ContentDispositionInline data ContentDispositionInline = ContentDispositionInline
derive instance Eq (ContentDispositionInline)
newtype ContentDispositionAttachment = ContentDispositionAttachment {filename :: Maybe {language :: Maybe String, encoding :: Maybe String, value :: String}} newtype ContentDispositionAttachment = ContentDispositionAttachment {filename :: Maybe String}
derive instance Newtype (ContentDispositionAttachment) _ derive instance Newtype (ContentDispositionAttachment) _
derive instance Eq (ContentDispositionAttachment)
newtype ContentDispositionFormData = ContentDispositionFormData {filename :: Maybe String, name :: Maybe String} newtype ContentDispositionFormData = ContentDispositionFormData {filename :: Maybe String, name :: Maybe String}
derive instance Newtype (ContentDispositionFormData) _ derive instance Newtype (ContentDispositionFormData) _
derive instance Eq (ContentDispositionFormData)
newtype ContentEncoding = ContentEncoding (NonEmptyArray String) newtype ContentEncoding = ContentEncoding (NonEmptyArray String)
derive instance Newtype (ContentEncoding) _ derive instance Newtype (ContentEncoding) _
derive instance Eq (ContentEncoding)
newtype ContentLength = ContentLength Int newtype ContentLength = ContentLength Int
derive instance Newtype (ContentLength) _ derive instance Newtype (ContentLength) _
derive instance Eq (ContentLength)
newtype ContentLocation = ContentLocation String newtype ContentLocation = ContentLocation String
derive instance Newtype (ContentLocation) _ derive instance Newtype (ContentLocation) _
derive instance Eq (ContentLocation)
newtype ContentRange = ContentRange ((ByteRangeStart /\ ByteRangeEnd /\ ByteRangeLength) \/ (ByteRangeStart /\ ByteRangeEnd) \/ ByteRangeLength) newtype ContentRange = ContentRange ((ByteRangeStart /\ ByteRangeEnd /\ ByteRangeLength) \/ (ByteRangeStart /\ ByteRangeEnd) \/ ByteRangeLength \/ Void)
derive instance Newtype (ContentRange) _ derive instance Newtype (ContentRange) _
derive instance Eq (ContentRange)
newtype ContentType a = ContentType a newtype ContentType a = ContentType a
derive instance Generic (ContentType a) _
derive instance Newtype (ContentType a) _ derive instance Newtype (ContentType a) _
derive instance Eq a => Eq (ContentType a)
instance Show a => Show (ContentType a) where show = genericShow
newtype Cookie = Cookie String newtype Cookie = Cookie String
derive instance Newtype (Cookie) _ derive instance Newtype (Cookie) _
derive instance Eq (Cookie)
newtype Date = Date DateTime newtype Date = Date DateTime
derive instance Newtype (Date) _ derive instance Newtype (Date) _
derive instance Eq (Date)
newtype ETag = ETag String newtype ETag = ETag String
derive instance Newtype (ETag) _ derive instance Newtype (ETag) _
derive instance Eq (ETag)
data ExpectContinue = ExpectContinue data ExpectContinue = ExpectContinue
newtype Expires = Expires DateTime newtype Expires = Expires DateTime
derive instance Newtype (Expires) _ derive instance Newtype (Expires) _
derive instance Eq (Expires)
newtype Host = Host String newtype Host = Host String
derive instance Newtype (Host) _ derive instance Newtype (Host) _
derive instance Eq (Host)
newtype IfMatch = IfMatch (Wildcard \/ NonEmptyArray MatchETag) newtype IfMatch = IfMatch (Wildcard \/ NonEmptyArray String)
derive instance Newtype (IfMatch) _ derive instance Newtype (IfMatch) _
derive instance Eq (IfMatch)
newtype IfNoneMatch = IfNoneMatch (Wildcard \/ NonEmptyArray MatchETag) newtype IfNoneMatch = IfNoneMatch (Wildcard \/ NonEmptyArray MatchETag)
derive instance Newtype (IfNoneMatch) _ derive instance Newtype (IfNoneMatch) _
derive instance Eq (IfNoneMatch)
newtype IfModifiedSince = IfModifiedSince DateTime newtype IfModifiedSince = IfModifiedSince DateTime
derive instance Newtype (IfModifiedSince) _ derive instance Newtype (IfModifiedSince) _
derive instance Eq (IfModifiedSince)
newtype IfRange = IfRange (DateTime \/ String) newtype IfRange = IfRange (DateTime \/ String)
derive instance Newtype (IfRange) _ derive instance Newtype (IfRange) _
derive instance Eq (IfRange)
newtype IfUnmodifiedSince = IfUnmodifiedSince DateTime newtype IfUnmodifiedSince = IfUnmodifiedSince DateTime
derive instance Newtype (IfUnmodifiedSince) _ derive instance Newtype (IfUnmodifiedSince) _
derive instance Eq (IfUnmodifiedSince)
newtype LastModified = LastModified DateTime newtype LastModified = LastModified DateTime
derive instance Newtype (LastModified) _ derive instance Newtype (LastModified) _
derive instance Eq (LastModified)
data MatchETag = MatchETag String | MatchETagWeak String data MatchETag = MatchETag String | MatchETagWeak String
derive instance Eq MatchETag
newtype Origin = Origin String newtype Origin = Origin String
derive instance Newtype (Origin) _ derive instance Newtype (Origin) _
derive instance Eq (Origin)
data ProxyAuthorization = ProxyAuthorization AuthScheme String data ProxyAuthorization = ProxyAuthorization AuthScheme String
@@ -228,9 +354,11 @@ type RangeSpecifier = ByteRangeStart \/ (ByteRangeStart /\ ByteRangeEnd) \/ Byte
newtype Range = Range (RangeSpecifier \/ Array RangeSpecifier) newtype Range = Range (RangeSpecifier \/ Array RangeSpecifier)
derive instance Newtype (Range) _ derive instance Newtype (Range) _
derive instance Eq (Range)
newtype Referer = Referer String newtype Referer = Referer String
derive instance Newtype (Referer) _ derive instance Newtype (Referer) _
derive instance Eq (Referer)
data ReferrerPolicy data ReferrerPolicy
= ReferrerPolicyNoReferrer = ReferrerPolicyNoReferrer
@@ -244,39 +372,51 @@ data ReferrerPolicy
newtype RetryAfter = RetryAfter (DateTime \/ Int) newtype RetryAfter = RetryAfter (DateTime \/ Int)
derive instance Newtype (RetryAfter) _ derive instance Newtype (RetryAfter) _
derive instance Eq (RetryAfter)
newtype SecWebsocketKey = SecWebsocketKey String newtype SecWebsocketKey = SecWebsocketKey String
derive instance Newtype (SecWebsocketKey) _ derive instance Newtype (SecWebsocketKey) _
derive instance Eq (SecWebsocketKey)
newtype SecWebsocketAccept = SecWebsocketAccept SecWebsocketKey newtype SecWebsocketAccept = SecWebsocketAccept SecWebsocketKey
derive instance Newtype (SecWebsocketAccept) _ derive instance Newtype (SecWebsocketAccept) _
derive instance Eq (SecWebsocketAccept)
newtype SecWebsocketVersion = SecWebsocketVersion (String \/ NonEmptyArray String) newtype SecWebsocketVersion = SecWebsocketVersion (String \/ NonEmptyArray String)
derive instance Newtype (SecWebsocketVersion) _ derive instance Newtype (SecWebsocketVersion) _
derive instance Eq (SecWebsocketVersion)
newtype Server = Server String newtype Server = Server String
derive instance Newtype (Server) _ derive instance Newtype (Server) _
derive instance Eq (Server)
newtype SetCookie = SetCookie String newtype SetCookie = SetCookie String
derive instance Newtype (SetCookie) _ derive instance Newtype (SetCookie) _
derive instance Eq (SetCookie)
newtype StrictTransportSecurity = StrictTransportSecurity {maxAge :: Int, includeSubdomains :: Boolean, preload :: Boolean} newtype StrictTransportSecurity = StrictTransportSecurity {maxAge :: Int, includeSubdomains :: Boolean, preload :: Boolean}
derive instance Newtype (StrictTransportSecurity) _ derive instance Newtype (StrictTransportSecurity) _
derive instance Eq (StrictTransportSecurity)
newtype TE = TE String newtype TE = TE String
derive instance Newtype (TE) _ derive instance Newtype (TE) _
derive instance Eq (TE)
newtype TransferEncoding = TransferEncoding String newtype TransferEncoding = TransferEncoding String
derive instance Newtype (TransferEncoding) _ derive instance Newtype (TransferEncoding) _
derive instance Eq (TransferEncoding)
newtype Upgrade = Upgrade (NonEmptyArray String) newtype Upgrade = Upgrade (NonEmptyArray String)
derive instance Newtype (Upgrade) _ derive instance Newtype (Upgrade) _
derive instance Eq (Upgrade)
newtype UserAgent = UserAgent String newtype UserAgent = UserAgent String
derive instance Newtype (UserAgent) _ derive instance Newtype (UserAgent) _
derive instance Eq (UserAgent)
newtype Vary = Vary (Wildcard \/ NonEmptyArray StringLower) newtype Vary = Vary (Wildcard \/ NonEmptyArray StringLower)
derive instance Newtype (Vary) _ derive instance Newtype (Vary) _
derive instance Eq (Vary)
cacheControlDefaults :: Record CacheControl' cacheControlDefaults :: Record CacheControl'
cacheControlDefaults = cacheControlDefaults =
@@ -969,7 +1109,7 @@ instance TypedHeader Authorization where
headerName = "Authorization" headerName = "Authorization"
headerValueParser = headerValueParser =
let let
scheme = (Parse.String.anyTill (Parse.String.Basic.space) <#> fst <#> AuthScheme) scheme = (Parse.String.anyTill (void Parse.String.Basic.space <|> Parse.String.eof) <#> fst <#> AuthScheme)
in in
pure Authorization <*> scheme <*> (Parse.String.rest <#> String.trim) pure Authorization <*> scheme <*> (Parse.String.rest <#> String.trim)
headerValueEncode (Authorization (AuthScheme s) v) = s <> " " <> v headerValueEncode (Authorization (AuthScheme s) v) = s <> " " <> v
@@ -998,7 +1138,7 @@ instance TypedHeader BearerAuth where
instance TypedHeader CacheControl where instance TypedHeader CacheControl where
headerName = "Cache-Control" headerName = "Cache-Control"
headerValueParser = do headerValueParser = do
directives <- commas1 directiveParser <#> Map.fromFoldable directives <- commas1 directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable
pure $ CacheControl pure $ CacheControl
{ maxAge: Map.lookup "max-age" directives # join >>= Int.fromString { maxAge: Map.lookup "max-age" directives # join >>= Int.fromString
, maxStale: Map.lookup "max-stale" directives # join >>= Int.fromString , maxStale: Map.lookup "max-stale" directives # join >>= Int.fromString
@@ -1043,3 +1183,126 @@ instance TypedHeader CacheControl where
, flag a.staleWhileRevalidate "stale-while-revalidate" , flag a.staleWhileRevalidate "stale-while-revalidate"
, flag a.staleIfError "stale-if-error" , flag a.staleIfError "stale-if-error"
] ]
instance TypedHeader Connection where
headerName = "Connection"
headerValueParser =
let
close = closeRegexParser $> Connection (Left ConnectionClose)
in
close <|> (commas1 headerNameParser <#> Right <#> Connection)
headerValueEncode (Connection (Left ConnectionClose)) = "close"
headerValueEncode (Connection (Right as)) = as <#> String.Lower.toString # Array.NonEmpty.intercalate ", "
instance TypedHeader ContentDisposition where
headerName = "Content-Disposition"
headerValueParser =
let
boundary = Parse.String.string ";" <|> (Parse.String.eof *> pure "")
inline = Parse.String.string "inline" *> boundary $> ContentDisposition (Either.Nested.in1 ContentDispositionInline)
attachment = do
void $ Parse.String.string "attachment" *> boundary *> Parse.String.Basic.whiteSpace
directives <- commas1 directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable
let
filename =
join (Map.lookup "filename" directives <|> Map.lookup "filename*" directives)
pure $ ContentDisposition $ Either.Nested.in2 $ ContentDispositionAttachment {filename}
formData = do
void $ Parse.String.string "form-data" *> boundary *> Parse.String.Basic.whiteSpace
directives <- commas1 directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable
let
filename = join (Map.lookup "filename" directives)
name = join (Map.lookup "name" directives)
pure $ ContentDisposition $ Either.Nested.in3 $ ContentDispositionFormData {filename, name}
in
inline <|> attachment <|> formData
headerValueEncode (ContentDisposition a) =
Either.Nested.either3
(const $ [Just "inline"])
(\(ContentDispositionAttachment {filename}) -> [Just "attachment", (\s -> "filename=\"" <> s <> "\"") <$> filename])
(\(ContentDispositionFormData {filename, name}) -> [Just "attachment", (\s -> "filename=\"" <> s <> "\"") <$> filename, (\s -> "name=\"" <> s <> "\"") <$> name])
a
# Array.catMaybes
# Array.intercalate "; "
instance TypedHeader ContentEncoding where
headerName = "Content-Encoding"
headerValueParser =
commas1 (Parse.Combine.many Parse.String.Basic.alphaNum <#> Array.fromFoldable <#> String.CodeUnit.fromCharArray)
<#> ContentEncoding
headerValueEncode (ContentEncoding as) = Array.NonEmpty.intercalate ", " as
instance TypedHeader ContentLength where
headerName = "Content-Length"
headerValueParser = Parse.String.Basic.intDecimal <#> ContentLength
headerValueEncode (ContentLength a) = Int.toStringAs Int.decimal a
instance TypedHeader ContentLocation where
headerName = "Content-Location"
headerValueParser = Parse.String.rest <#> ContentLocation
headerValueEncode (ContentLocation a) = a
instance TypedHeader ContentRange where
headerName = "Content-Range"
headerValueParser =
let
startEndSize =
pure (\a b c -> a /\ b /\ c)
<*> ((Parse.String.Basic.intDecimal <#> ByteRangeStart) <* Parse.String.string "-")
<*> ((Parse.String.Basic.intDecimal <#> ByteRangeEnd) <* Parse.String.string "/")
<*> (Parse.String.Basic.intDecimal <#> ByteRangeLength)
startEnd =
pure (\a b -> a /\ b)
<*> ((Parse.String.Basic.intDecimal <#> ByteRangeStart) <* Parse.String.string "-")
<*> ((Parse.String.Basic.intDecimal <#> ByteRangeEnd) <* Parse.String.string "/" <* wildcardParser)
size =
wildcardParser
*> Parse.String.string "/"
*> Parse.String.Basic.intDecimal <#> ByteRangeLength
in
Parse.String.string "bytes"
*> Parse.String.Basic.whiteSpace
*> (startEndSize <#> Either.Nested.in1) <|> (startEnd <#> Either.Nested.in2) <|> (size <#> Either.Nested.in3)
<#> ContentRange
headerValueEncode (ContentRange a) =
Either.Nested.either3
(\(ByteRangeStart start /\ ByteRangeEnd end /\ ByteRangeLength len) -> ["bytes ", Int.toStringAs Int.decimal start, "-", Int.toStringAs Int.decimal end, "/", Int.toStringAs Int.decimal len])
(\(ByteRangeStart start /\ ByteRangeEnd end) -> ["bytes ", Int.toStringAs Int.decimal start, "-", Int.toStringAs Int.decimal end, "/*"])
(\(ByteRangeLength len) -> ["bytes ", "*/", Int.toStringAs Int.decimal len])
a
# Array.fold
instance TypedHeader Cookie where
headerName = "Cookie"
headerValueParser = Parse.String.rest <#> Cookie
headerValueEncode (Cookie a) = a
instance TypedHeader Date where
headerName = "Date"
headerValueParser = datetimeParser <#> Date
headerValueEncode (Date a) = printDateTime a
instance TypedHeader ETag where
headerName = "ETag"
headerValueParser = Parse.String.rest <#> ETag
headerValueEncode (ETag a) = a
instance TypedHeader ExpectContinue where
headerName = "Expect"
headerValueParser = Parse.String.string "100-continue" $> ExpectContinue
headerValueEncode ExpectContinue = "100-continue"
instance TypedHeader Expires where
headerName = "Expires"
headerValueParser = datetimeParser <#> Expires
headerValueEncode (Expires a) = printDateTime a
instance TypedHeader Host where
headerName = "Host"
headerValueParser = Parse.String.rest <#> Host
headerValueEncode (Host a) = a
instance TypedHeader Origin where
headerName = "Origin"
headerValueParser = Parse.String.rest <#> Origin
headerValueEncode (Origin a) = a

50
src/Axon.Request.Parts.Class.purs
View File

@@ -1,6 +1,7 @@
module Axon.Request.Parts.Class module Axon.Request.Parts.Class
( class RequestParts ( class RequestParts
, extractRequestParts , extractRequestParts
, Header(..)
, module Parts.Method , module Parts.Method
, module Parts.Body , module Parts.Body
, module Path.Parts , module Path.Parts
@@ -8,40 +9,17 @@ module Axon.Request.Parts.Class
import Prelude import Prelude
import Axon.Header.Typed (class TypedHeader, headerName, headerValueParser)
import Axon.Request (Request) import Axon.Request (Request)
import Axon.Request as Request import Axon.Request as Request
import Axon.Request.Method (Method) import Axon.Request.Method (Method)
import Axon.Request.Method as Method import Axon.Request.Method as Method
import Axon.Request.Parts.Body (Json(..), Stream(..)) import Axon.Request.Parts.Body (Json(..), Stream(..))
import Axon.Request.Parts.Body (Json(..), Stream(..)) as Parts.Body import Axon.Request.Parts.Body (Json(..), Stream(..)) as Parts.Body
import Axon.Request.Parts.Method import Axon.Request.Parts.Method (Connect(..), Delete(..), Get(..), Options(..), Patch(..), Post(..), Put(..), Trace(..))
( Connect(..) import Axon.Request.Parts.Method (Get(..), Post(..), Put(..), Patch(..), Delete(..), Trace(..), Options(..), Connect(..)) as Parts.Method
, Delete(..)
, Get(..)
, Options(..)
, Patch(..)
, Post(..)
, Put(..)
, Trace(..)
)
import Axon.Request.Parts.Method
( Get(..)
, Post(..)
, Put(..)
, Patch(..)
, Delete(..)
, Trace(..)
, Options(..)
, Connect(..)
) as Parts.Method
import Axon.Request.Parts.Path (Path(..)) as Path.Parts import Axon.Request.Parts.Path (Path(..)) as Path.Parts
import Axon.Request.Parts.Path import Axon.Request.Parts.Path (class DiscardTupledUnits, class PathParts, Path(..), discardTupledUnits, extractPathParts)
( class DiscardTupledUnits
, class PathParts
, Path(..)
, discardTupledUnits
, extractPathParts
)
import Axon.Response (Response) import Axon.Response (Response)
import Axon.Response as Response import Axon.Response as Response
import Control.Alternative (guard) import Control.Alternative (guard)
@@ -51,14 +29,25 @@ import Control.Monad.Trans.Class (lift)
import Data.Argonaut.Decode (class DecodeJson, decodeJson) import Data.Argonaut.Decode (class DecodeJson, decodeJson)
import Data.Array as Array import Data.Array as Array
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
import Data.Either (Either(..)) import Data.Either (Either(..), hush)
import Data.Generic.Rep (class Generic)
import Data.Map as Map
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, wrap) import Data.Newtype (class Newtype, wrap)
import Data.String.Lower as String.Lower
import Data.Tuple.Nested (type (/\), (/\)) import Data.Tuple.Nested (type (/\), (/\))
import Data.URL as URL import Data.URL as URL
import Effect.Aff (Aff) import Effect.Aff (Aff)
import Effect.Class (liftEffect) import Effect.Class (liftEffect)
import Node.Buffer (Buffer) import Node.Buffer (Buffer)
import Parsing (runParser)
newtype Header a = Header a
derive instance Generic (Header a) _
derive instance Newtype (Header a) _
derive newtype instance (Eq a) => Eq (Header a)
derive newtype instance (Ord a) => Ord (Header a)
derive newtype instance (Show a) => Show (Header a)
extractMethod :: extractMethod ::
forall a. forall a.
@@ -96,6 +85,11 @@ instance RequestParts (Either Request.BodyStringError String) where
<#> Just <#> Just
<#> Right <#> Right
instance TypedHeader a => RequestParts (Header a) where
extractRequestParts r = runExceptT $ runMaybeT do
value <- Request.headers r # Map.lookup (String.Lower.fromString $ headerName @a) # pure # MaybeT
runParser value (headerValueParser @a) # hush # pure # MaybeT <#> Header
instance (PathParts a b, DiscardTupledUnits b c) => RequestParts (Path a c) where instance (PathParts a b, DiscardTupledUnits b c) => RequestParts (Path a c) where
extractRequestParts r = extractRequestParts r =
let let

20
test/Test/Axon.Request.Parts.purs
View File

@@ -2,16 +2,11 @@ module Test.Axon.Request.Parts where
import Prelude import Prelude
import Axon.Header.Typed (ContentType(..))
import Axon.Request (Request) import Axon.Request (Request)
import Axon.Request as Request import Axon.Request as Request
import Axon.Request.Method (Method(..)) import Axon.Request.Method (Method(..))
import Axon.Request.Parts.Class import Axon.Request.Parts.Class (Header(..), Json(..), Patch(..), Path(..), Post(..), extractRequestParts)
( Json(..)
, Patch(..)
, Path(..)
, Post(..)
, extractRequestParts
)
import Axon.Request.Parts.Path (type (/), IgnoreRest) import Axon.Request.Parts.Path (type (/), IgnoreRest)
import Control.Monad.Error.Class (liftEither, liftMaybe) import Control.Monad.Error.Class (liftEither, liftMaybe)
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
@@ -30,6 +25,7 @@ import Node.Stream as Stream
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafePartial)
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual) import Test.Spec.Assertions (shouldEqual)
import Type.MIME as MIME
spec :: Spec Unit spec :: Spec Unit
spec = describe "Parts" do spec = describe "Parts" do
@@ -37,7 +33,7 @@ spec = describe "Parts" do
req <- liftEffect $ Request.make req <- liftEffect $ Request.make
{ body: Request.BodyEmpty { body: Request.BodyEmpty
, url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust , url: URL.fromString "http://localhost:80/foo" # unsafePartial fromJust
, headers: Map.empty , headers: Map.singleton "content-type" "application/json"
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 , address: Left $ unsafePerformEffect $ SocketAddress.newIpv4
{ address: "127.0.0.1", port: 81 } { address: "127.0.0.1", port: 81 }
, method: GET , method: GET
@@ -46,7 +42,7 @@ spec = describe "Parts" do
>>= liftEither >>= liftEither
>>= liftMaybe (error "was nothing") >>= liftMaybe (error "was nothing")
it "extracts method, path, JSON body" do it "extracts header, method, path, JSON body" do
stream <- Buffer.fromString """{"firstName": "henry"}""" UTF8 stream <- Buffer.fromString """{"firstName": "henry"}""" UTF8
>>= Stream.readableFromBuffer >>= Stream.readableFromBuffer
# liftEffect # liftEffect
@@ -54,17 +50,17 @@ spec = describe "Parts" do
{ body: Request.BodyReadable stream { body: Request.BodyReadable stream
, url: URL.fromString "http://localhost:80/users/12" # unsafePartial , url: URL.fromString "http://localhost:80/users/12" # unsafePartial
fromJust fromJust
, headers: Map.empty , headers: Map.singleton "content-type" "application/json"
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4 , address: Left $ unsafePerformEffect $ SocketAddress.newIpv4
{ address: "127.0.0.1", port: 81 } { address: "127.0.0.1", port: 81 }
, method: PATCH , method: PATCH
} }
a <- a <-
extractRequestParts extractRequestParts
@(Patch /\ (Path ("users" / Int) _) /\ Json { firstName :: String }) @(Patch /\ Header (ContentType MIME.Json) /\ (Path ("users" / Int) _) /\ Json { firstName :: String })
req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe req <#> lmap (error <<< show) >>= liftEither >>= liftMaybe
(error "was nothing") (error "was nothing")
a `shouldEqual` (Patch /\ Path 12 /\ Json { firstName: "henry" }) a `shouldEqual` (Patch /\ Header (ContentType MIME.Json) /\ Path 12 /\ Json { firstName: "henry" })
describe "Path" do describe "Path" do
it "matches a route matching literal" do it "matches a route matching literal" do