Add init data in html page

2 files changed, 71 insertions, 45 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
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 33c19b4..f6804e1 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -2,7 +2,6 @@
 
 module Controller.SignIn
   ( signIn
-  , validateSignIn
   ) where
 
 import Web.Scotty
@@ -17,10 +16,6 @@ import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Encoding as TE
-import Data.Time.Clock (getCurrentTime, diffUTCTime)
-import Data.Maybe (isJust)
-
-import qualified LoginSession
 
 import Conf
 
@@ -33,8 +28,6 @@ import Model.User
 import Model.SignIn
 import Model.Message.Key
 
-import Secure (getUserFromToken)
-
 import qualified View.Mail.SignIn as SignIn
 
 signIn :: Conf -> Text -> ActionM ()
@@ -59,38 +52,3 @@ signIn conf login =
     else do
       status badRequest400
       text . TL.pack . show $ EnterValidEmail
-
-validateSignIn :: Conf -> Text -> ActionM (Either Key ())
-validateSignIn conf textToken = do
-  alreadySigned <- isAlreadySigned
-  if alreadySigned
-    then
-      return . Right $ ()
-    else do
-      mbSignIn <- liftIO . runDb $ getSignIn textToken
-      now <- liftIO getCurrentTime
-      case mbSignIn of
-        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)
-                      liftIO . runDb . signInTokenToUsed . entityKey $ signInValue
-                      return . Right $ ()
-        Nothing ->
-          return . Left $ SignInInvalid
-
-isAlreadySigned :: ActionM Bool
-isAlreadySigned = do
-  mbToken <- LoginSession.get
-  case mbToken of
-    Nothing ->
-      return False
-    Just token -> do
-      liftIO . runDb . fmap isJust $ getUserFromToken token