module WebGear.Core.Trait.Header (
RequestHeader (..),
HeaderNotFound (..),
HeaderParseError (..),
RequiredRequestHeader,
OptionalRequestHeader,
ResponseHeader (..),
RequiredResponseHeader,
OptionalResponseHeader,
header,
optionalHeader,
lenientHeader,
optionalLenientHeader,
setHeader,
setOptionalHeader,
) where
import Control.Arrow (ArrowChoice, arr)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Void (Void, absurd)
import GHC.TypeLits (Symbol)
import WebGear.Core.Handler (Middleware)
import WebGear.Core.Modifiers (Existence (..), ParseStyle (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (
Get (..),
Set,
Trait (..),
TraitAbsence (..),
With,
plant,
probe,
)
data =
deriving stock (ReadPrec [HeaderNotFound]
ReadPrec HeaderNotFound
Int -> ReadS HeaderNotFound
ReadS [HeaderNotFound]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderNotFound]
$creadListPrec :: ReadPrec [HeaderNotFound]
readPrec :: ReadPrec HeaderNotFound
$creadPrec :: ReadPrec HeaderNotFound
readList :: ReadS [HeaderNotFound]
$creadList :: ReadS [HeaderNotFound]
readsPrec :: Int -> ReadS HeaderNotFound
$creadsPrec :: Int -> ReadS HeaderNotFound
Read, Int -> HeaderNotFound -> ShowS
[HeaderNotFound] -> ShowS
HeaderNotFound -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderNotFound] -> ShowS
$cshowList :: [HeaderNotFound] -> ShowS
show :: HeaderNotFound -> String
$cshow :: HeaderNotFound -> String
showsPrec :: Int -> HeaderNotFound -> ShowS
$cshowsPrec :: Int -> HeaderNotFound -> ShowS
Show, HeaderNotFound -> HeaderNotFound -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderNotFound -> HeaderNotFound -> Bool
$c/= :: HeaderNotFound -> HeaderNotFound -> Bool
== :: HeaderNotFound -> HeaderNotFound -> Bool
$c== :: HeaderNotFound -> HeaderNotFound -> Bool
Eq)
newtype = Text
deriving stock (ReadPrec [HeaderParseError]
ReadPrec HeaderParseError
Int -> ReadS HeaderParseError
ReadS [HeaderParseError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderParseError]
$creadListPrec :: ReadPrec [HeaderParseError]
readPrec :: ReadPrec HeaderParseError
$creadPrec :: ReadPrec HeaderParseError
readList :: ReadS [HeaderParseError]
$creadList :: ReadS [HeaderParseError]
readsPrec :: Int -> ReadS HeaderParseError
$creadsPrec :: Int -> ReadS HeaderParseError
Read, Int -> HeaderParseError -> ShowS
[HeaderParseError] -> ShowS
HeaderParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderParseError] -> ShowS
$cshowList :: [HeaderParseError] -> ShowS
show :: HeaderParseError -> String
$cshow :: HeaderParseError -> String
showsPrec :: Int -> HeaderParseError -> ShowS
$cshowsPrec :: Int -> HeaderParseError -> ShowS
Show, HeaderParseError -> HeaderParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderParseError -> HeaderParseError -> Bool
$c/= :: HeaderParseError -> HeaderParseError -> Bool
== :: HeaderParseError -> HeaderParseError -> Bool
$c== :: HeaderParseError -> HeaderParseError -> Bool
Eq)
data (e :: Existence) (p :: ParseStyle) (name :: Symbol) (val :: Type) =
type = RequestHeader Required Strict
type = RequestHeader Optional Strict
instance Trait (RequestHeader Required Strict name val) Request where
type Attribute (RequestHeader Required Strict name val) Request = val
instance TraitAbsence (RequestHeader Required Strict name val) Request where
type Absence (RequestHeader Required Strict name val) Request = Either HeaderNotFound HeaderParseError
instance Trait (RequestHeader Optional Strict name val) Request where
type Attribute (RequestHeader Optional Strict name val) Request = Maybe val
instance TraitAbsence (RequestHeader Optional Strict name val) Request where
type Absence (RequestHeader Optional Strict name val) Request = HeaderParseError
instance Trait (RequestHeader Required Lenient name val) Request where
type Attribute (RequestHeader Required Lenient name val) Request = Either Text val
instance TraitAbsence (RequestHeader Required Lenient name val) Request where
type Absence (RequestHeader Required Lenient name val) Request = HeaderNotFound
instance Trait (RequestHeader Optional Lenient name val) Request where
type Attribute (RequestHeader Optional Lenient name val) Request = Maybe (Either Text val)
instance TraitAbsence (RequestHeader Optional Lenient name val) Request where
type Absence (RequestHeader Optional Lenient name val) Request = Void
headerHandler ::
forall name val e p h ts.
(Get h (RequestHeader e p name val) Request, ArrowChoice h) =>
h (Request `With` ts, Absence (RequestHeader e p name val) Request) Response ->
Middleware h ts (RequestHeader e p name val : ts)
headerHandler :: forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (RequestHeader e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
-> Middleware h ts (RequestHeader e p name val : ts)
headerHandler h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
errorHandler RequestHandler h (RequestHeader e p name val : ts)
nextHandler = proc With Request ts
request -> do
Either
(Absence (RequestHeader e p name val) Request)
(With Request (RequestHeader e p name val : ts))
result <- forall t (ts :: [*]) (h :: * -> * -> *) a.
Get h t a =>
t -> h (With a ts) (Either (Absence t a) (With a (t : ts)))
probe forall (e :: Existence) (p :: ParseStyle) (name :: Symbol) val.
RequestHeader e p name val
RequestHeader -< With Request ts
request
case Either
(Absence (RequestHeader e p name val) Request)
(With Request (RequestHeader e p name val : ts))
result of
Left Absence (RequestHeader e p name val) Request
err -> h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
errorHandler -< (With Request ts
request, Absence (RequestHeader e p name val) Request
err)
Right With Request (RequestHeader e p name val : ts)
val -> RequestHandler h (RequestHeader e p name val : ts)
nextHandler -< With Request (RequestHeader e p name val : ts)
val
{-# INLINE headerHandler #-}
header ::
forall name val h ts.
(Get h (RequestHeader Required Strict name val) Request, ArrowChoice h) =>
h (Request `With` ts, Either HeaderNotFound HeaderParseError) Response ->
Middleware h ts (RequestHeader Required Strict name val : ts)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (RequestHeader e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
-> Middleware h ts (RequestHeader e p name val : ts)
headerHandler
{-# INLINE header #-}
optionalHeader ::
forall name val h ts.
(Get h (RequestHeader Optional Strict name val) Request, ArrowChoice h) =>
h (Request `With` ts, HeaderParseError) Response ->
Middleware h ts (RequestHeader Optional Strict name val : ts)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (RequestHeader e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
-> Middleware h ts (RequestHeader e p name val : ts)
headerHandler
{-# INLINE optionalHeader #-}
lenientHeader ::
forall name val h ts.
(Get h (RequestHeader Required Lenient name val) Request, ArrowChoice h) =>
h (Request `With` ts, HeaderNotFound) Response ->
Middleware h ts (RequestHeader Required Lenient name val : ts)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (RequestHeader e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
-> Middleware h ts (RequestHeader e p name val : ts)
headerHandler
{-# INLINE lenientHeader #-}
optionalLenientHeader ::
forall name val h ts.
(Get h (RequestHeader Optional Lenient name val) Request, ArrowChoice h) =>
Middleware h ts (RequestHeader Optional Lenient name val : ts)
= forall (name :: Symbol) val (e :: Existence) (p :: ParseStyle)
(h :: * -> * -> *) (ts :: [*]).
(Get h (RequestHeader e p name val) Request, ArrowChoice h) =>
h (With Request ts, Absence (RequestHeader e p name val) Request)
Response
-> Middleware h ts (RequestHeader e p name val : ts)
headerHandler forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (forall a. Void -> a
absurd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
{-# INLINE optionalLenientHeader #-}
data (e :: Existence) (name :: Symbol) (val :: Type) =
type = ResponseHeader Required
type = ResponseHeader Optional
instance Trait (ResponseHeader Required name val) Response where
type Attribute (ResponseHeader Required name val) Response = val
instance Trait (ResponseHeader Optional name val) Response where
type Attribute (ResponseHeader Optional name val) Response = Maybe val
setHeader ::
forall name val h ts.
(Set h (ResponseHeader Required name val) Response) =>
h (Response `With` ts, val) (Response `With` (ResponseHeader Required name val : ts))
= forall t (ts :: [*]) (h :: * -> * -> *) a.
Set h t a =>
t -> h (With a ts, Attribute t a) (With a (t : ts))
plant forall (e :: Existence) (name :: Symbol) val.
ResponseHeader e name val
ResponseHeader
{-# INLINE setHeader #-}
setOptionalHeader ::
forall name val h ts.
(Set h (ResponseHeader Optional name val) Response) =>
h (Response `With` ts, Maybe val) (Response `With` (ResponseHeader Optional name val : ts))
= forall t (ts :: [*]) (h :: * -> * -> *) a.
Set h t a =>
t -> h (With a ts, Attribute t a) (With a (t : ts))
plant forall (e :: Existence) (name :: Symbol) val.
ResponseHeader e name val
ResponseHeader
{-# INLINE setOptionalHeader #-}