From 27e11b20b06f2f2dbfb56c0998a63169b4b8abc4 Mon Sep 17 00:00:00 2001
From: Joris
Date: Wed, 8 Nov 2017 23:47:26 +0100
Subject: Use a better project structure

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

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

diff --git a/server/src/LoginSession.hs b/server/src/LoginSession.hs
new file mode 100644
index 0000000..6f6d620
--- /dev/null
+++ b/server/src/LoginSession.hs
@@ -0,0 +1,53 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module LoginSession
+  ( put
+  , get
+  , delete
+  ) where
+
+import Web.Scotty (ActionM)
+import 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
+
+import Conf (Conf)
+
+sessionName :: Text
+sessionName = "SESSION"
+
+sessionKeyFile :: FilePath
+sessionKeyFile = "sessionKey"
+
+put :: Conf -> Text -> ActionM ()
+put conf value = do
+  encrypted <- liftIO $ encrypt value
+  setSimpleCookie conf 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 :: Conf -> ActionM ()
+delete conf = deleteCookie conf sessionName
-- 
cgit v1.2.3