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

wip i dont care this is exhausting

Browse Source
This commit is contained in:
Orion Kindel 2024-12-05 11:15:42 -06:00
parent c0546a9a0d
commit 718709fc31
Signed by untrusted user who does not match committer: orion
GPG Key ID: 6D4165AE4C928719
4 changed files with 908 additions and 508 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1139
.spec-results
View File

File diff suppressed because it is too large Load Diff

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

@ -17,15 +17,13 @@ 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.Enum (fromEnum, toEnum)
import Data.Filterable (filter) import Data.Foldable (fold)
import Data.Foldable (any, elem)
import Data.Generic.Rep (class Generic) 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(..), isJust, maybe) import Data.Maybe (Maybe(..), fromMaybe, isJust)
import Data.Newtype (class Newtype, unwrap, wrap) import Data.Newtype (class Newtype, unwrap, wrap)
import Data.Set as Set
import Data.Show.Generic (genericShow) 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
@ -38,19 +36,86 @@ import Data.String.Regex.Flags as Regex.Flags
import Data.Time as Time 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.Console (log)
import Effect.Exception as Error import Effect.Exception as Error
import Effect.Unsafe (unsafePerformEffect)
import Parsing (Parser) import Parsing (Parser)
import Parsing (liftMaybe, fail, liftEither) as Parse import Parsing (liftMaybe, fail, liftEither) as Parse
import Parsing.Combinators (between, choice, lookAhead, many, optional, sepBy, sepBy1, try) as Parse import Parsing.Combinators (between, choice, optionMaybe, optional, sepBy1, try) as Parse
import Parsing.String (anyTill, regex, string, eof, rest) as Parse import Parsing.Combinators.Array (many, many1) as Parse
import Parsing.String (anyTill, eof, regex, rest, string) as Parse
import Parsing.String.Basic (whiteSpace, space, intDecimal, alphaNum) as Parse import Parsing.String.Basic (whiteSpace, space, intDecimal, alphaNum) as Parse
import Partial.Unsafe (unsafePartial) import Partial.Unsafe (unsafeCrashWith, unsafePartial)
import Prim.Row (class Nub, class Union) import Prim.Row (class Nub, class Union)
import Record as Record import Record as Record
import Type.MIME as Type.MIME import Type.MIME as Type.MIME
-- TODO: this is fine, probably switch to a tokenizer at some point. parsing headers is also probably a solved problem
rules ::
{ char :: Parser String String
, upAlpha :: Parser String String
, loAlpha :: Parser String String
, alpha :: Parser String String
, digit :: Parser String String
, ctl :: Parser String String
, cr :: Parser String String
, lf :: Parser String String
, sp :: Parser String String
, ht :: Parser String String
, dquote :: Parser String String
, crlf :: Parser String String
, lws :: Parser String String
, text :: Parser String String
, separators :: Parser String String
, token :: Parser String String
, quoted :: Parser String String
, cookieChar :: Parser String String
, token68 :: Parser String String
}
rules =
let
un (Left e) = unsafeCrashWith e
un (Right a) = a
char = un $ Parse.regex "[\\x00-\\x7f]" Regex.Flags.noFlags
upAlpha = un $ Parse.regex "[A-Z]" Regex.Flags.noFlags
loAlpha = un $ Parse.regex "[a-z]" Regex.Flags.noFlags
alpha = loAlpha <|> upAlpha
digit = un $ Parse.regex "[0-9]" Regex.Flags.noFlags
ctl = un $ Parse.regex "[\\x00-\\x1f]|\\x7f" Regex.Flags.noFlags
cr = un $ Parse.regex "\\x0d" Regex.Flags.noFlags
lf = un $ Parse.regex "\\x0a" Regex.Flags.noFlags
sp = un $ Parse.regex "\\x20" Regex.Flags.noFlags
ht = un $ Parse.regex "\\x09" Regex.Flags.noFlags
dquote = un $ Parse.regex "\\x22" Regex.Flags.noFlags
crlf = un $ Parse.regex "\\x0d\\x0a" Regex.Flags.noFlags
lws = Parse.optional crlf *> Parse.many1 (Parse.try sp <|> ht) <#> fold
text = un $ Parse.regex "\\x20|\\x09|[^\\x00-\\x1f]" Regex.Flags.noFlags
separators = un $ Parse.regex "[()<>@,;:\\\\\"\\/\\[\\]?={}\\x20\\x09]" Regex.Flags.noFlags
token = un $ Parse.regex "[^\\x00-\\x1f()<>@,;:\\\\\"\\/\\[\\]?={}\\x20\\x09]+" Regex.Flags.noFlags
quoted = un $ Parse.regex "\"(.*)(?<!\\\\)\"" Regex.Flags.noFlags
cookieChar = un $ Parse.regex "\\x21|[\\x23-\\x2b]|[\\x2d-\\x3a]|[\\x3c-\\x5b]|[\\x5d-\\x7e]" Regex.Flags.noFlags
token68 = un $ Parse.regex "[a-zA-Z0-9\\-._~+\\/]+=*" Regex.Flags.noFlags
in
{ char
, upAlpha
, loAlpha
, alpha
, digit
, ctl
, cr
, lf
, sp
, ht
, dquote
, crlf
, lws
, text
, separators
, token
, quoted
,cookieChar
,token68
}
data Wildcard = Wildcard data Wildcard = Wildcard
derive instance Generic Wildcard _ derive instance Generic Wildcard _
derive instance Eq Wildcard derive instance Eq Wildcard
@ -128,14 +193,31 @@ printDateTime dt =
] ]
# Array.intercalate " " # Array.intercalate " "
list :: forall a sep. Parser String sep -> Parser String a -> Parser String (Array a)
list sep p = do
head <- Parse.optionMaybe p
tail <- Array.many (Parse.whiteSpace *> sep *> Parse.whiteSpace *> Parse.optionMaybe p)
pure $ Array.catMaybes $ [head] <> tail
list1 :: forall a sep. Parser String sep -> Parser String a -> Parser String (NonEmptyArray a)
list1 sep p = do
head <- p
tail <-
Array.many (Parse.whiteSpace *> sep *> Parse.whiteSpace *> Parse.optionMaybe p)
<#> Array.catMaybes
pure $ Array.NonEmpty.cons' head tail
commas :: forall a. Parser String a -> Parser String (Array a) commas :: forall a. Parser String a -> Parser String (Array a)
commas p = Parse.sepBy p (Parse.whiteSpace <* Parse.string "," <* Parse.whiteSpace) <#> Array.fromFoldable commas = list $ Parse.string ","
commas1 :: forall a. Parser String a -> Parser String (NonEmptyArray a) commas1 :: forall a. Parser String a -> Parser String (NonEmptyArray a)
commas1 p = Parse.sepBy1 p (Parse.whiteSpace <* Parse.string "," <* Parse.whiteSpace) <#> Array.NonEmpty.fromFoldable1 commas1 = list1 $ Parse.string ","
semis :: forall a. Parser String a -> Parser String (Array a) semis :: forall a. Parser String a -> Parser String (Array a)
semis p = Parse.sepBy p (Parse.whiteSpace <* Parse.string ";" <* Parse.whiteSpace) <#> Array.fromFoldable semis = list $ Parse.string ";"
semis1 :: forall a. Parser String a -> Parser String (NonEmptyArray a)
semis1 = list1 $ Parse.string ";"
wildcardParser :: Parser String Wildcard wildcardParser :: Parser String Wildcard
wildcardParser = Parse.whiteSpace *> (Parse.string "*" $> Wildcard) <* Parse.whiteSpace wildcardParser = Parse.whiteSpace *> (Parse.string "*" $> Wildcard) <* Parse.whiteSpace
@ -153,29 +235,20 @@ headerNameParser :: Parser String StringLower
headerNameParser = Parse.between Parse.whiteSpace Parse.whiteSpace (headerNameRegexParser <#> String.Lower.fromString) headerNameParser = Parse.between Parse.whiteSpace Parse.whiteSpace (headerNameRegexParser <#> String.Lower.fromString)
methodParser :: Parser String Method methodParser :: Parser String Method
methodParser = Parse.between Parse.whiteSpace Parse.whiteSpace $ Parse.many Parse.alphaNum <#> Array.fromFoldable <#> String.CodeUnit.fromCharArray >>= (\a -> Parse.liftMaybe (const $ "invalid method " <> a) $ Method.fromString a) methodParser =
Parse.try (Parse.string "GET" $> Method.GET)
<|> Parse.try (Parse.string "HEAD" $> Method.HEAD)
<|> Parse.try (Parse.string "POST" $> Method.POST)
<|> Parse.try (Parse.string "PUT" $> Method.PUT)
<|> Parse.try (Parse.string "PATCH" $> Method.PATCH)
<|> Parse.try (Parse.string "DELETE" $> Method.DELETE)
<|> Parse.try (Parse.string "CONNECT" $> Method.CONNECT)
<|> Parse.try (Parse.string "OPTIONS" $> Method.OPTIONS)
<|> Parse.string "TRACE" $> Method.TRACE
directiveParser :: Parser String (StringLower /\ Maybe String) directiveParser :: Parser String (String /\ Maybe String)
directiveParser = directiveParser =
let pure (/\) <*> rules.token <*> Parse.optionMaybe (Parse.string "=" *> (rules.quoted <|> rules.token))
boundary = Parse.lookAhead $ Parse.try (Parse.string ",") <|> Parse.try (Parse.string ";") <|> Parse.try (Parse.eof *> pure "")
kvSep = Parse.string "="
kvParser =
pure (\k v -> k /\ Just v)
<*> (Parse.whiteSpace *> Parse.anyTill kvSep <#> fst <#> String.trim <#> String.Lower.fromString)
<*> (Parse.whiteSpace *> Parse.anyTill boundary <#> fst <#> String.trim)
kParser =
Parse.whiteSpace
*> Parse.anyTill boundary
<#> fst
<#> String.trim
<#> String.Lower.fromString
<#> (\k -> k /\ Nothing)
in
(Parse.try kvParser <|> kParser)
<#> Just
<#> filter (\(k /\ v) -> not (String.null $ String.Lower.toString k) && maybe true (not <<< String.null) v)
>>= (Parse.liftMaybe $ const "empty directive")
class TypedHeader a where class TypedHeader a where
headerName :: String headerName :: String
@ -377,7 +450,7 @@ derive instance Newtype (ContentType a) _
derive instance Eq a => Eq (ContentType a) derive instance Eq a => Eq (ContentType a)
instance Show a => Show (ContentType a) where show = genericShow instance Show a => Show (ContentType a) where show = genericShow
newtype Cookie = Cookie String newtype Cookie = Cookie (NonEmptyArray (String /\ String))
derive instance Newtype (Cookie) _ derive instance Newtype (Cookie) _
derive instance Generic (Cookie) _ derive instance Generic (Cookie) _
instance Show (Cookie) where show = genericShow instance Show (Cookie) where show = genericShow
@ -1179,7 +1252,7 @@ instance TypedHeader AccessControlAllowHeaders where
headerName = "Access-Control-Allow-Headers" headerName = "Access-Control-Allow-Headers"
headerValueParser = headerValueParser =
let let
headers = commas1 headerNameParser <#> Right <#> AccessControlAllowHeaders headers = commas1 rules.token <#> map String.Lower.fromString <#> Right <#> AccessControlAllowHeaders
in in
Parse.try (wildcardParser $> AccessControlAllowHeaders (Left Wildcard)) <|> Parse.try headers Parse.try (wildcardParser $> AccessControlAllowHeaders (Left Wildcard)) <|> Parse.try headers
headerValueEncode (AccessControlAllowHeaders (Left Wildcard)) = "*" headerValueEncode (AccessControlAllowHeaders (Left Wildcard)) = "*"
@ -1243,10 +1316,9 @@ instance TypedHeader Allow where
instance TypedHeader Authorization where instance TypedHeader Authorization where
headerName = "Authorization" headerName = "Authorization"
headerValueParser = headerValueParser =
let pure (\scheme val -> Authorization scheme val)
scheme = Parse.whiteSpace *> (Parse.anyTill (void (Parse.try Parse.space) <|> Parse.eof) <#> fst <#> String.trim <#> AuthScheme) <*> ((rules.token <#> AuthScheme) <* Parse.whiteSpace)
in <*> (Parse.optionMaybe rules.token68 <#> fromMaybe "")
pure Authorization <*> scheme <*> (Parse.rest <#> String.trim)
headerValueEncode (Authorization (AuthScheme s) v) = s <> " " <> v headerValueEncode (Authorization (AuthScheme s) v) = s <> " " <> v
instance TypedHeader BasicAuth where instance TypedHeader BasicAuth where
@ -1273,29 +1345,7 @@ instance TypedHeader BearerAuth where
instance TypedHeader CacheControl where instance TypedHeader CacheControl where
headerName = "Cache-Control" headerName = "Cache-Control"
headerValueParser = do headerValueParser = do
directives <- commas directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable directives <- commas directiveParser <#> Map.fromFoldable
let
keys =
[ "max-age"
, "max-stale"
, "min-fresh"
, "s-maxage"
, "no-cache"
, "no-store"
, "no-transform"
, "only-if-cached"
, "must-revalidate"
, "must-understand"
, "proxy-revalidate"
, "private"
, "public"
, "immutable"
, "stale-while-revalidate"
, "stale-if-error"
]
when
(Map.keys directives # (Set.toUnfoldable :: _ (Array _)) # any (flip elem keys) # not)
(Parse.fail "no directives")
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
@ -1359,7 +1409,7 @@ instance TypedHeader ContentDisposition where
inline = Parse.whiteSpace *> Parse.string "inline" *> boundary $> ContentDisposition (Either.Nested.in1 ContentDispositionInline) inline = Parse.whiteSpace *> Parse.string "inline" *> boundary $> ContentDisposition (Either.Nested.in1 ContentDispositionInline)
attachment = do attachment = do
void $ Parse.whiteSpace *> Parse.string "attachment" *> boundary *> Parse.whiteSpace void $ Parse.whiteSpace *> Parse.string "attachment" *> boundary *> Parse.whiteSpace
directives <- semis directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable directives <- semis directiveParser <#> Map.fromFoldable
let let
filename = filename =
(Map.lookup "filename" directives <|> Map.lookup "filename*" directives) (Map.lookup "filename" directives <|> Map.lookup "filename*" directives)
@ -1368,7 +1418,7 @@ instance TypedHeader ContentDisposition where
pure $ ContentDisposition $ Either.Nested.in2 $ ContentDispositionAttachment {filename} pure $ ContentDisposition $ Either.Nested.in2 $ ContentDispositionAttachment {filename}
formData = do formData = do
void $ Parse.whiteSpace *> Parse.string "form-data" *> boundary *> Parse.whiteSpace void $ Parse.whiteSpace *> Parse.string "form-data" *> boundary *> Parse.whiteSpace
directives <- semis directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable directives <- semis directiveParser <#> Map.fromFoldable
let let
filename = Map.lookup "filename" directives # join <#> Regex.replace quotesRe "" filename = Map.lookup "filename" directives # join <#> Regex.replace quotesRe ""
name = Map.lookup "name" directives # join <#> Regex.replace quotesRe "" name = Map.lookup "name" directives # join <#> Regex.replace quotesRe ""
@ -1398,7 +1448,7 @@ instance TypedHeader ContentLength where
instance TypedHeader ContentLocation where instance TypedHeader ContentLocation where
headerName = "Content-Location" headerName = "Content-Location"
headerValueParser = Parse.rest <#> ContentLocation headerValueParser = Parse.rest <#> String.trim <#> ContentLocation
headerValueEncode (ContentLocation a) = a headerValueEncode (ContentLocation a) = a
instance TypedHeader ContentRange where instance TypedHeader ContentRange where
@ -1419,9 +1469,13 @@ instance TypedHeader ContentRange where
*> Parse.string "/" *> Parse.string "/"
*> Parse.intDecimal <#> ByteRangeLength *> Parse.intDecimal <#> ByteRangeLength
in in
Parse.string "bytes" Parse.whiteSpace
*> Parse.string "bytes"
*> Parse.whiteSpace *> Parse.whiteSpace
*> Parse.try (startEndSize <#> Either.Nested.in1) <|> Parse.try (startEnd <#> Either.Nested.in2) <|> Parse.try (size <#> Either.Nested.in3) *> ( (Parse.try startEndSize <#> Either.Nested.in1)
<|> (Parse.try startEnd <#> Either.Nested.in2)
<|> (Parse.try size <#> Either.Nested.in3)
)
<#> ContentRange <#> ContentRange
headerValueEncode (ContentRange a) = headerValueEncode (ContentRange a) =
Either.Nested.either3 Either.Nested.either3
@ -1433,8 +1487,16 @@ instance TypedHeader ContentRange where
instance TypedHeader Cookie where instance TypedHeader Cookie where
headerName = "Cookie" headerName = "Cookie"
headerValueParser = Parse.rest <#> Cookie headerValueParser =
headerValueEncode (Cookie a) = a let
cookieName = rules.token
cookieValue =
(Parse.try (rules.dquote *> Parse.many rules.cookieChar <* rules.dquote) <|> Parse.many rules.cookieChar)
<#> fold
cookiePair = pure (\k v -> k /\ v) <*> (cookieName <* Parse.string "=") <*> cookieValue
in
Parse.sepBy1 cookiePair (Parse.string "; ") <#> Array.NonEmpty.fromFoldable1 <#> Cookie
headerValueEncode (Cookie as) = as <#> (\(k /\ v) -> k <> "=" <> v) # Array.NonEmpty.intercalate "; "
instance TypedHeader Date where instance TypedHeader Date where
headerName = "Date" headerName = "Date"
@ -1649,7 +1711,7 @@ instance TypedHeader SetCookie where
instance TypedHeader StrictTransportSecurity where instance TypedHeader StrictTransportSecurity where
headerName = "Strict-Transport-Security" headerName = "Strict-Transport-Security"
headerValueParser = do headerValueParser = do
directives <- commas1 directiveParser <#> map (\(k /\ v) -> String.Lower.toString k /\ v) <#> Map.fromFoldable directives <- commas1 directiveParser <#> Map.fromFoldable
pure $ StrictTransportSecurity pure $ StrictTransportSecurity
{ maxAge: Map.lookup "max-age" directives # join >>= Int.fromString { maxAge: Map.lookup "max-age" directives # join >>= Int.fromString
, includeSubdomains: Map.lookup "includesubdomains" directives # isJust , includeSubdomains: Map.lookup "includesubdomains" directives # isJust

5
src/Axon.Request.Method.purs
View File

@ -7,7 +7,7 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow) import Data.Show.Generic (genericShow)
import Data.String as String import Data.String as String
data Method = GET | POST | PUT | PATCH | DELETE | OPTIONS | TRACE | CONNECT data Method = GET | POST | PUT | PATCH | DELETE | OPTIONS | TRACE | CONNECT | HEAD
derive instance Generic Method _ derive instance Generic Method _
derive instance Eq Method derive instance Eq Method
@ -16,6 +16,7 @@ instance Show Method where
toString :: Method -> String toString :: Method -> String
toString GET = "GET" toString GET = "GET"
toString HEAD = "HEAD"
toString POST = "POST" toString POST = "POST"
toString PUT = "PUT" toString PUT = "PUT"
toString PATCH = "PATCH" toString PATCH = "PATCH"
@ -37,4 +38,4 @@ fromString =
go "CONNECT" = Just CONNECT go "CONNECT" = Just CONNECT
go _ = Nothing go _ = Nothing
in in
go <<< String.toUpper go

70
test/Test/Axon.Header.Typed.purs
View File

@ -2,7 +2,7 @@ module Test.Axon.Header.Typed where
import Prelude import Prelude
import Axon.Header.Typed (class TypedHeader, Accept(..), AccessControlAllowCredentials(..), AccessControlAllowHeaders(..), AccessControlAllowMethods(..), AccessControlAllowOrigin(..), AccessControlExposeHeaders(..), AccessControlMaxAge(..), AccessControlRequestHeaders(..), AccessControlRequestMethod(..), Age(..), Allow(..), AuthScheme(..), Authorization(..), BasicAuth(..), BearerAuth(..), CacheControl(..), Connection(..), ConnectionClose(..), ContentDisposition(..), ContentDispositionAttachment(..), ContentDispositionFormData(..), ContentDispositionInline(..), ContentEncoding(..), ContentLength(..), ContentType(..), Wildcard(..), cacheControlDefaults, headerValueParser) import Axon.Header.Typed (class TypedHeader, Accept(..), AccessControlAllowCredentials(..), AccessControlAllowHeaders(..), AccessControlAllowMethods(..), AccessControlAllowOrigin(..), AccessControlExposeHeaders(..), AccessControlMaxAge(..), AccessControlRequestHeaders(..), AccessControlRequestMethod(..), Age(..), Allow(..), AuthScheme(..), Authorization(..), BasicAuth(..), BearerAuth(..), ByteRangeEnd(..), ByteRangeLength(..), ByteRangeStart(..), CacheControl(..), Connection(..), ConnectionClose(..), ContentDisposition(..), ContentDispositionAttachment(..), ContentDispositionFormData(..), ContentDispositionInline(..), ContentEncoding(..), ContentLength(..), ContentLocation(..), ContentRange(..), ContentType(..), Cookie(..), Wildcard(..), cacheControlDefaults, headerValueParser)
import Axon.Request.Method (Method(..)) import Axon.Request.Method (Method(..))
import Control.Monad.Error.Class (liftEither) import Control.Monad.Error.Class (liftEither)
import Data.Bifunctor (lmap) import Data.Bifunctor (lmap)
@ -11,6 +11,7 @@ import Data.Either.Nested as Either.Nested
import Data.MIME as MIME import Data.MIME as MIME
import Data.Maybe (Maybe(..)) import Data.Maybe (Maybe(..))
import Data.String.Lower as String.Lower import Data.String.Lower as String.Lower
import Data.Tuple.Nested ((/\))
import Effect.Exception (error) import Effect.Exception (error)
import Parsing (parseErrorMessage, runParser) import Parsing (parseErrorMessage, runParser)
import Test.Spec (Spec, describe, it) import Test.Spec (Spec, describe, it)
@ -482,17 +483,18 @@ spec =
" * " `is` AccessControlAllowHeaders (Left Wildcard) " * " `is` AccessControlAllowHeaders (Left Wildcard)
"* " `is` AccessControlAllowHeaders (Left Wildcard) "* " `is` AccessControlAllowHeaders (Left Wildcard)
"Vary" `is` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary") "Vary" `is` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary")
" Vary" `is` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary") " Vary" `isnt` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary")
" Vary " `is` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary") "Vary " `isnt` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary")
"Vary, " `is` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary")
"Accept, Vary, Content-Type" `is` AccessControlAllowHeaders (Right $ (pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString) "Accept, Vary, Content-Type" `is` AccessControlAllowHeaders (Right $ (pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString)
describe "AccessControlAllowMethods" do describe "AccessControlAllowMethods" do
"*" `is` AccessControlAllowMethods (Left Wildcard) "*" `is` AccessControlAllowMethods (Left Wildcard)
" * " `is` AccessControlAllowMethods (Left Wildcard) " * " `is` AccessControlAllowMethods (Left Wildcard)
"* " `is` AccessControlAllowMethods (Left Wildcard) "* " `is` AccessControlAllowMethods (Left Wildcard)
"GET" `is` AccessControlAllowMethods (Right $ pure GET) "GET" `is` AccessControlAllowMethods (Right $ pure GET)
"get" `is` AccessControlAllowMethods (Right $ pure GET) "get" `isnt` AccessControlAllowMethods (Right $ pure GET)
"GET, PATCH" `is` AccessControlAllowMethods (Right $ pure GET <> pure PATCH) "GET,,,,,, PATCH" `is` AccessControlAllowMethods (Right $ pure GET <> pure PATCH)
" GET , PATCH " `is` AccessControlAllowMethods (Right $ pure GET <> pure PATCH) " GET , PATCH " `isnt` AccessControlAllowMethods (Right $ pure GET <> pure PATCH)
describe "AccessControlAllowOrigin" do describe "AccessControlAllowOrigin" do
"*" `is` AccessControlAllowOrigin (Left Wildcard) "*" `is` AccessControlAllowOrigin (Left Wildcard)
" * " `is` AccessControlAllowOrigin (Left Wildcard) " * " `is` AccessControlAllowOrigin (Left Wildcard)
@ -505,8 +507,8 @@ spec =
" * " `is` AccessControlExposeHeaders (Left Wildcard) " * " `is` AccessControlExposeHeaders (Left Wildcard)
"* " `is` AccessControlExposeHeaders (Left Wildcard) "* " `is` AccessControlExposeHeaders (Left Wildcard)
"Vary" `is` AccessControlExposeHeaders (Right $ pure $ String.Lower.fromString "Vary") "Vary" `is` AccessControlExposeHeaders (Right $ pure $ String.Lower.fromString "Vary")
" Vary" `is` AccessControlExposeHeaders (Right $ pure $ String.Lower.fromString "Vary") "Vary" `is` AccessControlExposeHeaders (Right $ pure $ String.Lower.fromString "Vary")
" Vary " `is` AccessControlExposeHeaders (Right $ pure $ String.Lower.fromString "Vary") "Vary " `is` AccessControlExposeHeaders (Right $ pure $ String.Lower.fromString "Vary")
"Accept, Vary, Content-Type" `is` AccessControlExposeHeaders (Right $ (pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString) "Accept, Vary, Content-Type" `is` AccessControlExposeHeaders (Right $ (pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString)
describe "AccessControlMaxAge" do describe "AccessControlMaxAge" do
" 123 " `is` AccessControlMaxAge 123 " 123 " `is` AccessControlMaxAge 123
@ -519,22 +521,26 @@ spec =
"Accept, Vary, Content-Type" `is` AccessControlRequestHeaders ((pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString) "Accept, Vary, Content-Type" `is` AccessControlRequestHeaders ((pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString)
describe "AccessControlRequestMethod" do describe "AccessControlRequestMethod" do
"GET" `is` AccessControlRequestMethod GET "GET" `is` AccessControlRequestMethod GET
"get" `is` AccessControlRequestMethod GET " PATCH " `isnt` AccessControlRequestMethod PATCH
" patCh " `is` AccessControlRequestMethod PATCH "get" `isnt` AccessControlRequestMethod GET
"PATCh" `isnt` AccessControlRequestMethod PATCH
describe "Age" do describe "Age" do
" 123 " `is` Age 123 " 123 " `is` Age 123
" 0" `is` Age 0 " 0" `is` Age 0
"23190" `is` Age 23190 "23190" `is` Age 23190
describe "Allow" do describe "Allow" do
"GET" `is` Allow (pure GET) "GET" `is` Allow (pure GET)
"get" `is` Allow (pure GET) "get" `isnt` Allow (pure GET)
"GET, PATCH" `is` Allow (pure GET <> pure PATCH) "GET, PATCH" `is` Allow (pure GET <> pure PATCH)
" GET , PATCH " `is` Allow (pure GET <> pure PATCH) "GET,,,,,, , , ,PATCH" `is` Allow (pure GET <> pure PATCH)
" GET , PATCH " `isnt` Allow (pure GET <> pure PATCH)
describe "Authorization" do describe "Authorization" do
"Foo bar" `is` Authorization (AuthScheme "Foo") "bar" "Foo bar" `is` Authorization (AuthScheme "Foo") "bar"
"Bing bar" `is` Authorization (AuthScheme "Bing") "bar" "Bing bar" `is` Authorization (AuthScheme "Bing") "bar"
" Bing bar " `is` Authorization (AuthScheme "Bing") "bar" " Bing bar" `isnt` Authorization (AuthScheme "Bing") "bar"
"bar" `isnt` Authorization (AuthScheme "Foo") "bar" "Bing bar " `is` Authorization (AuthScheme "Bing") "bar"
" Bing bar " `isnt` Authorization (AuthScheme "Bing") "bar"
"Bar" `is` Authorization (AuthScheme "Bar") ""
describe "BasicAuth" do describe "BasicAuth" do
"Basic ZGVtbzpwQDU1dzByZA==" `is` BasicAuth {username: "demo", password: "p@55w0rd"} "Basic ZGVtbzpwQDU1dzByZA==" `is` BasicAuth {username: "demo", password: "p@55w0rd"}
"Bearer ZGVtbzpwQDU1dzByZA==" `isnt` BasicAuth {username: "demo", password: "p@55w0rd"} "Bearer ZGVtbzpwQDU1dzByZA==" `isnt` BasicAuth {username: "demo", password: "p@55w0rd"}
@ -545,16 +551,17 @@ spec =
"Bearer foo " `is` BearerAuth "foo" "Bearer foo " `is` BearerAuth "foo"
describe "CacheControl" do describe "CacheControl" do
"max-age=604800" `is` CacheControl (cacheControlDefaults {maxAge = Just 604800}) "max-age=604800" `is` CacheControl (cacheControlDefaults {maxAge = Just 604800})
" max-age=604800 " `is` CacheControl (cacheControlDefaults {maxAge = Just 604800}) " max-age=604800" `isnt` CacheControl (cacheControlDefaults {maxAge = Just 604800})
"max-age=604800 " `isnt` CacheControl (cacheControlDefaults {maxAge = Just 604800})
"max-age=604800, must-revalidate" `is` CacheControl (cacheControlDefaults {maxAge = Just 604800, mustRevalidate = true}) "max-age=604800, must-revalidate" `is` CacheControl (cacheControlDefaults {maxAge = Just 604800, mustRevalidate = true})
"max-age=20, s-maxage=10, no-cache, must-revalidate, proxy-revalidate, no-store, private, public, must-understand, no-transform, immutable, stale-while-revalidate, stale-if-error" "max-age=20, s-maxage=10, no-cache, must-revalidate, proxy-revalidate, no-store, private, public, must-understand, no-transform, immutable, stale-while-revalidate, stale-if-error"
`is` `is`
CacheControl (cacheControlDefaults {maxAge = Just 20, sMaxAge = Just 10, noCache = true, mustRevalidate = true, proxyRevalidate = true, noStore = true, private = true, public = true, mustUnderstand = true, noTransform = true, immutable = true, staleWhileRevalidate = true, staleIfError = true}) CacheControl (cacheControlDefaults {maxAge = Just 20, sMaxAge = Just 10, noCache = true, mustRevalidate = true, proxyRevalidate = true, noStore = true, private = true, public = true, mustUnderstand = true, noTransform = true, immutable = true, staleWhileRevalidate = true, staleIfError = true})
"" `isnt` CacheControl cacheControlDefaults "" `is` CacheControl cacheControlDefaults
" " `isnt` CacheControl cacheControlDefaults " " `isnt` CacheControl cacheControlDefaults
"foo=bar" `isnt` CacheControl cacheControlDefaults "foo=bar" `is` CacheControl cacheControlDefaults
"foo" `isnt` CacheControl cacheControlDefaults "foo" `is` CacheControl cacheControlDefaults
" foo=bar " `isnt` CacheControl cacheControlDefaults "foo=bar " `isnt` CacheControl cacheControlDefaults
" foo " `isnt` CacheControl cacheControlDefaults " foo " `isnt` CacheControl cacheControlDefaults
describe "Connection" do describe "Connection" do
"" `isnt` Connection (Left ConnectionClose) "" `isnt` Connection (Left ConnectionClose)
@ -568,11 +575,11 @@ spec =
"form-data" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Nothing, name: Nothing}) "form-data" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Nothing, name: Nothing})
"form-data; name=\"foo\"" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Nothing, name: Just "foo"}) "form-data; name=\"foo\"" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Nothing, name: Just "foo"})
"form-data; filename=\"foo.txt\"" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Just "foo.txt", name: Nothing}) "form-data; filename=\"foo.txt\"" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Just "foo.txt", name: Nothing})
" form-data; filename=\"foo.txt\" ; name=\"foo\" " `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Just "foo.txt", name: Just "foo"}) " form-data; filename=\"foo.txt\" ; name=\"foo\" " `isnt` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Just "foo.txt", name: Just "foo"})
"attachment" `is` ContentDisposition (Either.Nested.in2 $ ContentDispositionAttachment {filename: Nothing}) "attachment" `is` ContentDisposition (Either.Nested.in2 $ ContentDispositionAttachment {filename: Nothing})
"attachment; filename=\"foo.txt\"" `is` ContentDisposition (Either.Nested.in2 $ ContentDispositionAttachment {filename: Just "foo.txt"}) "attachment; filename=\"foo.txt\"" `is` ContentDisposition (Either.Nested.in2 $ ContentDispositionAttachment {filename: Just "foo.txt"})
" attachment; filename=\"foo.txt\" " `is` ContentDisposition (Either.Nested.in2 $ ContentDispositionAttachment {filename: Just "foo.txt"}) " attachment; filename=\"foo.txt\" " `isnt` ContentDisposition (Either.Nested.in2 $ ContentDispositionAttachment {filename: Just "foo.txt"})
"inline" `is` ContentDisposition (Either.Nested.in1 $ ContentDispositionInline) "inline" `is` ContentDisposition (Either.Nested.in1 $ ContentDispositionInline)
"inline " `is` ContentDisposition (Either.Nested.in1 $ ContentDispositionInline) "inline " `is` ContentDisposition (Either.Nested.in1 $ ContentDispositionInline)
@ -585,9 +592,24 @@ spec =
" 0 " `is` ContentLength 0 " 0 " `is` ContentLength 0
" 1 " `is` ContentLength 1 " 1 " `is` ContentLength 1
" 1212943817 " `is` ContentLength 1212943817 " 1212943817 " `is` ContentLength 1212943817
describe "ContentLocation" $ pure unit describe "ContentLocation" do
describe "ContentRange" $ pure unit "" `is` ContentLocation ""
describe "Cookie" $ pure unit "a" `is` ContentLocation "a"
" a " `is` ContentLocation "a"
"abc" `is` ContentLocation "abc"
describe "ContentRange" do
"bytes 0-10/10" `is` (ContentRange $ Either.Nested.in1 $ ByteRangeStart 0 /\ ByteRangeEnd 10 /\ ByteRangeLength 10)
" bytes 0-10/10 " `is` (ContentRange $ Either.Nested.in1 $ ByteRangeStart 0 /\ ByteRangeEnd 10 /\ ByteRangeLength 10)
" bytes 0-0/0 " `is` (ContentRange $ Either.Nested.in1 $ ByteRangeStart 0 /\ ByteRangeEnd 0 /\ ByteRangeLength 0)
"bytes 0-10/*" `is` (ContentRange $ Either.Nested.in2 $ ByteRangeStart 0 /\ ByteRangeEnd 10)
" bytes 0-10/* " `is` (ContentRange $ Either.Nested.in2 $ ByteRangeStart 0 /\ ByteRangeEnd 10)
"bytes */10" `is` (ContentRange $ Either.Nested.in3 $ ByteRangeLength 10)
" bytes */10 " `is` (ContentRange $ Either.Nested.in3 $ ByteRangeLength 10)
describe "Cookie" do
"foo=" `is` Cookie (pure ("foo" /\ ""))
"foo=bar" `is` Cookie (pure ("foo" /\ "bar"))
"foo=bar; baz=" `is` Cookie (pure ("foo" /\ "bar") <> pure ("baz" /\ ""))
"foo=bar; baz=quux" `is` Cookie (pure ("foo" /\ "bar") <> pure ("baz" /\ "quux"))
describe "Date" $ pure unit describe "Date" $ pure unit
describe "ETag" $ pure unit describe "ETag" $ pure unit
describe "ExpectContinue" $ pure unit describe "ExpectContinue" $ pure unit