{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
module Happstack.Server.Cookie
( Cookie(..)
, CookieLife(..)
, mkCookie
, addCookie
, addCookies
, expireCookie
)
where
import Control.Monad.Trans (MonadIO(..))
import Happstack.Server.Internal.Monads (FilterMonad, composeFilter)
import Happstack.Server.Internal.Cookie (Cookie(..), CookieLife(..), calcLife, mkCookie, mkCookieHeader)
import Happstack.Server.Types (Response, addHeader)
addCookie :: (MonadIO m, FilterMonad Response m) => CookieLife -> Cookie -> m ()
addCookie life cookie =
do l <- liftIO $ calcLife life
(addHeaderM "Set-Cookie") $ mkCookieHeader l cookie
where
addHeaderM a v = composeFilter $ \res-> addHeader a v res
addCookies :: (MonadIO m, FilterMonad Response m) => [(CookieLife, Cookie)] -> m ()
addCookies = mapM_ (uncurry addCookie)
expireCookie :: (MonadIO m, FilterMonad Response m) => String -> m ()
expireCookie name = addCookie Expired (mkCookie name "")