module WebGear.Trait.Header
( Header
, HeaderFail (..)
, HeaderMatch
, HeaderMismatch (..)
) where
import Data.ByteString (ByteString)
import Data.Kind (Type)
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import Data.Text (Text)
import GHC.TypeLits (KnownSymbol, Symbol, symbolVal)
import Web.HttpApiData (FromHttpApiData (..))
import WebGear.Trait (CheckResult (..), Trait (..))
import WebGear.Types (Request, requestHeader)
data (s :: Symbol) (t :: Type)
data = | Text
deriving stock (ReadPrec [HeaderFail]
ReadPrec HeaderFail
Int -> ReadS HeaderFail
ReadS [HeaderFail]
(Int -> ReadS HeaderFail)
-> ReadS [HeaderFail]
-> ReadPrec HeaderFail
-> ReadPrec [HeaderFail]
-> Read HeaderFail
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderFail]
$creadListPrec :: ReadPrec [HeaderFail]
readPrec :: ReadPrec HeaderFail
$creadPrec :: ReadPrec HeaderFail
readList :: ReadS [HeaderFail]
$creadList :: ReadS [HeaderFail]
readsPrec :: Int -> ReadS HeaderFail
$creadsPrec :: Int -> ReadS HeaderFail
Read, Int -> HeaderFail -> ShowS
[HeaderFail] -> ShowS
HeaderFail -> String
(Int -> HeaderFail -> ShowS)
-> (HeaderFail -> String)
-> ([HeaderFail] -> ShowS)
-> Show HeaderFail
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderFail] -> ShowS
$cshowList :: [HeaderFail] -> ShowS
show :: HeaderFail -> String
$cshow :: HeaderFail -> String
showsPrec :: Int -> HeaderFail -> ShowS
$cshowsPrec :: Int -> HeaderFail -> ShowS
Show, HeaderFail -> HeaderFail -> Bool
(HeaderFail -> HeaderFail -> Bool)
-> (HeaderFail -> HeaderFail -> Bool) -> Eq HeaderFail
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderFail -> HeaderFail -> Bool
$c/= :: HeaderFail -> HeaderFail -> Bool
== :: HeaderFail -> HeaderFail -> Bool
$c== :: HeaderFail -> HeaderFail -> Bool
Eq)
instance (KnownSymbol s, FromHttpApiData t, Monad m) => Trait (Header s t) Request m where
type Val (Header s t) Request = t
type Fail (Header s t) Request = HeaderFail
check :: Request -> m (CheckResult (Header s t) Request)
check :: Request -> m (CheckResult (Header s t) Request)
check r :: Request
r = CheckResult (Header s t) Request
-> m (CheckResult (Header s t) Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckResult (Header s t) Request
-> m (CheckResult (Header s t) Request))
-> CheckResult (Header s t) Request
-> m (CheckResult (Header s t) Request)
forall a b. (a -> b) -> a -> b
$
let s :: HeaderName
s = String -> HeaderName
forall a. IsString a => String -> a
fromString (String -> HeaderName) -> String -> HeaderName
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
in case ByteString -> Either Text t
forall a. FromHttpApiData a => ByteString -> Either Text a
parseHeader (ByteString -> Either Text t)
-> Maybe ByteString -> Maybe (Either Text t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeaderName -> Request -> Maybe ByteString
requestHeader HeaderName
s Request
r of
Nothing -> Fail (Header s t) Request -> CheckResult (Header s t) Request
forall k (t :: k) a. Fail t a -> CheckResult t a
CheckFail Fail (Header s t) Request
HeaderFail
HeaderNotFound
Just (Left e :: Text
e) -> Fail (Header s t) Request -> CheckResult (Header s t) Request
forall k (t :: k) a. Fail t a -> CheckResult t a
CheckFail (Fail (Header s t) Request -> CheckResult (Header s t) Request)
-> Fail (Header s t) Request -> CheckResult (Header s t) Request
forall a b. (a -> b) -> a -> b
$ Text -> HeaderFail
HeaderParseError Text
e
Just (Right x :: t
x) -> Request
-> Val (Header s t) Request -> CheckResult (Header s t) Request
forall k (t :: k) a. a -> Val t a -> CheckResult t a
CheckSuccess Request
r t
Val (Header s t) Request
x
data (s :: Symbol) (t :: Symbol)
data =
{ :: ByteString
, :: Maybe ByteString
}
deriving stock (HeaderMismatch -> HeaderMismatch -> Bool
(HeaderMismatch -> HeaderMismatch -> Bool)
-> (HeaderMismatch -> HeaderMismatch -> Bool) -> Eq HeaderMismatch
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HeaderMismatch -> HeaderMismatch -> Bool
$c/= :: HeaderMismatch -> HeaderMismatch -> Bool
== :: HeaderMismatch -> HeaderMismatch -> Bool
$c== :: HeaderMismatch -> HeaderMismatch -> Bool
Eq, ReadPrec [HeaderMismatch]
ReadPrec HeaderMismatch
Int -> ReadS HeaderMismatch
ReadS [HeaderMismatch]
(Int -> ReadS HeaderMismatch)
-> ReadS [HeaderMismatch]
-> ReadPrec HeaderMismatch
-> ReadPrec [HeaderMismatch]
-> Read HeaderMismatch
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [HeaderMismatch]
$creadListPrec :: ReadPrec [HeaderMismatch]
readPrec :: ReadPrec HeaderMismatch
$creadPrec :: ReadPrec HeaderMismatch
readList :: ReadS [HeaderMismatch]
$creadList :: ReadS [HeaderMismatch]
readsPrec :: Int -> ReadS HeaderMismatch
$creadsPrec :: Int -> ReadS HeaderMismatch
Read, Int -> HeaderMismatch -> ShowS
[HeaderMismatch] -> ShowS
HeaderMismatch -> String
(Int -> HeaderMismatch -> ShowS)
-> (HeaderMismatch -> String)
-> ([HeaderMismatch] -> ShowS)
-> Show HeaderMismatch
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HeaderMismatch] -> ShowS
$cshowList :: [HeaderMismatch] -> ShowS
show :: HeaderMismatch -> String
$cshow :: HeaderMismatch -> String
showsPrec :: Int -> HeaderMismatch -> ShowS
$cshowsPrec :: Int -> HeaderMismatch -> ShowS
Show)
instance (KnownSymbol s, KnownSymbol t, Monad m) => Trait (HeaderMatch s t) Request m where
type Val (HeaderMatch s t) Request = ByteString
type Fail (HeaderMatch s t) Request = HeaderMismatch
check :: Request -> m (CheckResult (HeaderMatch s t) Request)
check :: Request -> m (CheckResult (HeaderMatch s t) Request)
check r :: Request
r = CheckResult (HeaderMatch s t) Request
-> m (CheckResult (HeaderMatch s t) Request)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (CheckResult (HeaderMatch s t) Request
-> m (CheckResult (HeaderMatch s t) Request))
-> CheckResult (HeaderMatch s t) Request
-> m (CheckResult (HeaderMatch s t) Request)
forall a b. (a -> b) -> a -> b
$
let
name :: HeaderName
name = String -> HeaderName
forall a. IsString a => String -> a
fromString (String -> HeaderName) -> String -> HeaderName
forall a b. (a -> b) -> a -> b
$ Proxy s -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy s
forall k (t :: k). Proxy t
Proxy @s)
expected :: ByteString
expected = String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Proxy t -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy t
forall k (t :: k). Proxy t
Proxy @t)
in
case HeaderName -> Request -> Maybe ByteString
requestHeader HeaderName
name Request
r of
Nothing -> Fail (HeaderMatch s t) Request
-> CheckResult (HeaderMatch s t) Request
forall k (t :: k) a. Fail t a -> CheckResult t a
CheckFail HeaderMismatch :: ByteString -> Maybe ByteString -> HeaderMismatch
HeaderMismatch
{expectedHeader :: ByteString
expectedHeader = ByteString
expected, actualHeader :: Maybe ByteString
actualHeader = Maybe ByteString
forall a. Maybe a
Nothing}
Just hv :: ByteString
hv | ByteString
hv ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expected -> Request
-> Val (HeaderMatch s t) Request
-> CheckResult (HeaderMatch s t) Request
forall k (t :: k) a. a -> Val t a -> CheckResult t a
CheckSuccess Request
r ByteString
Val (HeaderMatch s t) Request
hv
| Bool
otherwise -> Fail (HeaderMatch s t) Request
-> CheckResult (HeaderMatch s t) Request
forall k (t :: k) a. Fail t a -> CheckResult t a
CheckFail HeaderMismatch :: ByteString -> Maybe ByteString -> HeaderMismatch
HeaderMismatch
{expectedHeader :: ByteString
expectedHeader = ByteString
expected, actualHeader :: Maybe ByteString
actualHeader = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
hv}