aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Controller')
-rw-r--r--src/server/Controller/Index.hs74
-rw-r--r--src/server/Controller/SignIn.hs42
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