blob: f05ce6f38957e51513d85b99b6a3c8b5b762a9b3 (
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
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
module Controller.Index
( get
, signOut
) where
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import Data.Time.Clock (diffUTCTime, getCurrentTime)
import Network.HTTP.Types.Status (ok200)
import Prelude hiding (error)
import Web.Scotty hiding (get)
import Common.Model (InitResult (..), User (..))
import Common.Msg (Key)
import qualified Common.Msg as Msg
import Conf (Conf (..))
import qualified LoginSession
import Model.Init (getInit)
import qualified Model.Query as Query
import qualified Model.SignIn as SignIn
import qualified Model.User as User
import Secure (getUserFromToken)
import View.Page (page)
get :: Conf -> Maybe Text -> ActionM ()
get conf mbToken = do
initResult <- case mbToken of
Just token -> do
userOrError <- validateSignIn conf token
case userOrError of
Left errorKey ->
return . InitEmpty . Left . Msg.get $ errorKey
Right user ->
liftIO . Query.run . fmap InitSuccess $ getInit user conf
Nothing -> do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Nothing ->
return . InitEmpty . Right $ Nothing
Just user ->
liftIO . Query.run . fmap InitSuccess $ getInit user conf
html $ page initResult
validateSignIn :: Conf -> Text -> ActionM (Either Key User)
validateSignIn conf textToken = do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Just loggedUser ->
return . Right $ loggedUser
Nothing -> do
mbSignIn <- liftIO . Query.run $ SignIn.getSignIn textToken
now <- liftIO getCurrentTime
case mbSignIn of
Nothing ->
return . Left $ Msg.SignIn_LinkInvalid
Just signIn ->
if SignIn.isUsed signIn
then
return . Left $ Msg.SignIn_LinkUsed
else
let diffTime = now `diffUTCTime` (SignIn.creation signIn)
in if diffTime > signInExpiration conf
then
return . Left $ Msg.SignIn_LinkExpired
else do
LoginSession.put conf (SignIn.token signIn)
mbUser <- liftIO . Query.run $ do
SignIn.signInTokenToUsed . SignIn.id $ signIn
User.get . SignIn.email $ signIn
return $ case mbUser of
Nothing -> Left Msg.Secure_Unauthorized
Just user -> Right user
getLoggedUser :: ActionM (Maybe User)
getLoggedUser = do
mbToken <- LoginSession.get
case mbToken of
Nothing ->
return Nothing
Just token -> do
liftIO . Query.run . getUserFromToken $ token
signOut :: Conf -> ActionM ()
signOut conf = LoginSession.delete conf >> status ok200
|
