From c95e19407d492a0d4e9e14e320520fe29ce379e5 Mon Sep 17 00:00:00 2001
From: Joris
Date: Thu, 31 Mar 2016 00:06:50 +0200
Subject: Add init data in html page

---
 src/server/Controller/Index.hs | 74 ++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 71 insertions(+), 3 deletions(-)

(limited to 'src/server/Controller/Index.hs')

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
-- 
cgit v1.2.3