diff options
author | Joris | 2016-03-31 00:06:50 +0200 |
---|---|---|
committer | Joris | 2016-03-31 00:13:25 +0200 |
commit | c95e19407d492a0d4e9e14e320520fe29ce379e5 (patch) | |
tree | ca6a14ad1396af6a4bc36e17ce89278d5dbea0a0 /src/server/Cookie.hs | |
parent | c542551ad043260e6a4a6569b4af5c748f7b6001 (diff) | |
download | budget-c95e19407d492a0d4e9e14e320520fe29ce379e5.tar.gz budget-c95e19407d492a0d4e9e14e320520fe29ce379e5.tar.bz2 budget-c95e19407d492a0d4e9e14e320520fe29ce379e5.zip |
Add init data in html page
Diffstat (limited to 'src/server/Cookie.hs')
-rw-r--r-- | src/server/Cookie.hs | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/src/server/Cookie.hs b/src/server/Cookie.hs new file mode 100644 index 0000000..7ff5493 --- /dev/null +++ b/src/server/Cookie.hs @@ -0,0 +1,53 @@ +{-# 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 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 :: TS.Text -> TS.Text -> SetCookie +makeSimpleCookie n v = + def + { setCookieName = TS.encodeUtf8 n + , setCookieValue = TS.encodeUtf8 v + , setCookiePath = Just $ TS.encodeUtf8 "/" + , setCookieSecure = True + } + +setCookie :: (Monad m, ScottyError e) => SetCookie -> ActionT e m () +setCookie c = addHeader "Set-Cookie" (TL.decodeUtf8 . toLazyByteString $ renderSetCookie c) + +setSimpleCookie :: (Monad m, ScottyError e) => TS.Text -> TS.Text -> ActionT e m () +setSimpleCookie n v = setCookie $ makeSimpleCookie n v + +getCookie :: (Monad m, ScottyError e) => TS.Text -> ActionT e m (Maybe TS.Text) +getCookie c = liftM (Map.lookup c) 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, ScottyError e) => TS.Text -> ActionT e m () +deleteCookie c = setCookie $ (makeSimpleCookie c "") { setCookieExpires = Just $ posixSecondsToUTCTime 0 } |