blob: 9fb2aa0823a628e0113693cb4f4f267ea5d3841c (
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
|
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 Web.Scotty hiding (get)
import Conf (Conf(..))
import Model.Init (getInit)
import Model.Json.Init (InitResult(..))
import Model.Message.Key
import Model.User (User)
import qualified LoginSession
import qualified Model.Json.Conf as M
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 . InitError $ errorKey
Right user ->
liftIO . Query.run . fmap InitSuccess . getInit $ user
Nothing -> do
mbLoggedUser <- getLoggedUser
case mbLoggedUser of
Nothing ->
return InitEmpty
Just user ->
liftIO . Query.run . fmap InitSuccess . getInit $ user
html $ page (M.Conf { M.currency = currency conf }) 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 $ SignInInvalid
Just signIn ->
if SignIn.isUsed signIn
then
return . Left $ SignInUsed
else
let diffTime = now `diffUTCTime` (SignIn.creation signIn)
in if diffTime > signInExpiration conf
then
return . Left $ SignInExpired
else do
LoginSession.put conf (SignIn.token signIn)
mbUser <- liftIO . Query.run $ do
SignIn.signInTokenToUsed . SignIn.id $ signIn
User.getUser . SignIn.email $ signIn
return $ case mbUser of
Nothing -> Left UnauthorizedSignIn
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
|
