src/server/Secure.hs


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

{-# LANGUAGE OverloadedStrings #-}

module Secure
  ( loggedAction
  , getUserFromToken
  ) where

import Web.Scotty

import Network.HTTP.Types.Status (forbidden403)

import Database.Persist (Entity, entityVal)

import Data.Text (Text)
import Data.Text.Lazy (fromStrict)

import Model.User (getUser)
import Model.SignIn (getSignIn)
import Model.Database
import Model.Message (getMessage)
import qualified Model.Message.Key as Key

import Control.Monad.IO.Class (liftIO)

import qualified LoginSession

loggedAction :: (Entity User -> ActionM ()) -> ActionM ()
loggedAction action = do
  maybeToken <- LoginSession.get
  case maybeToken of
    Just token -> do
      maybeUser <- liftIO . runDb . getUserFromToken $ token
      case maybeUser of
        Just user ->
          action user
        Nothing -> do
          status forbidden403
          html . fromStrict . getMessage $ Key.UnauthorizedSignIn
    Nothing -> do
      status forbidden403
      html . fromStrict . getMessage $ Key.Forbidden

getUserFromToken :: Text -> Persist (Maybe (Entity User))
getUserFromToken token = do
  mbSignIn <- fmap entityVal <$> getSignIn token
  case mbSignIn of
    Just signIn -> do
      getUser (signInEmail signIn)
    Nothing ->
      return Nothing