{-# LANGUAGE OverloadedStrings #-} module Cookie ( makeSimpleCookie , setCookie , setSimpleCookie , getCookie , getCookies , deleteCookie ) where import Control.Monad ( liftM ) import qualified Data.Text as TS import qualified Data.Text.Encoding as TS import qualified Data.Text.Lazy.Encoding as TL import Conf (Conf) import qualified Conf import qualified Data.Map as Map import qualified Data.ByteString.Lazy as BSL import Data.Time.Clock.POSIX ( posixSecondsToUTCTime ) import Blaze.ByteString.Builder ( toLazyByteString ) import Web.Scotty.Trans import Web.Cookie makeSimpleCookie :: Conf -> TS.Text -> TS.Text -> SetCookie makeSimpleCookie conf name value = def { setCookieName = TS.encodeUtf8 name , setCookieValue = TS.encodeUtf8 value , setCookiePath = Just $ TS.encodeUtf8 "/" , setCookieSecure = Conf.https conf } setCookie :: (Monad m) => SetCookie -> ActionT e m () setCookie name = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie name) setSimpleCookie :: (Monad m) => Conf -> TS.Text -> TS.Text -> ActionT e m () setSimpleCookie conf name value = setCookie $ makeSimpleCookie conf name value getCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m (Maybe TS.Text) getCookie name = liftM (Map.lookup name) getCookies getCookies :: (Monad m, ScottyError e) => ActionT e m (Map.Map TS.Text TS.Text) getCookies = liftM (Map.fromList . maybe [] parse) $ header "Cookie" where parse = parseCookiesText . BSL.toStrict . TL.encodeUtf8 deleteCookie :: (Monad m) => Conf -> TS.Text -> ActionT e m () deleteCookie conf name = setCookie $ (makeSimpleCookie conf name "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 }