module WebGear.Core.Trait.Cookie (
Cookie (..),
CookieNotFound (..),
CookieParseError (..),
SetCookie (..),
cookie,
optionalCookie,
setCookie,
setOptionalCookie,
) where
import Control.Arrow (ArrowChoice)
import Data.Kind (Type)
import Data.Text (Text)
import GHC.TypeLits (Symbol)
import qualified Web.Cookie as Cookie
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,
HasTrait,
Prerequisite,
Set,
Trait (..),
TraitAbsence (..),
With,
plant,
probe,
)
import WebGear.Core.Trait.Header (RequestHeader)
data CookieNotFound = CookieNotFound
deriving stock (ReadPrec [CookieNotFound]
ReadPrec CookieNotFound
Int -> ReadS CookieNotFound
ReadS [CookieNotFound]
(Int -> ReadS CookieNotFound)
-> ReadS [CookieNotFound]
-> ReadPrec CookieNotFound
-> ReadPrec [CookieNotFound]
-> Read CookieNotFound
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CookieNotFound
readsPrec :: Int -> ReadS CookieNotFound
$creadList :: ReadS [CookieNotFound]
readList :: ReadS [CookieNotFound]
$creadPrec :: ReadPrec CookieNotFound
readPrec :: ReadPrec CookieNotFound
$creadListPrec :: ReadPrec [CookieNotFound]
readListPrec :: ReadPrec [CookieNotFound]
Read, Int -> CookieNotFound -> ShowS
[CookieNotFound] -> ShowS
CookieNotFound -> String
(Int -> CookieNotFound -> ShowS)
-> (CookieNotFound -> String)
-> ([CookieNotFound] -> ShowS)
-> Show CookieNotFound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieNotFound -> ShowS
showsPrec :: Int -> CookieNotFound -> ShowS
$cshow :: CookieNotFound -> String
show :: CookieNotFound -> String
$cshowList :: [CookieNotFound] -> ShowS
showList :: [CookieNotFound] -> ShowS
Show, CookieNotFound -> CookieNotFound -> Bool
(CookieNotFound -> CookieNotFound -> Bool)
-> (CookieNotFound -> CookieNotFound -> Bool) -> Eq CookieNotFound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieNotFound -> CookieNotFound -> Bool
== :: CookieNotFound -> CookieNotFound -> Bool
$c/= :: CookieNotFound -> CookieNotFound -> Bool
/= :: CookieNotFound -> CookieNotFound -> Bool
Eq)
newtype CookieParseError = CookieParseError Text
deriving stock (ReadPrec [CookieParseError]
ReadPrec CookieParseError
Int -> ReadS CookieParseError
ReadS [CookieParseError]
(Int -> ReadS CookieParseError)
-> ReadS [CookieParseError]
-> ReadPrec CookieParseError
-> ReadPrec [CookieParseError]
-> Read CookieParseError
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CookieParseError
readsPrec :: Int -> ReadS CookieParseError
$creadList :: ReadS [CookieParseError]
readList :: ReadS [CookieParseError]
$creadPrec :: ReadPrec CookieParseError
readPrec :: ReadPrec CookieParseError
$creadListPrec :: ReadPrec [CookieParseError]
readListPrec :: ReadPrec [CookieParseError]
Read, Int -> CookieParseError -> ShowS
[CookieParseError] -> ShowS
CookieParseError -> String
(Int -> CookieParseError -> ShowS)
-> (CookieParseError -> String)
-> ([CookieParseError] -> ShowS)
-> Show CookieParseError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CookieParseError -> ShowS
showsPrec :: Int -> CookieParseError -> ShowS
$cshow :: CookieParseError -> String
show :: CookieParseError -> String
$cshowList :: [CookieParseError] -> ShowS
showList :: [CookieParseError] -> ShowS
Show, CookieParseError -> CookieParseError -> Bool
(CookieParseError -> CookieParseError -> Bool)
-> (CookieParseError -> CookieParseError -> Bool)
-> Eq CookieParseError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CookieParseError -> CookieParseError -> Bool
== :: CookieParseError -> CookieParseError -> Bool
$c/= :: CookieParseError -> CookieParseError -> Bool
/= :: CookieParseError -> CookieParseError -> Bool
Eq)
data Cookie (e :: Existence) (name :: Symbol) (val :: Type) = Cookie
instance Trait (Cookie Required name val) Request where
type Attribute (Cookie Required name val) Request = val
type instance
Prerequisite (Cookie e name val) ts Request =
HasTrait (RequestHeader e Strict "Cookie" Text) ts
instance TraitAbsence (Cookie Required name val) Request where
type Absence (Cookie Required name val) Request = Either CookieNotFound CookieParseError
instance Trait (Cookie Optional name val) Request where
type Attribute (Cookie Optional name val) Request = Maybe val
instance TraitAbsence (Cookie Optional name val) Request where
type Absence (Cookie Optional name val) Request = CookieParseError
cookieHandler ::
forall name val e h ts.
( ArrowChoice h
, Get h (Cookie e name val) Request
, HasTrait (RequestHeader e Strict "Cookie" Text) ts
) =>
h (Request `With` ts, Absence (Cookie e name val) Request) Response ->
Middleware h ts (Cookie e name val : ts)
cookieHandler :: forall (name :: Symbol) val (e :: Existence) (h :: * -> * -> *)
(ts :: [*]).
(ArrowChoice h, Get h (Cookie e name val) Request,
HasTrait (RequestHeader e 'Strict "Cookie" Text) ts) =>
h (With Request ts, Absence (Cookie e name val) Request) Response
-> Middleware h ts (Cookie e name val : ts)
cookieHandler h (With Request ts, Absence (Cookie e name val) Request) Response
errorHandler RequestHandler h (Cookie e name val : ts)
nextHandler = proc With Request ts
request -> do
Either
(Absence (Cookie e name val) Request)
(With Request (Cookie e name val : ts))
result <- Cookie e name val
-> h (With Request ts)
(Either
(Absence (Cookie e name val) Request)
(With Request (Cookie e name val : ts)))
forall t (ts :: [*]) (h :: * -> * -> *) a.
(Get h t a, Prerequisite t ts a) =>
t -> h (With a ts) (Either (Absence t a) (With a (t : ts)))
probe Cookie e name val
forall (e :: Existence) (name :: Symbol) val. Cookie e name val
Cookie -< With Request ts
request
case Either
(Absence (Cookie e name val) Request)
(With Request (Cookie e name val : ts))
result of
Left Absence (Cookie e name val) Request
err -> h (With Request ts, Absence (Cookie e name val) Request) Response
errorHandler -< (With Request ts
request, Absence (Cookie e name val) Request
err)
Right With Request (Cookie e name val : ts)
val -> RequestHandler h (Cookie e name val : ts)
nextHandler -< With Request (Cookie e name val : ts)
val
{-# INLINE cookieHandler #-}
cookie ::
forall name val h ts.
( ArrowChoice h
, Get h (Cookie Required name val) Request
, HasTrait (RequestHeader Required Strict "Cookie" Text) ts
) =>
h (Request `With` ts, Either CookieNotFound CookieParseError) Response ->
Middleware h ts (Cookie Required name val : ts)
cookie :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(ArrowChoice h, Get h (Cookie 'Required name val) Request,
HasTrait (RequestHeader 'Required 'Strict "Cookie" Text) ts) =>
h (With Request ts, Either CookieNotFound CookieParseError)
Response
-> Middleware h ts (Cookie 'Required name val : ts)
cookie = h (With Request ts, Either CookieNotFound CookieParseError)
Response
-> h (With Request (Cookie 'Required name val : ts)) Response
-> h (With Request ts) Response
h (With Request ts, Absence (Cookie 'Required name val) Request)
Response
-> h (With Request (Cookie 'Required name val : ts)) Response
-> h (With Request ts) Response
forall (name :: Symbol) val (e :: Existence) (h :: * -> * -> *)
(ts :: [*]).
(ArrowChoice h, Get h (Cookie e name val) Request,
HasTrait (RequestHeader e 'Strict "Cookie" Text) ts) =>
h (With Request ts, Absence (Cookie e name val) Request) Response
-> Middleware h ts (Cookie e name val : ts)
cookieHandler
{-# INLINE cookie #-}
optionalCookie ::
forall name val h ts.
( ArrowChoice h
, Get h (Cookie Optional name val) Request
, HasTrait (RequestHeader Optional Strict "Cookie" Text) ts
) =>
h (Request `With` ts, CookieParseError) Response ->
Middleware h ts (Cookie Optional name val : ts)
optionalCookie :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(ArrowChoice h, Get h (Cookie 'Optional name val) Request,
HasTrait (RequestHeader 'Optional 'Strict "Cookie" Text) ts) =>
h (With Request ts, CookieParseError) Response
-> Middleware h ts (Cookie 'Optional name val : ts)
optionalCookie = h (With Request ts, Absence (Cookie 'Optional name val) Request)
Response
-> Middleware h ts (Cookie 'Optional name val : ts)
h (With Request ts, CookieParseError) Response
-> Middleware h ts (Cookie 'Optional name val : ts)
forall (name :: Symbol) val (e :: Existence) (h :: * -> * -> *)
(ts :: [*]).
(ArrowChoice h, Get h (Cookie e name val) Request,
HasTrait (RequestHeader e 'Strict "Cookie" Text) ts) =>
h (With Request ts, Absence (Cookie e name val) Request) Response
-> Middleware h ts (Cookie e name val : ts)
cookieHandler
{-# INLINE optionalCookie #-}
data SetCookie (e :: Existence) (name :: Symbol) = SetCookie
instance Trait (SetCookie Required name) Response where
type Attribute (SetCookie Required name) Response = Cookie.SetCookie
instance Trait (SetCookie Optional name) Response where
type Attribute (SetCookie Optional name) Response = Maybe Cookie.SetCookie
setCookie ::
forall name h ts.
(Set h (SetCookie Required name) Response) =>
h (Response `With` ts, Cookie.SetCookie) (Response `With` (SetCookie Required name : ts))
setCookie :: forall (name :: Symbol) (h :: * -> * -> *) (ts :: [*]).
Set h (SetCookie 'Required name) Response =>
h (With Response ts, SetCookie)
(With Response (SetCookie 'Required name : ts))
setCookie = SetCookie 'Required name
-> h (With Response ts,
Attribute (SetCookie 'Required name) Response)
(With Response (SetCookie 'Required name : ts))
forall t (ts :: [*]) (h :: * -> * -> *) a.
Set h t a =>
t -> h (With a ts, Attribute t a) (With a (t : ts))
plant SetCookie 'Required name
forall (e :: Existence) (name :: Symbol). SetCookie e name
SetCookie
{-# INLINE setCookie #-}
setOptionalCookie ::
forall name h ts.
(Set h (SetCookie Optional name) Response) =>
h (Response `With` ts, Maybe Cookie.SetCookie) (Response `With` (SetCookie Optional name : ts))
setOptionalCookie :: forall (name :: Symbol) (h :: * -> * -> *) (ts :: [*]).
Set h (SetCookie 'Optional name) Response =>
h (With Response ts, Maybe SetCookie)
(With Response (SetCookie 'Optional name : ts))
setOptionalCookie = SetCookie 'Optional name
-> h (With Response ts,
Attribute (SetCookie 'Optional name) Response)
(With Response (SetCookie 'Optional name : ts))
forall t (ts :: [*]) (h :: * -> * -> *) a.
Set h t a =>
t -> h (With a ts, Attribute t a) (With a (t : ts))
plant SetCookie 'Optional name
forall (e :: Existence) (name :: Symbol). SetCookie e name
SetCookie
{-# INLINE setOptionalCookie #-}