aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller/Index.hs
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