aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller/Index.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Controller/Index.hs')
-rw-r--r--src/server/Controller/Index.hs74
1 files changed, 71 insertions, 3 deletions
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs
index bbf741e..f84f945 100644
--- a/src/server/Controller/Index.hs
+++ b/src/server/Controller/Index.hs
@@ -3,20 +3,88 @@ module Controller.Index
, signOut
) where
+import Control.Monad.IO.Class (liftIO)
+
import Web.Scotty
import Network.HTTP.Types.Status (ok200)
+import Data.Text (Text)
+import Data.Time.Clock (getCurrentTime, diffUTCTime)
+
+import Database.Persist hiding (Key)
+
import Conf (Conf(..))
import qualified LoginSession
+import Secure (getUserFromToken)
+import Model.Database
import qualified Model.Json.Conf as M
-import Model.Message.Key (Key)
+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)
-getIndex :: Conf -> Maybe Key -> ActionM ()
-getIndex conf mbErrorKey = html $ page (M.Conf { M.currency = currency conf }) mbErrorKey
+getIndex :: Conf -> Maybe Text -> ActionM ()
+getIndex 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 (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 :: ActionM ()
signOut = do