{-# 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 :: CookieLife -> Cookie -> m ()
addCookie CookieLife
life Cookie
cookie =
    do Maybe (Int, UTCTime)
l <- IO (Maybe (Int, UTCTime)) -> m (Maybe (Int, UTCTime))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe (Int, UTCTime)) -> m (Maybe (Int, UTCTime)))
-> IO (Maybe (Int, UTCTime)) -> m (Maybe (Int, UTCTime))
forall a b. (a -> b) -> a -> b
$ CookieLife -> IO (Maybe (Int, UTCTime))
calcLife CookieLife
life
       (String -> String -> m ()
forall r (m :: * -> *).
(FilterMonad r m, HasHeaders r) =>
String -> String -> m ()
addHeaderM String
"Set-Cookie") (String -> m ()) -> String -> m ()
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 = (r -> r) -> m ()
forall a (m :: * -> *). FilterMonad a m => (a -> a) -> m ()
composeFilter ((r -> r) -> m ()) -> (r -> r) -> m ()
forall a b. (a -> b) -> a -> b
$ \r
res-> String -> String -> r -> r
forall r. HasHeaders r => String -> String -> r -> r
addHeader String
a String
v r
res

-- | Add the list 'Cookie' to the 'Response'.
-- 
-- see also: 'addCookie'
addCookies :: (MonadIO m, FilterMonad Response m) => [(CookieLife, Cookie)] -> m ()
addCookies :: [(CookieLife, Cookie)] -> m ()
addCookies = ((CookieLife, Cookie) -> m ()) -> [(CookieLife, Cookie)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((CookieLife -> Cookie -> m ()) -> (CookieLife, Cookie) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CookieLife -> Cookie -> m ()
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 :: String -> m ()
expireCookie String
name = CookieLife -> Cookie -> m ()
forall (m :: * -> *).
(MonadIO m, FilterMonad Response m) =>
CookieLife -> Cookie -> m ()
addCookie CookieLife
Expired (String -> String -> Cookie
mkCookie String
name String
"")