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 (..))
import WebGear.Core.Request (Request)
import WebGear.Core.Response (Response)
import WebGear.Core.Trait (Get, Set, Trait (..), TraitAbsence (..), With, plant, probe)
data CookieNotFound = CookieNotFound
deriving stock (ReadPrec [CookieNotFound]
ReadPrec CookieNotFound
Int -> ReadS CookieNotFound
ReadS [CookieNotFound]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CookieNotFound]
$creadListPrec :: ReadPrec [CookieNotFound]
readPrec :: ReadPrec CookieNotFound
$creadPrec :: ReadPrec CookieNotFound
readList :: ReadS [CookieNotFound]
$creadList :: ReadS [CookieNotFound]
readsPrec :: Int -> ReadS CookieNotFound
$creadsPrec :: Int -> ReadS CookieNotFound
Read, Int -> CookieNotFound -> ShowS
[CookieNotFound] -> ShowS
CookieNotFound -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieNotFound] -> ShowS
$cshowList :: [CookieNotFound] -> ShowS
show :: CookieNotFound -> String
$cshow :: CookieNotFound -> String
showsPrec :: Int -> CookieNotFound -> ShowS
$cshowsPrec :: Int -> CookieNotFound -> ShowS
Show, CookieNotFound -> CookieNotFound -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieNotFound -> CookieNotFound -> Bool
$c/= :: CookieNotFound -> CookieNotFound -> Bool
== :: CookieNotFound -> CookieNotFound -> Bool
$c== :: CookieNotFound -> CookieNotFound -> Bool
Eq)
newtype CookieParseError = CookieParseError Text
deriving stock (ReadPrec [CookieParseError]
ReadPrec CookieParseError
Int -> ReadS CookieParseError
ReadS [CookieParseError]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CookieParseError]
$creadListPrec :: ReadPrec [CookieParseError]
readPrec :: ReadPrec CookieParseError
$creadPrec :: ReadPrec CookieParseError
readList :: ReadS [CookieParseError]
$creadList :: ReadS [CookieParseError]
readsPrec :: Int -> ReadS CookieParseError
$creadsPrec :: Int -> ReadS CookieParseError
Read, Int -> CookieParseError -> ShowS
[CookieParseError] -> ShowS
CookieParseError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CookieParseError] -> ShowS
$cshowList :: [CookieParseError] -> ShowS
show :: CookieParseError -> String
$cshow :: CookieParseError -> String
showsPrec :: Int -> CookieParseError -> ShowS
$cshowsPrec :: Int -> CookieParseError -> ShowS
Show, CookieParseError -> CookieParseError -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CookieParseError -> CookieParseError -> Bool
$c/= :: CookieParseError -> CookieParseError -> Bool
== :: CookieParseError -> CookieParseError -> Bool
$c== :: 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
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.
(Get h (Cookie e name val) Request, ArrowChoice h) =>
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 :: [*]).
(Get h (Cookie e name val) Request, ArrowChoice h) =>
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 <- 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) (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.
(Get h (Cookie Required name val) Request, ArrowChoice h) =>
h (Request `With` ts, Either CookieNotFound CookieParseError) Response ->
Middleware h ts (Cookie Required name val : ts)
cookie :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (Cookie 'Required name val) Request, ArrowChoice h) =>
h (With Request ts, Either CookieNotFound CookieParseError)
Response
-> Middleware h ts (Cookie 'Required name val : ts)
cookie = forall (name :: Symbol) val (e :: Existence) (h :: * -> * -> *)
(ts :: [*]).
(Get h (Cookie e name val) Request, ArrowChoice h) =>
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.
(Get h (Cookie Optional name val) Request, ArrowChoice h) =>
h (Request `With` ts, CookieParseError) Response ->
Middleware h ts (Cookie Optional name val : ts)
optionalCookie :: forall (name :: Symbol) val (h :: * -> * -> *) (ts :: [*]).
(Get h (Cookie 'Optional name val) Request, ArrowChoice h) =>
h (With Request ts, CookieParseError) Response
-> Middleware h ts (Cookie 'Optional name val : ts)
optionalCookie = forall (name :: Symbol) val (e :: Existence) (h :: * -> * -> *)
(ts :: [*]).
(Get h (Cookie e name val) Request, ArrowChoice h) =>
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 = 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). 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 = 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). SetCookie e name
SetCookie
{-# INLINE setOptionalCookie #-}