blob: 8473c5c1c983019121588e42c7835c95988337d1 (
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
86
|
module Controller.Index
( get
, signOut
) where
import Control.Monad.IO.Class (liftIO)
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import Network.HTTP.Types.Status (ok200)
import Prelude hiding (error)
import Web.Scotty hiding (get)
import qualified Common.Message as Message
import Common.Message.Key (Key)
import qualified Common.Message.Key as Key
import Common.Model (InitResult(..), User(..))
import Conf (Conf(..))
import Model.Init (getInit)
import qualified LoginSession
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 . Message.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 $ Key.SignIn_LinkInvalid
Just signIn ->
if SignIn.isUsed signIn
then
return . Left $ Key.SignIn_LinkUsed
else
let diffTime = now `diffUTCTime` (SignIn.creation signIn)
in if diffTime > signInExpiration conf
then
return . Left $ Key.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 Key.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
|
