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

fix: some handler plumbing

Browse Source
This commit is contained in:
Orion Kindel 2025-02-12 12:26:30 -06:00
parent 718709fc31
commit 789fc5165f
Signed by untrusted user who does not match committer: orion
GPG Key ID: 6D4165AE4C928719
16 changed files with 3125 additions and 1057 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

867
.spec-results
View File

File diff suppressed because it is too large Load Diff

56
spago.yaml
View File

@ -3,34 +3,34 @@ package:
dependencies:
- b64
- parsing
- aff: ">=8.0.0 <9.0.0"
- argonaut-codecs: ">=9.1.0 <10.0.0"
- argonaut-core: ">=7.0.0 <8.0.0"
- arraybuffer-types: ">=3.0.2 <4.0.0"
- arrays: ">=7.3.0 <8.0.0"
- bifunctors: ">=6.0.0 <7.0.0"
- console: ">=6.1.0 <7.0.0"
- control: ">=6.0.0 <7.0.0"
- effect: ">=4.0.0 <5.0.0"
- either: ">=6.1.0 <7.0.0"
- exceptions: ">=6.1.0 <7.0.0"
- foldable-traversable: ">=6.0.0 <7.0.0"
- integers: ">=6.0.0 <7.0.0"
- maybe: ">=6.0.0 <7.0.0"
- newtype: ">=5.0.0 <6.0.0"
- node-buffer: ">=9.0.0 <10.0.0"
- node-net: ">=5.1.0 <6.0.0"
- node-streams: ">=9.0.0 <10.0.0"
- nullable: ">=6.0.0 <7.0.0"
- ordered-collections: ">=3.2.0 <4.0.0"
- prelude: ">=6.0.1 <7.0.0"
- refs: ">=6.0.0 <7.0.0"
- strings: ">=6.0.1 <7.0.0"
- transformers: ">=6.1.0 <7.0.0"
- tuples: ">=7.0.0 <8.0.0"
- typelevel-prelude: ">=7.0.0 <8.0.0"
- url-immutable: ">=1.0.0 <2.0.0"
- web-streams: ">=4.0.0 <5.0.0"
- aff: '>=8.0.0 <9.0.0'
- argonaut-codecs: '>=9.1.0 <10.0.0'
- argonaut-core: '>=7.0.0 <8.0.0'
- arraybuffer-types: '>=3.0.2 <4.0.0'
- arrays: '>=7.3.0 <8.0.0'
- bifunctors: '>=6.0.0 <7.0.0'
- console: '>=6.1.0 <7.0.0'
- control: '>=6.0.0 <7.0.0'
- effect: '>=4.0.0 <5.0.0'
- either: '>=6.1.0 <7.0.0'
- exceptions: '>=6.1.0 <7.0.0'
- foldable-traversable: '>=6.0.0 <7.0.0'
- integers: '>=6.0.0 <7.0.0'
- maybe: '>=6.0.0 <7.0.0'
- newtype: '>=5.0.0 <6.0.0'
- node-buffer: '>=9.0.0 <10.0.0'
- node-net: '>=5.1.0 <6.0.0'
- node-streams: '>=9.0.0 <10.0.0'
- nullable: '>=6.0.0 <7.0.0'
- ordered-collections: '>=3.2.0 <4.0.0'
- prelude: '>=6.0.1 <7.0.0'
- refs: '>=6.0.0 <7.0.0'
- strings: '>=6.0.1 <7.0.0'
- transformers: '>=6.1.0 <7.0.0'
- tuples: '>=7.0.0 <8.0.0'
- typelevel-prelude: '>=7.0.0 <8.0.0'
- url-immutable: '>=1.0.0 <2.0.0'
- web-streams: '>=4.0.0 <5.0.0'
test:
main: Test.Main
dependencies:

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

File diff suppressed because it is too large Load Diff

1
src/Axon.Node.purs Normal file
View File

@ -0,0 +1 @@
module Axon.Node where

12
src/Axon.Request.Handler.Default.purs Normal file
View File

@ -0,0 +1,12 @@
module Axon.Request.Handler.Default where
import Prelude
import Axon.Request.Handler (Handler(..))
import Axon.Response (Response)
import Axon.Response as Response
import Data.Either (Either(..))
import Effect.Aff.Class (class MonadAff)
notFound :: forall m. MonadAff m => Handler m Response
notFound = Handler $ const $ pure $ Right $ Response.fromStatus 404

54
src/Axon.Request.Handler.purs Normal file
View File

@ -0,0 +1,54 @@
module Axon.Request.Handler where
import Prelude
import Axon.Request (Request)
import Axon.Request.Parts.Class
( class RequestParts
, ExtractError(..)
, extractRequestParts
)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Data.Either (Either(..))
import Data.Newtype (class Newtype)
import Effect.Aff.Class (class MonadAff, liftAff)
newtype Handler m a = Handler (Request -> m (Either ExtractError a))
derive instance Newtype (Handler m a) _
or ::
forall m a b r.
RequestHandler a m r =>
RequestHandler b m r =>
a ->
b ->
Handler m r
or a b = toHandler a <> toHandler b
instance Monad m => Semigroup (Handler m a) where
append (Handler a) (Handler b) = Handler \req ->
a req >>= case _ of
Left ExtractNext -> b req
a' -> pure a'
class MonadAff m <= RequestHandler a m b | a -> b m where
toHandler :: a -> Handler m b
invokeHandler :: a -> Request -> m (Either ExtractError b)
instance (MonadAff m) => RequestHandler (Handler m b) m b where
toHandler = identity
invokeHandler (Handler f) = f
else instance
( MonadAff m
, RequestHandler f m b
, RequestParts a
) =>
RequestHandler (a -> f) m b where
toHandler f = Handler $ invokeHandler f
invokeHandler f req = runExceptT do
a <- ExceptT $ liftAff $ extractRequestParts @a req
ExceptT $ invokeHandler (f a) req
else instance (MonadAff m) => RequestHandler (m a) m a where
toHandler m = Handler $ const $ m <#> Right
invokeHandler m _ = m <#> Right

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

@ -7,7 +7,16 @@ import Data.Maybe (Maybe(..))
import Data.Show.Generic (genericShow)
import Data.String as String
data Method = GET | POST | PUT | PATCH | DELETE | OPTIONS | TRACE | CONNECT | HEAD
data Method
= GET
| POST
| PUT
| PATCH
| DELETE
| OPTIONS
| TRACE
| CONNECT
| HEAD
derive instance Generic Method _
derive instance Eq Method

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

