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

{-# LANGUAGE OverloadedStrings #-}

module Secure
  ( loggedAction
  , getUserFromToken
  ) where

import Web.Scotty

import Network.HTTP.Types.Status (forbidden403)

import Database.Persist (Entity, entityVal)

import Model.User (getUser)
import Model.SignIn (getSignInToken)
import Model.Database

import Control.Monad.IO.Class (liftIO)

import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as TIO

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 "You are not authorized to logged in"
    Nothing -> do
      status forbidden403
      html "You need to be logged in to perform this action"

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