aboutsummaryrefslogtreecommitdiff
path: root/server/src/LoginSession.hs
blob: 86f132900cdce25b00880817eccc7f3686bd5e85 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
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