blob: 96d0a4928a8c9635f803295d35b71f0c8510f20e (
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
87
88
89
90
|
module Controller.Index
( get
, signOut
) where
import Control.Monad.IO.Class (liftIO)
import Web.Scotty hiding (get)
import Network.HTTP.Types.Status (ok200)
import Data.Text (Text)
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import Database.Persist hiding (Key, get)
import Conf (Conf(..))
import qualified LoginSession
import Secure (getUserFromToken)
import Model.Database hiding (Key)
import qualified Model.Json.Conf as M
import Model.User (getUser)
import Model.Message.Key
import Model.SignIn (getSignIn, signInTokenToUsed)
import Model.Json.Init (InitResult(..))
import Model.Init (getInit)
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 . InitError $ errorKey
Right user ->
liftIO . runDb . fmap InitSuccess . getInit $ user
Nothing -> do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Nothing ->
return InitEmpty
Just user ->
liftIO . runDb . fmap InitSuccess . getInit $ user
html $ page (M.Conf { M.currency = currency conf }) initResult
validateSignIn :: Conf -> Text -> ActionM (Either Key (Entity User))
validateSignIn conf textToken = do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Just loggedUser ->
return . Right $ loggedUser
Nothing -> do
mbSignIn <- liftIO . runDb $ getSignIn textToken
now <- liftIO getCurrentTime
case mbSignIn of
Nothing ->
return . Left $ SignInInvalid
Just signInValue ->
if signInIsUsed . entityVal $ signInValue
then
return . Left $ SignInUsed
else
let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signInValue)
in if diffTime > signInExpiration conf
then
return . Left $ SignInExpired
else do
LoginSession.put conf (signInToken . entityVal $ signInValue)
mbUser <- liftIO . runDb $ do
signInTokenToUsed . entityKey $ signInValue
getUser . signInEmail . entityVal $ signInValue
return $ case mbUser of
Nothing -> Left UnauthorizedSignIn
Just user -> Right user
getLoggedUser :: ActionM (Maybe (Entity User))
getLoggedUser = do
mbToken <- LoginSession.get
case mbToken of
Nothing ->
return Nothing
Just token -> do
liftIO . runDb . getUserFromToken $ token
signOut :: Conf -> ActionM ()
signOut conf = LoginSession.delete conf >> status ok200
|
