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 }