From 89dd4de13896f8e37d1bf133080eb881ab42b292 Mon Sep 17 00:00:00 2001
From: Joris Guyonvarch
Date: Sat, 18 Jul 2015 15:19:48 +0200
Subject: Adding login/logout functions thanks to a client session

---
 src/server/LoginSession.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 51 insertions(+)
 create mode 100644 src/server/LoginSession.hs

(limited to 'src/server/LoginSession.hs')

diff --git a/src/server/LoginSession.hs b/src/server/LoginSession.hs
new file mode 100644
index 0000000..c755607
--- /dev/null
+++ b/src/server/LoginSession.hs
@@ -0,0 +1,51 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module LoginSession
+  ( put
+  , get
+  , delete
+  ) where
+
+import Web.Scotty (ActionM)
+import Web.Scotty.Cookie (setSimpleCookie, getCookie, deleteCookie)
+import qualified Web.ClientSession as CS
+
+import Control.Monad.IO.Class (liftIO)
+
+import Data.Text (Text)
+import qualified Data.Text.Encoding as TE
+
+sessionName :: Text
+sessionName = "SESSION"
+
+sessionKeyFile :: FilePath
+sessionKeyFile = "sessionKey"
+
+put :: Text -> ActionM ()
+put value = do
+  encrypted <- liftIO $ encrypt value
+  setSimpleCookie sessionName encrypted
+
+encrypt :: Text -> IO Text
+encrypt value = do
+  iv <- CS.randomIV
+  key <- CS.getKey sessionKeyFile
+  return . TE.decodeUtf8 $ CS.encrypt key iv (TE.encodeUtf8 value)
+
+get :: ActionM (Maybe Text)
+get = do
+  maybeEncrypted <- getCookie sessionName
+  case maybeEncrypted of
+    Just encrypted ->
+      liftIO $ decrypt encrypted
+    Nothing ->
+      return Nothing
+
+decrypt :: Text -> IO (Maybe Text)
+decrypt encrypted = do
+  key <- CS.getKey sessionKeyFile
+  let decrypted = TE.decodeUtf8 <$> CS.decrypt key (TE.encodeUtf8 encrypted)
+  return decrypted
+
+delete :: ActionM ()
+delete = deleteCookie sessionName
-- 
cgit v1.2.3