{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
-- | Functions for creating, adding, and expiring cookies. To lookup cookie values see "Happstack.Server.RqData".
module Happstack.Server.Cookie
    ( Cookie(..)
    , CookieLife(..)
    , SameSite(..)
    , mkCookie
    , addCookie
    , addCookies
    , expireCookie
    )
    where

import Control.Monad.Trans              (MonadIO(..))
import Happstack.Server.Internal.Monads (FilterMonad, composeFilter)
import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), SameSite(..), calcLife, mkCookie, mkCookieHeader)
import Happstack.Server.Types           (Response, addHeader)

-- | Add the 'Cookie' to 'Response'.
--
-- example
-- 
-- > main = simpleHTTP nullConf $
-- >   do addCookie Session (mkCookie "name" "value")
-- >      ok $ "You now have a session cookie."
--
-- see also: 'addCookies'
addCookie :: (MonadIO m, FilterMonad Response m) => CookieLife -> Cookie -> m ()
addCookie :: forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie CookieLife
life Cookie
cookie =
    do Maybe (Int, UTCTime)
l <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ CookieLife -> IO (Maybe (Int, UTCTime))
calcLife CookieLife
life
       (forall {a} {m :: * -> *}.
(FilterMonad a m, HasHeaders a) =>
String -> String -> m ()
addHeaderM String
"Set-Cookie") forall a b. (a -> b) -> a -> b
$ Maybe (Int, UTCTime) -> Cookie -> String
mkCookieHeader Maybe (Int, UTCTime)
l Cookie
cookie
    where
      addHeaderM :: String -> String -> m ()
addHeaderM String
a String
v = forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter forall a b. (a -> b) -> a -> b
$ \a
res-> forall r. HasHeaders r => String -> String -> r -> r
addHeader String
a String
v a
res

-- | Add the list 'Cookie' to the 'Response'.
-- 
-- see also: 'addCookie'
addCookies :: (MonadIO m, FilterMonad Response m) => [(CookieLife, Cookie)] -> m ()
addCookies :: forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
[(CookieLife, Cookie)] -> m ()
addCookies = forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie)

-- | Expire the named cookie immediately and set the cookie value to @\"\"@
--
-- > main = simpleHTTP nullConf $
-- >   do expireCookie "name"
-- >      ok $ "The cookie has been expired."

expireCookie :: (MonadIO m, FilterMonad Response m) => String -> m () 
expireCookie :: forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
String -> m ()
expireCookie String
name = forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie CookieLife
Expired (String -> String -> Cookie
mkCookie String
name String
"")