@ -1,8 +1,9 @@
module Axon.Request.Parts.Class
( class RequestParts
, class RequestHandler
, invokeHandler
, extractRequestParts
, Try(..)
, tryEither
, tryToEither
, ExtractError(..)
, module Parts.Header
, module Parts.Method
@ -21,30 +22,70 @@ import Axon.Request.Parts.Body (Json(..), Stream(..))
import Axon.Request.Parts.Body (Json(..), Stream(..)) as Parts.Body
import Axon.Request.Parts.Header (Header(..), HeaderMap(..))
import Axon.Request.Parts.Header (Header(..), HeaderMap(..)) as Parts.Header
import Axon.Request.Parts.Method (Connect(..), 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.Method
( Connect(..)
, 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 (class DiscardTupledUnits, class PathParts, Path(..), discardTupledUnits, extractPathParts)
import Axon.Request.Parts.Path
( class DiscardTupledUnits
, class PathParts
, Path(..)
, discardTupledUnits
, extractPathParts
)
import Control.Monad.Error.Class (liftEither, liftMaybe, throwError)
import Control.Monad.Except (ExceptT(..), runExceptT)
import Data.Argonaut.Decode (class DecodeJson, decodeJson)
import Data.Argonaut.Decode.Error (printJsonDecodeError)
import Data.Array as Array
import Data.Bifunctor (bimap, lmap)
import Data.Either (Either(..), note)
import Data.Either (Either(..), hush, note)
import Data.Generic.Rep (class Generic)
import Data.Map as Map
import Data.Maybe (Maybe)
import Data.Show.Generic (genericShow)
import Data.String.Lower as String.Lower
import Data.Tuple.Nested (type (/\), (/\))
import Data.URL as URL
import Effect.Aff (Aff)
import Effect.Aff.Class (class MonadAff, liftAff)
import Effect.Class (liftEffect)
import Node.Buffer (Buffer)
import Parsing (runParser)
import Parsing.String (parseErrorHuman)
data Try err ok = Err err | Ok ok
derive instance Generic (Try a b) _
derive instance (Eq a, Eq b) => Eq (Try a b)
instance (Show a, Show b) => Show (Try a b) where
show = genericShow
tryEither :: forall a b. Either a b -> Try a b
tryEither (Left a) = Err a
tryEither (Right b) = Ok b
tryToEither :: forall a b. Try a b -> Either a b
tryToEither (Err a) = Left a
tryToEither (Ok b) = Right b
data ExtractError
= ExtractError String
| ExtractNext
@ -52,7 +93,8 @@ data ExtractError
derive instance Generic ExtractError _
derive instance Eq ExtractError
instance Show ExtractError where show = genericShow
instance Show ExtractError where
show = genericShow
extractMethod ::
forall a.
@ -64,16 +106,6 @@ extractMethod a method r = runExceptT do
when (Request.method r /= method) $ throwError ExtractNext
pure a
class MonadAff m <= RequestHandler a m b | a -> b m where
invokeHandler :: Request -> a -> m (Either ExtractError b)
instance (MonadAff m, RequestHandler f m b, RequestParts a) => RequestHandler (a -> f) m b where
invokeHandler req f = runExceptT do
a <- ExceptT $ liftAff $ extractRequestParts @a req
ExceptT $ invokeHandler req (f a)
else instance (MonadAff m) => RequestHandler (m a) m a where
invokeHandler _ m = m <#> Right
class RequestParts a where
extractRequestParts :: Request -> Aff (Either ExtractError a)
@ -88,8 +120,19 @@ instance RequestParts String where
Request.bodyString r
<#> lmap (const $ ExtractBadRequest "Expected body to be valid UTF-8")
instance RequestParts (Either Request.BodyStringError String) where
extractRequestParts r = Request.bodyString r <#> Right
instance RequestParts (Try Request.BodyStringError String) where
extractRequestParts r = Request.bodyString r <#> tryEither <#> Right
instance (RequestParts a, RequestParts b) => RequestParts (Either a b) where
extractRequestParts r =
extractRequestParts @a r
>>=
case _ of
Right a' -> pure $ Right $ Left a'
_ -> extractRequestParts @b r <#> map Right
instance (RequestParts a) => RequestParts (Maybe a) where
extractRequestParts r = extractRequestParts @a r <#> hush <#> Right
instance TypedHeader a => RequestParts (Header a) where
extractRequestParts r = runExceptT do
@ -98,7 +141,12 @@ instance TypedHeader a => RequestParts (Header a) where
# Map.lookup (String.Lower.fromString $ headerName @a)
# liftMaybe ExtractNext
runParser value (headerValueParser @a)
# bimap (ExtractBadRequest <<< Array.intercalate "\n" <<< parseErrorHuman value 5) Header
# bimap
( ExtractBadRequest <<< Array.intercalate "\n" <<< parseErrorHuman
value
5
)
Header
# liftEither
instance RequestParts HeaderMap where
@ -112,7 +160,8 @@ instance (PathParts a b, DiscardTupledUnits b c) => RequestParts (Path a c) wher
URL.PathRelative a -> a
_ -> []
extract = extractPathParts @a @b (Request.url r)
ensureConsumed (leftover /\ x) = when (not $ Array.null leftover) (throwError ExtractNext) $> x
ensureConsumed (leftover /\ x) =
when (not $ Array.null leftover) (throwError ExtractNext) $> x
in
segments
# extract

2
src/Axon.Request.Parts.Header.purs
View File

@ -8,6 +8,7 @@ import Data.Newtype (class Newtype)
import Data.String.Lower (StringLower)
newtype Header a = Header a
derive instance Generic (Header a) _
derive instance Newtype (Header a) _
derive newtype instance (Eq a) => Eq (Header a)
@ -15,6 +16,7 @@ derive newtype instance (Ord a) => Ord (Header a)
derive newtype instance (Show a) => Show (Header a)
newtype HeaderMap = HeaderMap (Map StringLower String)
derive instance Generic HeaderMap _
derive instance Newtype HeaderMap _
derive newtype instance Eq HeaderMap

2
src/Axon.purs Normal file
View File

@ -0,0 +1,2 @@
module Axon where

94
src/Data.MIME.purs
View File

@ -6,7 +6,79 @@ import Data.Eq.Generic (genericEq)
import Data.Generic.Rep (class Generic)
import Data.Show.Generic (genericShow)
data MIME = Other String | Aac | Abw | Arc | Avif | Avi | Azw | Bin | Bmp | Bz | Bz2 | Cda | Csh | Css | Csv | Doc | Docx | Eot | Epub | Gz | Gif | Html | Ico | Ics | Jar | Jpeg | Js | Json | Jsonld | Midi | Mp3 | Mp4 | Mpeg | Mpkg | Odp | Ods | Odt | Oga | Ogv | Ogx | Opus | Otf | Png | Pdf | Php | Ppt | Pptx | Rar | Rtf | Sh | Svg | Tar | Tif | Ts | Ttf | Txt | Vsd | Wav | Weba | Webm | Webp | Woff | Woff2 | Xhtml | Xls | Xlsx | Xml | Xul | Zip | Video3gp | Video3g2 | Archive7z
data MIME
= Other String
| Aac
| Abw
| Arc
| Avif
| Avi
| Azw
| Bin
| Bmp
| Bz
| Bz2
| Cda
| Csh
| Css
| Csv
| Doc
| Docx
| Eot
| Epub
| Gz
| Gif
| Html
| Ico
| Ics
| Jar
| Jpeg
| Js
| Json
| Jsonld
| Midi
| Mp3
| Mp4
| Mpeg
| Mpkg
| Odp
| Ods
| Odt
| Oga
| Ogv
| Ogx
| Opus
| Otf
| Png
| Pdf
| Php
| Ppt
| Pptx
| Rar
| Rtf
| Sh
| Svg
| Tar
| Tif
| Ts
| Ttf
| Txt
| Vsd
| Wav
| Weba
| Webm
| Webp
| Woff
| Woff2
| Xhtml
| Xls
| Xlsx
| Xml
| Xul
| Zip
| Video3gp
| Video3g2
| Archive7z
derive instance Generic MIME _
instance Show MIME where
@ -32,7 +104,8 @@ toString Csh = "application/x-csh"
toString Css = "text/css"
toString Csv = "text/csv"
toString Doc = "application/msword"
toString Docx = "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
toString Docx =
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
toString Eot = "application/vnd.ms-fontobject"
toString Epub = "application/epub+zip"
toString Gz = "application/gzip"
@ -62,7 +135,8 @@ toString Png = "image/png"
toString Pdf = "application/pdf"
toString Php = "application/x-httpd-php"
toString Ppt = "application/vnd.ms-powerpoint"
toString Pptx = "application/vnd.openxmlformats-officedocument.presentationml.presentation"
toString Pptx =
"application/vnd.openxmlformats-officedocument.presentationml.presentation"
toString Rar = "application/vnd.rar"
toString Rtf = "application/rtf"
toString Sh = "application/x-sh"
@ -81,7 +155,8 @@ toString Woff = "font/woff"
toString Woff2 = "font/woff2"
toString Xhtml = "application/xhtml+xml"
toString Xls = "application/vnd.ms-excel"
toString Xlsx = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
toString Xlsx =
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
toString Xml = "application/xml"
toString Xul = "application/vnd.mozilla.xul+xml"
toString Zip = "application/zip"
@ -105,7 +180,9 @@ fromString "application/x-csh" = Csh
fromString "text/css" = Css
fromString "text/csv" = Csv
fromString "application/msword" = Doc
fromString "application/vnd.openxmlformats-officedocument.wordprocessingml.document" = Docx
fromString
"application/vnd.openxmlformats-officedocument.wordprocessingml.document" =
Docx
fromString "application/vnd.ms-fontobject" = Eot
fromString "application/epub+zip" = Epub
fromString "application/gzip" = Gz
@ -135,7 +212,9 @@ fromString "image/png" = Png
fromString "application/pdf" = Pdf
fromString "application/x-httpd-php" = Php
fromString "application/vnd.ms-powerpoint" = Ppt
fromString "application/vnd.openxmlformats-officedocument.presentationml.presentation" = Pptx
fromString
"application/vnd.openxmlformats-officedocument.presentationml.presentation" =
Pptx
fromString "application/vnd.rar" = Rar
fromString "application/rtf" = Rtf
fromString "application/x-sh" = Sh
@ -154,7 +233,8 @@ fromString "font/woff" = Woff
fromString "font/woff2" = Woff2
fromString "application/xhtml+xml" = Xhtml
fromString "application/vnd.ms-excel" = Xls
fromString "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" = Xlsx
fromString "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" =
Xlsx
fromString "application/xml" = Xml
fromString "application/vnd.mozilla.xul+xml" = Xul
fromString "application/zip" = Zip

282
src/Type.MIME.purs
View File

@ -12,710 +12,852 @@ class TypelevelMIME a where
value :: MIME.MIME
data Aac = Aac
derive instance Generic Aac _
derive instance Eq Aac
instance Show Aac where
show = genericShow
instance TypelevelMIME Aac where
fromValue MIME.Aac = Just Aac
fromValue _ = Nothing
value = MIME.Aac
data Abw = Abw
derive instance Generic Abw _
derive instance Eq Abw
instance Show Abw where
show = genericShow
instance TypelevelMIME Abw where
fromValue MIME.Abw = Just Abw
fromValue _ = Nothing
value = MIME.Abw
data Arc = Arc
derive instance Generic Arc _
derive instance Eq Arc
instance Show Arc where
show = genericShow
instance TypelevelMIME Arc where
fromValue MIME.Arc = Just Arc
fromValue _ = Nothing
value = MIME.Arc
data Avif = Avif
derive instance Generic Avif _
derive instance Eq Avif
instance Show Avif where
show = genericShow
instance TypelevelMIME Avif where
fromValue MIME.Avif = Just Avif
fromValue _ = Nothing
value = MIME.Avif
data Avi = Avi
derive instance Generic Avi _
derive instance Eq Avi
instance Show Avi where
show = genericShow
instance TypelevelMIME Avi where
fromValue MIME.Avi = Just Avi
fromValue _ = Nothing
value = MIME.Avi
data Azw = Azw
derive instance Generic Azw _
derive instance Eq Azw
instance Show Azw where
show = genericShow
instance TypelevelMIME Azw where
fromValue MIME.Azw = Just Azw
fromValue _ = Nothing
value = MIME.Azw
data Bin = Bin
derive instance Generic Bin _
derive instance Eq Bin
instance Show Bin where
show = genericShow
instance TypelevelMIME Bin where
fromValue MIME.Bin = Just Bin
fromValue _ = Nothing
value = MIME.Bin
data Bmp = Bmp
derive instance Generic Bmp _
derive instance Eq Bmp
instance Show Bmp where
show = genericShow
instance TypelevelMIME Bmp where
fromValue MIME.Bmp = Just Bmp
fromValue _ = Nothing
value = MIME.Bmp
data Bz = Bz
derive instance Generic Bz _
derive instance Eq Bz
instance Show Bz where
show = genericShow
instance TypelevelMIME Bz where
fromValue MIME.Bz = Just Bz
fromValue _ = Nothing
value = MIME.Bz
data Bz2 = Bz2
derive instance Generic Bz2 _
derive instance Eq Bz2
instance Show Bz2 where
show = genericShow
instance TypelevelMIME Bz2 where
fromValue MIME.Bz2 = Just Bz2
fromValue _ = Nothing
value = MIME.Bz2
data Cda = Cda
derive instance Generic Cda _
derive instance Eq Cda
instance Show Cda where
show = genericShow
instance TypelevelMIME Cda where
fromValue MIME.Cda = Just Cda
fromValue _ = Nothing
value = MIME.Cda
data Csh = Csh
derive instance Generic Csh _
derive instance Eq Csh
instance Show Csh where
show = genericShow
instance TypelevelMIME Csh where
fromValue MIME.Csh = Just Csh
fromValue _ = Nothing
value = MIME.Csh
data Css = Css
derive instance Generic Css _
derive instance Eq Css
instance Show Css where
show = genericShow
instance TypelevelMIME Css where
fromValue MIME.Css = Just Css
fromValue _ = Nothing
value = MIME.Css
data Csv = Csv
derive instance Generic Csv _
derive instance Eq Csv
instance Show Csv where
show = genericShow
instance TypelevelMIME Csv where
fromValue MIME.Csv = Just Csv
fromValue _ = Nothing
value = MIME.Csv
data Doc = Doc
derive instance Generic Doc _
derive instance Eq Doc
instance Show Doc where
show = genericShow
instance TypelevelMIME Doc where
fromValue MIME.Doc = Just Doc
fromValue _ = Nothing
value = MIME.Doc
data Docx = Docx
derive instance Generic Docx _
derive instance Eq Docx
instance Show Docx where
show = genericShow
instance TypelevelMIME Docx where
fromValue MIME.Docx = Just Docx
fromValue _ = Nothing
value = MIME.Docx
data Eot = Eot
derive instance Generic Eot _
derive instance Eq Eot
instance Show Eot where
show = genericShow
instance TypelevelMIME Eot where
fromValue MIME.Eot = Just Eot
fromValue _ = Nothing
value = MIME.Eot
data Epub = Epub
derive instance Generic Epub _
derive instance Eq Epub
instance Show Epub where
show = genericShow
instance TypelevelMIME Epub where
fromValue MIME.Epub = Just Epub
fromValue _ = Nothing
value = MIME.Epub
data Gz = Gz
derive instance Generic Gz _
derive instance Eq Gz
instance Show Gz where
show = genericShow
instance TypelevelMIME Gz where
fromValue MIME.Gz = Just Gz
fromValue _ = Nothing
value = MIME.Gz
data Gif = Gif
derive instance Generic Gif _
derive instance Eq Gif
instance Show Gif where
show = genericShow
instance TypelevelMIME Gif where
fromValue MIME.Gif = Just Gif
fromValue _ = Nothing
value = MIME.Gif
data Html = Html
derive instance Generic Html _
derive instance Eq Html
instance Show Html where
show = genericShow
instance TypelevelMIME Html where
fromValue MIME.Html = Just Html
fromValue _ = Nothing
value = MIME.Html
data Ico = Ico
derive instance Generic Ico _
derive instance Eq Ico
instance Show Ico where
show = genericShow
instance TypelevelMIME Ico where
fromValue MIME.Ico = Just Ico
fromValue _ = Nothing
value = MIME.Ico
data Ics = Ics
derive instance Generic Ics _
derive instance Eq Ics
instance Show Ics where
show = genericShow
instance TypelevelMIME Ics where
fromValue MIME.Ics = Just Ics
fromValue _ = Nothing
value = MIME.Ics
data Jar = Jar
derive instance Generic Jar _
derive instance Eq Jar
instance Show Jar where
show = genericShow
instance TypelevelMIME Jar where
fromValue MIME.Jar = Just Jar
fromValue _ = Nothing
value = MIME.Jar
data Jpeg = Jpeg
derive instance Generic Jpeg _
derive instance Eq Jpeg
instance Show Jpeg where
show = genericShow
instance TypelevelMIME Jpeg where
fromValue MIME.Jpeg = Just Jpeg
fromValue _ = Nothing
value = MIME.Jpeg
data Js = Js
derive instance Generic Js _
derive instance Eq Js
instance Show Js where
show = genericShow
instance TypelevelMIME Js where
fromValue MIME.Js = Just Js
fromValue _ = Nothing
value = MIME.Js
data Json = Json
derive instance Generic Json _
derive instance Eq Json
instance Show Json where
show = genericShow
instance TypelevelMIME Json where
fromValue MIME.Json = Just Json
fromValue _ = Nothing
value = MIME.Json
data Jsonld = Jsonld
derive instance Generic Jsonld _
derive instance Eq Jsonld
instance Show Jsonld where
show = genericShow
instance TypelevelMIME Jsonld where
fromValue MIME.Jsonld = Just Jsonld
fromValue _ = Nothing
value = MIME.Jsonld
data Midi = Midi
derive instance Generic Midi _
derive instance Eq Midi
instance Show Midi where
show = genericShow
instance TypelevelMIME Midi where
fromValue MIME.Midi = Just Midi
fromValue _ = Nothing
value = MIME.Midi
data Mp3 = Mp3
derive instance Generic Mp3 _
derive instance Eq Mp3
instance Show Mp3 where
show = genericShow
instance TypelevelMIME Mp3 where
fromValue MIME.Mp3 = Just Mp3
fromValue _ = Nothing
value = MIME.Mp3
data Mp4 = Mp4
derive instance Generic Mp4 _
derive instance Eq Mp4
instance Show Mp4 where
show = genericShow
instance TypelevelMIME Mp4 where
fromValue MIME.Mp4 = Just Mp4
fromValue _ = Nothing
value = MIME.Mp4
data Mpeg = Mpeg
derive instance Generic Mpeg _
derive instance Eq Mpeg
instance Show Mpeg where
show = genericShow
instance TypelevelMIME Mpeg where
fromValue MIME.Mpeg = Just Mpeg
fromValue _ = Nothing
value = MIME.Mpeg
data Mpkg = Mpkg
derive instance Generic Mpkg _
derive instance Eq Mpkg
instance Show Mpkg where
show = genericShow
instance TypelevelMIME Mpkg where
fromValue MIME.Mpkg = Just Mpkg
fromValue _ = Nothing
value = MIME.Mpkg
data Odp = Odp
derive instance Generic Odp _
derive instance Eq Odp
instance Show Odp where
show = genericShow
instance TypelevelMIME Odp where
fromValue MIME.Odp = Just Odp
fromValue _ = Nothing
value = MIME.Odp
data Ods = Ods
derive instance Generic Ods _
derive instance Eq Ods
instance Show Ods where
show = genericShow
instance TypelevelMIME Ods where
fromValue MIME.Ods = Just Ods
fromValue _ = Nothing
value = MIME.Ods
data Odt = Odt
derive instance Generic Odt _
derive instance Eq Odt
instance Show Odt where
show = genericShow
instance TypelevelMIME Odt where
fromValue MIME.Odt = Just Odt
fromValue _ = Nothing
value = MIME.Odt
data Oga = Oga
derive instance Generic Oga _
derive instance Eq Oga
instance Show Oga where
show = genericShow
instance TypelevelMIME Oga where
fromValue MIME.Oga = Just Oga
fromValue _ = Nothing
value = MIME.Oga
data Ogv = Ogv
derive instance Generic Ogv _
derive instance Eq Ogv
instance Show Ogv where
show = genericShow
instance TypelevelMIME Ogv where
fromValue MIME.Ogv = Just Ogv
fromValue _ = Nothing
value = MIME.Ogv
data Ogx = Ogx
derive instance Generic Ogx _
derive instance Eq Ogx
instance Show Ogx where
show = genericShow
instance TypelevelMIME Ogx where
fromValue MIME.Ogx = Just Ogx
fromValue _ = Nothing
value = MIME.Ogx
data Opus = Opus
derive instance Generic Opus _
derive instance Eq Opus
instance Show Opus where
show = genericShow
instance TypelevelMIME Opus where
fromValue MIME.Opus = Just Opus
fromValue _ = Nothing
value = MIME.Opus
data Otf = Otf
derive instance Generic Otf _
derive instance Eq Otf
instance Show Otf where
show = genericShow
instance TypelevelMIME Otf where
fromValue MIME.Otf = Just Otf
fromValue _ = Nothing
value = MIME.Otf
data Png = Png
derive instance Generic Png _
derive instance Eq Png
instance Show Png where
show = genericShow
instance TypelevelMIME Png where
fromValue MIME.Png = Just Png
fromValue _ = Nothing
value = MIME.Png
data Pdf = Pdf
derive instance Generic Pdf _
derive instance Eq Pdf
instance Show Pdf where
show = genericShow
instance TypelevelMIME Pdf where
fromValue MIME.Pdf = Just Pdf
fromValue _ = Nothing
value = MIME.Pdf
data Php = Php
derive instance Generic Php _
derive instance Eq Php
instance Show Php where
show = genericShow
instance TypelevelMIME Php where
fromValue MIME.Php = Just Php
fromValue _ = Nothing
value = MIME.Php
data Ppt = Ppt
derive instance Generic Ppt _
derive instance Eq Ppt
instance Show Ppt where
show = genericShow
instance TypelevelMIME Ppt where
fromValue MIME.Ppt = Just Ppt
fromValue _ = Nothing
value = MIME.Ppt
data Pptx = Pptx
derive instance Generic Pptx _
derive instance Eq Pptx
instance Show Pptx where
show = genericShow
instance TypelevelMIME Pptx where
fromValue MIME.Pptx = Just Pptx
fromValue _ = Nothing
value = MIME.Pptx
data Rar = Rar
derive instance Generic Rar _
derive instance Eq Rar
instance Show Rar where
show = genericShow
instance TypelevelMIME Rar where
fromValue MIME.Rar = Just Rar
fromValue _ = Nothing
value = MIME.Rar
data Rtf = Rtf
derive instance Generic Rtf _
derive instance Eq Rtf
instance Show Rtf where
show = genericShow
instance TypelevelMIME Rtf where
fromValue MIME.Rtf = Just Rtf
fromValue _ = Nothing
value = MIME.Rtf
data Sh = Sh
derive instance Generic Sh _
derive instance Eq Sh
instance Show Sh where
show = genericShow
instance TypelevelMIME Sh where
fromValue MIME.Sh = Just Sh
fromValue _ = Nothing
value = MIME.Sh
data Svg = Svg
derive instance Generic Svg _
derive instance Eq Svg
instance Show Svg where
show = genericShow
instance TypelevelMIME Svg where
fromValue MIME.Svg = Just Svg
fromValue _ = Nothing
value = MIME.Svg
data Tar = Tar
derive instance Generic Tar _
derive instance Eq Tar
instance Show Tar where
show = genericShow
instance TypelevelMIME Tar where
fromValue MIME.Tar = Just Tar
fromValue _ = Nothing
value = MIME.Tar
data Tif = Tif
derive instance Generic Tif _
derive instance Eq Tif
instance Show Tif where
show = genericShow
instance TypelevelMIME Tif where
fromValue MIME.Tif = Just Tif
fromValue _ = Nothing
value = MIME.Tif
data Ts = Ts
derive instance Generic Ts _
derive instance Eq Ts
instance Show Ts where
show = genericShow
instance TypelevelMIME Ts where
fromValue MIME.Ts = Just Ts
fromValue _ = Nothing
value = MIME.Ts
data Ttf = Ttf
derive instance Generic Ttf _
derive instance Eq Ttf
instance Show Ttf where
show = genericShow
instance TypelevelMIME Ttf where
fromValue MIME.Ttf = Just Ttf
fromValue _ = Nothing
value = MIME.Ttf
data Txt = Txt
derive instance Generic Txt _
derive instance Eq Txt
instance Show Txt where
show = genericShow
instance TypelevelMIME Txt where
fromValue MIME.Txt = Just Txt
fromValue _ = Nothing
value = MIME.Txt
data Vsd = Vsd
derive instance Generic Vsd _
derive instance Eq Vsd
instance Show Vsd where
show = genericShow
instance TypelevelMIME Vsd where
fromValue MIME.Vsd = Just Vsd
fromValue _ = Nothing
value = MIME.Vsd
data Wav = Wav
derive instance Generic Wav _
derive instance Eq Wav
instance Show Wav where
show = genericShow
instance TypelevelMIME Wav where
fromValue MIME.Wav = Just Wav
fromValue _ = Nothing
value = MIME.Wav
data Weba = Weba
derive instance Generic Weba _
derive instance Eq Weba
instance Show Weba where
show = genericShow
instance TypelevelMIME Weba where
fromValue MIME.Weba = Just Weba
fromValue _ = Nothing
value = MIME.Weba
data Webm = Webm
derive instance Generic Webm _
derive instance Eq Webm
instance Show Webm where
show = genericShow
instance TypelevelMIME Webm where
fromValue MIME.Webm = Just Webm
fromValue _ = Nothing
value = MIME.Webm
data Webp = Webp
derive instance Generic Webp _
derive instance Eq Webp
instance Show Webp where
show = genericShow
instance TypelevelMIME Webp where
fromValue MIME.Webp = Just Webp
fromValue _ = Nothing
value = MIME.Webp
data Woff = Woff
derive instance Generic Woff _
derive instance Eq Woff
instance Show Woff where
show = genericShow
instance TypelevelMIME Woff where
fromValue MIME.Woff = Just Woff
fromValue _ = Nothing
value = MIME.Woff
data Woff2 = Woff2
derive instance Generic Woff2 _
derive instance Eq Woff2
instance Show Woff2 where
show = genericShow
instance TypelevelMIME Woff2 where
fromValue MIME.Woff2 = Just Woff2
fromValue _ = Nothing
value = MIME.Woff2
data Xhtml = Xhtml
derive instance Generic Xhtml _
derive instance Eq Xhtml
instance Show Xhtml where
show = genericShow
instance TypelevelMIME Xhtml where
fromValue MIME.Xhtml = Just Xhtml
fromValue _ = Nothing
value = MIME.Xhtml
data Xls = Xls
derive instance Generic Xls _
derive instance Eq Xls
instance Show Xls where
show = genericShow
instance TypelevelMIME Xls where
fromValue MIME.Xls = Just Xls
fromValue _ = Nothing
value = MIME.Xls
data Xlsx = Xlsx
derive instance Generic Xlsx _
derive instance Eq Xlsx
instance Show Xlsx where
show = genericShow
instance TypelevelMIME Xlsx where
fromValue MIME.Xlsx = Just Xlsx
fromValue _ = Nothing
value = MIME.Xlsx
data Xml = Xml
derive instance Generic Xml _
derive instance Eq Xml
instance Show Xml where
show = genericShow
instance TypelevelMIME Xml where
fromValue MIME.Xml = Just Xml
fromValue _ = Nothing
value = MIME.Xml
data Xul = Xul
derive instance Generic Xul _
derive instance Eq Xul
instance Show Xul where
show = genericShow
instance TypelevelMIME Xul where
fromValue MIME.Xul = Just Xul
fromValue _ = Nothing
value = MIME.Xul
data Zip = Zip
derive instance Generic Zip _
derive instance Eq Zip
instance Show Zip where
show = genericShow
instance TypelevelMIME Zip where
fromValue MIME.Zip = Just Zip
fromValue _ = Nothing
value = MIME.Zip
data Video3gp = Video3gp
derive instance Generic Video3gp _
derive instance Eq Video3gp
instance Show Video3gp where
show = genericShow
instance TypelevelMIME Video3gp where
fromValue MIME.Video3gp = Just Video3gp
fromValue _ = Nothing
value = MIME.Video3gp
data Video3g2 = Video3g2
derive instance Generic Video3g2 _
derive instance Eq Video3g2
instance Show Video3g2 where
show = genericShow
instance TypelevelMIME Video3g2 where
fromValue MIME.Video3g2 = Just Video3g2
fromValue _ = Nothing
value = MIME.Video3g2
data Archive7z = Archive7z
derive instance Generic Archive7z _
derive instance Eq Archive7z
instance Show Archive7z where
show = genericShow
instance TypelevelMIME Archive7z where
fromValue MIME.Archive7z = Just Archive7z
fromValue _ = Nothing

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

@ -2,7 +2,43 @@ module Test.Axon.Header.Typed where
import Prelude
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.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 Control.Monad.Error.Class (liftEither)
import Data.Bifunctor (lmap)
@ -20,7 +56,8 @@ import Type.MIME as Type.MIME
is :: forall h. Eq h => Show h => TypedHeader h => String -> h -> Spec Unit
is i exp = it ("parses " <> show i) do
act <- runParser i (headerValueParser @h) # lmap (error <<< parseErrorMessage) # liftEither
act <- runParser i (headerValueParser @h) # lmap (error <<< parseErrorMessage)
# liftEither
act `shouldEqual` exp
isnt :: forall h. Eq h => Show h => TypedHeader h => String -> h -> Spec Unit
@ -38,7 +75,8 @@ spec =
describe "Accept MIME.MIME" do
"application/json" `is` (Accept MIME.Json)
"text/plain" `is` (Accept MIME.Txt)
"text/plain;charset=utf8" `is` (Accept $ MIME.Other "text/plain;charset=utf8")
"text/plain;charset=utf8" `is`
(Accept $ MIME.Other "text/plain;charset=utf8")
"foo" `is` (Accept $ MIME.Other "foo")
describe "Accept Aac" do
"unknown" `isnt` Accept Type.MIME.Aac
@ -87,7 +125,8 @@ spec =
"application/msword" `is` Accept Type.MIME.Doc
describe "Accept Docx" do
"unknown" `isnt` Accept Type.MIME.Docx
"application/vnd.openxmlformats-officedocument.wordprocessingml.document" `is` Accept Type.MIME.Docx
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
`is` Accept Type.MIME.Docx
describe "Accept Eot" do
"unknown" `isnt` Accept Type.MIME.Eot
"application/vnd.ms-fontobject" `is` Accept Type.MIME.Eot
@ -141,7 +180,8 @@ spec =
"application/vnd.apple.installer+xml" `is` Accept Type.MIME.Mpkg
describe "Accept Odp" do
"unknown" `isnt` Accept Type.MIME.Odp
"application/vnd.oasis.opendocument.presentation" `is` Accept Type.MIME.Odp
"application/vnd.oasis.opendocument.presentation" `is` Accept
Type.MIME.Odp
describe "Accept Ods" do
"unknown" `isnt` Accept Type.MIME.Ods
"application/vnd.oasis.opendocument.spreadsheet" `is` Accept Type.MIME.Ods
@ -177,7 +217,8 @@ spec =
"application/vnd.ms-powerpoint" `is` Accept Type.MIME.Ppt
describe "Accept Pptx" do
"unknown" `isnt` Accept Type.MIME.Pptx
"application/vnd.openxmlformats-officedocument.presentationml.presentation" `is` Accept Type.MIME.Pptx
"application/vnd.openxmlformats-officedocument.presentationml.presentation"
`is` Accept Type.MIME.Pptx
describe "Accept Rar" do
"unknown" `isnt` Accept Type.MIME.Rar
"application/vnd.rar" `is` Accept Type.MIME.Rar
@ -234,7 +275,8 @@ spec =
"application/vnd.ms-excel" `is` Accept Type.MIME.Xls
describe "Accept Xlsx" do
"unknown" `isnt` Accept Type.MIME.Xlsx
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" `is` Accept Type.MIME.Xlsx
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" `is`
Accept Type.MIME.Xlsx
describe "Accept Xml" do
"unknown" `isnt` Accept Type.MIME.Xml
"application/xml" `is` Accept Type.MIME.Xml
@ -259,7 +301,8 @@ spec =
describe "ContentType MIME.MIME" do
"application/json" `is` (ContentType MIME.Json)
"text/plain" `is` (ContentType MIME.Txt)
"text/plain;charset=utf8" `is` (ContentType $ MIME.Other "text/plain;charset=utf8")
"text/plain;charset=utf8" `is`
(ContentType $ MIME.Other "text/plain;charset=utf8")
"foo" `is` (ContentType $ MIME.Other "foo")
describe "ContentType Aac" do
"unknown" `isnt` ContentType Type.MIME.Aac
@ -308,7 +351,8 @@ spec =
"application/msword" `is` ContentType Type.MIME.Doc
describe "ContentType Docx" do
"unknown" `isnt` ContentType Type.MIME.Docx
"application/vnd.openxmlformats-officedocument.wordprocessingml.document" `is` ContentType Type.MIME.Docx
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
`is` ContentType Type.MIME.Docx
describe "ContentType Eot" do
"unknown" `isnt` ContentType Type.MIME.Eot
"application/vnd.ms-fontobject" `is` ContentType Type.MIME.Eot
@ -362,10 +406,12 @@ spec =
"application/vnd.apple.installer+xml" `is` ContentType Type.MIME.Mpkg
describe "ContentType Odp" do
"unknown" `isnt` ContentType Type.MIME.Odp
"application/vnd.oasis.opendocument.presentation" `is` ContentType Type.MIME.Odp
"application/vnd.oasis.opendocument.presentation" `is` ContentType
Type.MIME.Odp
describe "ContentType Ods" do
"unknown" `isnt` ContentType Type.MIME.Ods
"application/vnd.oasis.opendocument.spreadsheet" `is` ContentType Type.MIME.Ods
"application/vnd.oasis.opendocument.spreadsheet" `is` ContentType
Type.MIME.Ods
describe "ContentType Odt" do
"unknown" `isnt` ContentType Type.MIME.Odt
"application/vnd.oasis.opendocument.text" `is` ContentType Type.MIME.Odt
@ -398,7 +444,8 @@ spec =
"application/vnd.ms-powerpoint" `is` ContentType Type.MIME.Ppt
describe "ContentType Pptx" do
"unknown" `isnt` ContentType Type.MIME.Pptx
"application/vnd.openxmlformats-officedocument.presentationml.presentation" `is` ContentType Type.MIME.Pptx
"application/vnd.openxmlformats-officedocument.presentationml.presentation"
`is` ContentType Type.MIME.Pptx
describe "ContentType Rar" do
"unknown" `isnt` ContentType Type.MIME.Rar
"application/vnd.rar" `is` ContentType Type.MIME.Rar
@ -455,7 +502,8 @@ spec =
"application/vnd.ms-excel" `is` ContentType Type.MIME.Xls
describe "ContentType Xlsx" do
"unknown" `isnt` ContentType Type.MIME.Xlsx
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" `is` ContentType Type.MIME.Xlsx
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet" `is`
ContentType Type.MIME.Xlsx
describe "ContentType Xml" do
"unknown" `isnt` ContentType Type.MIME.Xml
"application/xml" `is` ContentType Type.MIME.Xml
@ -482,43 +530,65 @@ spec =
"*" `is` AccessControlAllowHeaders (Left Wildcard)
" * " `is` AccessControlAllowHeaders (Left Wildcard)
"* " `is` AccessControlAllowHeaders (Left Wildcard)
"Vary" `is` AccessControlAllowHeaders (Right $ pure $ String.Lower.fromString "Vary")
" Vary" `isnt` 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)
"Vary" `is` AccessControlAllowHeaders
(Right $ pure $ String.Lower.fromString "Vary")
" Vary" `isnt` 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
)
describe "AccessControlAllowMethods" do
"*" `is` AccessControlAllowMethods (Left Wildcard)
" * " `is` AccessControlAllowMethods (Left Wildcard)
"* " `is` AccessControlAllowMethods (Left Wildcard)
"GET" `is` AccessControlAllowMethods (Right $ pure GET)
"get" `isnt` AccessControlAllowMethods (Right $ pure GET)
"GET,,,,,, PATCH" `is` AccessControlAllowMethods (Right $ pure GET <> pure PATCH)
" GET , PATCH " `isnt` 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
"*" `is` AccessControlAllowOrigin (Left Wildcard)
" * " `is` AccessControlAllowOrigin (Left Wildcard)
"* " `is` AccessControlAllowOrigin (Left Wildcard)
"foo" `is` AccessControlAllowOrigin (Right "foo")
" foo " `is` AccessControlAllowOrigin (Right "foo")
"https://example.com" `is` AccessControlAllowOrigin (Right "https://example.com")
"https://example.com" `is` AccessControlAllowOrigin
(Right "https://example.com")
describe "AccessControlExposeHeaders" do
"*" `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")
"Accept, Vary, Content-Type" `is` AccessControlExposeHeaders (Right $ (pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString)
"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
)
describe "AccessControlMaxAge" do
" 123 " `is` AccessControlMaxAge 123
" 0" `is` AccessControlMaxAge 0
"23190" `is` AccessControlMaxAge 23190
describe "AccessControlRequestHeaders" do
"Vary" `is` AccessControlRequestHeaders (pure $ String.Lower.fromString "Vary")
" Vary" `is` AccessControlRequestHeaders (pure $ String.Lower.fromString "Vary")
" Vary " `is` AccessControlRequestHeaders (pure $ String.Lower.fromString "Vary")
"Accept, Vary, Content-Type" `is` AccessControlRequestHeaders ((pure "Accept" <> pure "Vary" <> pure "Content-Type") <#> String.Lower.fromString)
"Vary" `is` AccessControlRequestHeaders
(pure $ String.Lower.fromString "Vary")
" Vary" `is` AccessControlRequestHeaders
(pure $ String.Lower.fromString "Vary")
" Vary " `is` AccessControlRequestHeaders
(pure $ String.Lower.fromString "Vary")
"Accept, Vary, Content-Type" `is` AccessControlRequestHeaders
( (pure "Accept" <> pure "Vary" <> pure "Content-Type") <#>
String.Lower.fromString
)
describe "AccessControlRequestMethod" do
"GET" `is` AccessControlRequestMethod GET
" PATCH " `isnt` AccessControlRequestMethod PATCH
@ -542,21 +612,43 @@ spec =
" Bing bar " `isnt` Authorization (AuthScheme "Bing") "bar"
"Bar" `is` Authorization (AuthScheme "Bar") ""
describe "BasicAuth" do
"Basic ZGVtbzpwQDU1dzByZA==" `is` BasicAuth {username: "demo", password: "p@55w0rd"}
"Bearer ZGVtbzpwQDU1dzByZA==" `isnt` BasicAuth {username: "demo", password: "p@55w0rd"}
"Basic foo" `isnt` BasicAuth {username: "demo", password: "p@55w0rd"}
"Basic ZGVtbzpwQDU1dzByZA==" `is` BasicAuth
{ username: "demo", password: "p@55w0rd" }
"Bearer ZGVtbzpwQDU1dzByZA==" `isnt` BasicAuth
{ username: "demo", password: "p@55w0rd" }
"Basic foo" `isnt` BasicAuth { username: "demo", password: "p@55w0rd" }
describe "BearerAuth" do
"Bearer foo" `is` BearerAuth "foo"
"Basic foo" `isnt` BearerAuth "foo"
"Bearer foo " `is` BearerAuth "foo"
describe "CacheControl" do
"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" `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=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`
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
}
)
"" `is` CacheControl cacheControlDefaults
" " `isnt` CacheControl cacheControlDefaults
"foo=bar" `is` CacheControl cacheControlDefaults
@ -569,25 +661,53 @@ spec =
"close" `is` Connection (Left ConnectionClose)
" close " `is` Connection (Left ConnectionClose)
" cLoSe " `is` Connection (Left ConnectionClose)
"fuaiowf" `is` Connection (Right $ pure $ String.Lower.fromString "fuaiowf")
" a , b , c,d" `is` Connection (Right $ String.Lower.fromString <$> (pure "a" <> pure "b" <> pure "c" <> pure "d"))
"fuaiowf" `is` Connection
(Right $ pure $ String.Lower.fromString "fuaiowf")
" a , b , c,d" `is` Connection
( Right $ String.Lower.fromString <$>
(pure "a" <> pure "b" <> pure "c" <> pure "d")
)
describe "ContentDisposition" do
"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; filename=\"foo.txt\"" `is` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Just "foo.txt", name: Nothing})
" form-data; filename=\"foo.txt\" ; name=\"foo\" " `isnt` ContentDisposition (Either.Nested.in3 $ ContentDispositionFormData {filename: Just "foo.txt", name: Just "foo"})
"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; filename=\"foo.txt\"" `is` ContentDisposition
( Either.Nested.in3 $ ContentDispositionFormData
{ filename: Just "foo.txt", name: Nothing }
)
" 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; 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"})
"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\" " `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)
"inline " `is` ContentDisposition
(Either.Nested.in1 $ ContentDispositionInline)
" inline " `is` ContentDisposition
(Either.Nested.in1 $ ContentDispositionInline)
describe "ContentEncoding" do
"gzip" `is` ContentEncoding (pure "gzip")
" gzip " `is` ContentEncoding (pure "gzip")
" gzip , deflate " `is` ContentEncoding (pure "gzip" <> pure "deflate")
" gzip , deflate " `is` ContentEncoding
(pure "gzip" <> pure "deflate")
describe "ContentLength" do
" 0 " `is` ContentLength 0
" 1 " `is` ContentLength 1
@ -598,18 +718,31 @@ spec =
" 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 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)
" 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"))
"foo=bar; baz=quux" `is` Cookie
(pure ("foo" /\ "bar") <> pure ("baz" /\ "quux"))
describe "Date" $ pure unit
describe "ETag" $ pure unit
describe "ExpectContinue" $ pure unit
@ -637,4 +770,4 @@ spec =
describe "TransferEncoding" $ pure unit
describe "Upgrade" $ pure unit
describe "UserAgent" $ pure unit
describe "Vary"$ pure unit
describe "Vary" $ pure unit

