server/src/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

module Secure
  ( loggedAction
  ) where

import           Control.Monad.IO.Class    (liftIO)
import qualified Data.Text.Lazy            as TL
import qualified Network.HTTP.Types.Status as HTTP
import           Web.Scotty

import           Common.Model              (User)
import qualified Common.Msg                as Msg

import qualified LoginSession
import qualified Model.Query               as Query
import qualified Persistence.User          as UserPersistence

loggedAction :: (User -> ActionM ()) -> ActionM ()
loggedAction action = do
  maybeToken <- LoginSession.get
  case maybeToken of
    Just token -> do
      maybeUser <- liftIO . Query.run . UserPersistence.get $ token
      case maybeUser of
        Just user ->
          action user
        Nothing -> do
          status HTTP.forbidden403
          html . TL.fromStrict . Msg.get $ Msg.Secure_Unauthorized
    Nothing -> do
      status HTTP.forbidden403
      html . TL.fromStrict . Msg.get $ Msg.Secure_Forbidden