From 7194cddb28656c721342c2ef604f9f9fb0692960 Mon Sep 17 00:00:00 2001 From: Joris Date: Sun, 19 Nov 2017 00:20:25 +0100 Subject: Show payment count and partition - Also fixes exceedingPayer in back by using only punctual payments --- server/src/Controller/Index.hs | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'server/src/Controller/Index.hs') diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs index bf4859d..f05ce6f 100644 --- a/server/src/Controller/Index.hs +++ b/server/src/Controller/Index.hs @@ -10,10 +10,9 @@ import Network.HTTP.Types.Status (ok200) import Prelude hiding (error) import Web.Scotty hiding (get) -import qualified Common.Message as Message -import Common.Message.Key (Key) -import qualified Common.Message.Key as Key import Common.Model (InitResult (..), User (..)) +import Common.Msg (Key) +import qualified Common.Msg as Msg import Conf (Conf (..)) import qualified LoginSession @@ -31,7 +30,7 @@ get conf mbToken = do userOrError <- validateSignIn conf token case userOrError of Left errorKey -> - return . InitEmpty . Left . Message.get $ errorKey + return . InitEmpty . Left . Msg.get $ errorKey Right user -> liftIO . Query.run . fmap InitSuccess $ getInit user conf Nothing -> do @@ -54,23 +53,23 @@ validateSignIn conf textToken = do now <- liftIO getCurrentTime case mbSignIn of Nothing -> - return . Left $ Key.SignIn_LinkInvalid + return . Left $ Msg.SignIn_LinkInvalid Just signIn -> if SignIn.isUsed signIn then - return . Left $ Key.SignIn_LinkUsed + return . Left $ Msg.SignIn_LinkUsed else let diffTime = now `diffUTCTime` (SignIn.creation signIn) in if diffTime > signInExpiration conf then - return . Left $ Key.SignIn_LinkExpired + return . Left $ Msg.SignIn_LinkExpired else do LoginSession.put conf (SignIn.token signIn) mbUser <- liftIO . Query.run $ do SignIn.signInTokenToUsed . SignIn.id $ signIn User.get . SignIn.email $ signIn return $ case mbUser of - Nothing -> Left Key.Secure_Unauthorized + Nothing -> Left Msg.Secure_Unauthorized Just user -> Right user getLoggedUser :: ActionM (Maybe User) -- cgit v1.2.3