blob: 6e5b998c1497db2d70f978db2182405c6cd424d4 (
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
|
module Secure
( loggedAction
, getUserFromToken
) where
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import Data.Text.Lazy (fromStrict)
import Network.HTTP.Types.Status (forbidden403)
import Web.Scotty
import Common.Model (User)
import qualified Common.Msg as Msg
import qualified LoginSession
import Model.Query (Query)
import qualified Model.Query as Query
import qualified Model.SignIn as SignIn
import qualified Model.User as User
loggedAction :: (User -> ActionM ()) -> ActionM ()
loggedAction action = do
maybeToken <- LoginSession.get
case maybeToken of
Just token -> do
maybeUser <- liftIO . Query.run . getUserFromToken $ token
case maybeUser of
Just user ->
action user
Nothing -> do
status forbidden403
html . fromStrict . Msg.get $ Msg.Secure_Unauthorized
Nothing -> do
status forbidden403
html . fromStrict . Msg.get $ Msg.Secure_Forbidden
getUserFromToken :: Text -> Query (Maybe User)
getUserFromToken token = do
mbSignIn <- SignIn.getSignIn token
case mbSignIn of
Just signIn ->
User.get (SignIn.email signIn)
Nothing ->
return Nothing
|
