Merge branch 'with-ghcjs' into 'master'

Use Haskell on the frontend

See merge request guyonvarch/shared-cost!2

1 files changed, 52 insertions, 0 deletions

diff --git a/server/src/LoginSession.hs b/server/src/LoginSession.hs
new file mode 100644
index 0000000..86f1329
--- /dev/null
+++ b/server/src/LoginSession.hs
@@ -0,0 +1,52 @@
+module LoginSession
+  ( put
+  , get
+  , delete
+  ) where
+
+import           Cookie                 (deleteCookie, getCookie,
+                                         setSimpleCookie)
+import qualified Web.ClientSession      as CS
+import           Web.Scotty             (ActionM)
+
+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