74
test/Test/Axon.Request.Handler.purs Normal file
View File

@ -0,0 +1,74 @@
module Test.Axon.Request.Handler where
import Axon.Request.Parts.Class
import Prelude
import Axon.Request (Body)
import Axon.Request as Request
import Axon.Request.Handler as Handle
import Axon.Request.Handler.Default (notFound)
import Axon.Request.Method (Method(..))
import Axon.Request.Parts.Path (type (/))
import Axon.Response (Response)
import Axon.Response as Response
import Axon.Response.Body as Response.Body
import Control.Monad.Error.Class (liftEither)
import Data.Bifunctor (lmap)
import Data.Either (Either(..))
import Data.Map (Map)
import Data.Map as Map
import Data.Maybe (fromJust)
import Data.URL (URL)
import Data.URL as URL
import Effect.Aff (Aff, error)
import Effect.Class (liftEffect)
import Effect.Unsafe (unsafePerformEffect)
import Node.Net.SocketAddress as SocketAddress
import Node.Net.Types (IPv4, IPv6, SocketAddress)
import Partial.Unsafe (unsafePartial)
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual)
defaultRequest ::
{ headers :: Map String String
, address :: Either (SocketAddress IPv4) (SocketAddress IPv6)
, url :: URL
, method :: Method
, body :: Body
}
defaultRequest =
{ body: Request.BodyEmpty
, url: URL.fromString "http://localhost:80/" # unsafePartial fromJust
, headers: Map.singleton "content-type" "application/json"
, address: Left $ unsafePerformEffect $ SocketAddress.newIpv4
{ address: "127.0.0.1", port: 81 }
, method: GET
}
getPerson :: Get -> Path ("people" / Int) Int -> Aff Response
getPerson _ (Path id) =
if id == 1 then
pure $ Response.response 200
(Response.Body.stringBody "{\"name\": \"Henry\"}")
Map.empty
else
pure $ Response.fromStatus 404
spec :: Spec Unit
spec = describe "Handler" do
it "responds ok" do
req <- liftEffect $ Request.make $ defaultRequest
{ url = defaultRequest.url `URL.(/)` "people" `URL.(/)` "1" }
rep <- Handle.invokeHandler (getPerson `Handle.or` notFound) req
<#> lmap (error <<< show)
>>= liftEither
Response.status rep `shouldEqual` 200
it "responds not found" do
req <- liftEffect $ Request.make $ defaultRequest
{ url = defaultRequest.url `URL.(/)` "people" `URL.(/)` "1"
, method = PUT
}
rep <- Handle.invokeHandler (getPerson `Handle.or` notFound) req
<#> lmap (error <<< show)
>>= liftEither
Response.status rep `shouldEqual` 404

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

@ -5,8 +5,18 @@ import Prelude
import Axon.Header.Typed (ContentType)
import Axon.Request (Request)
import Axon.Request as Request
import Axon.Request.Handler (invokeHandler)
import Axon.Request.Method (Method(..))
import Axon.Request.Parts.Class (ExtractError(..), Header, Json(..), Patch, Path(..), Post(..), extractRequestParts, invokeHandler)
import Axon.Request.Parts.Class
( ExtractError(..)
, Header
, Json(..)
, Patch
, Path(..)
, Post(..)
, Try(..)
, extractRequestParts
)
import Axon.Request.Parts.Path (type (/), IgnoreRest)
import Control.Monad.Error.Class (liftEither)
import Data.Bifunctor (lmap)
@ -39,7 +49,8 @@ spec = describe "Parts" do
{ address: "127.0.0.1", port: 81 }
, method: GET
}
_ :: Request <- invokeHandler req (pure @Aff) <#> lmap (error <<< show) >>= liftEither
_ :: Request <- invokeHandler (pure @Aff) req <#> lmap (error <<< show) >>=
liftEither
pure unit
it "extracts header, method, path, JSON body" do
@ -63,12 +74,12 @@ spec = describe "Parts" do
Path ("users" / Int) Int ->
Json { firstName :: String } ->
Aff String
handler _ _ (Path id) (Json {firstName}) = do
handler _ _ (Path id) (Json { firstName }) = do
id `shouldEqual` 12
firstName `shouldEqual` "henry"
pure firstName
name <- invokeHandler req handler
name <- invokeHandler handler req
<#> lmap (error <<< show)
>>= liftEither
@ -171,10 +182,10 @@ spec = describe "Parts" do
{ address: "127.0.0.1", port: 81 }
, method: GET
}
a <- extractRequestParts @(Either Request.BodyStringError String) req
a <- extractRequestParts @(Try Request.BodyStringError String) req
<#> lmap (error <<< show)
>>= liftEither
a `shouldEqual` (Right "foo")
a `shouldEqual` (Ok "foo")
it "extracts a string body from a readable stream" do
stream <- Buffer.fromString "foo" UTF8 >>= Stream.readableFromBuffer #
@ -187,10 +198,10 @@ spec = describe "Parts" do
{ address: "127.0.0.1", port: 81 }
, method: GET
}
a <- extractRequestParts @(Either Request.BodyStringError String) req
a <- extractRequestParts @(Try Request.BodyStringError String) req
<#> lmap (error <<< show)
>>= liftEither
a `shouldEqual` (Right "foo")
a `shouldEqual` (Ok "foo")
a' <- extractRequestParts @String req <#> lmap (error <<< show)
>>= liftEither
@ -206,10 +217,10 @@ spec = describe "Parts" do
{ address: "127.0.0.1", port: 81 }
, method: GET
}
a <- extractRequestParts @(Either Request.BodyStringError String) req
a <- extractRequestParts @(Try Request.BodyStringError String) req
<#> lmap (error <<< show)
>>= liftEither
a `shouldEqual` (Right "foo")
a `shouldEqual` (Ok "foo")
a' <- extractRequestParts @String req <#> lmap (error <<< show)
>>= liftEither

2
test/Test/Axon.Request.purs
View File

@ -3,8 +3,10 @@ module Test.Axon.Request where
import Prelude
import Test.Axon.Request.Parts as Parts
import Test.Axon.Request.Handler as Handler
import Test.Spec (Spec, describe)
spec :: Spec Unit
spec = describe "Request" do
Parts.spec
Handler.spec