diff options
author | Joris | 2015-11-01 20:10:28 +0100 |
---|---|---|
committer | Joris | 2015-11-01 20:10:28 +0100 |
commit | c79fa3e212e8bb49f950da3c3218e32e3b9df2ec (patch) | |
tree | 0a8d7169b038a3eda4f1d214ea6bb9270ba59811 /src/server | |
parent | 51d1ff2273315ad1270794499d0c49e8fb99aba5 (diff) |
Give access to sharedCost if someone click on the sign in link and is already connected
Diffstat (limited to 'src/server')
-rw-r--r-- | src/server/Controller/SignIn.hs | 49 | ||||
-rw-r--r-- | src/server/Secure.hs | 1 |
2 files changed, 34 insertions, 16 deletions
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs index 5306ee1..31cd510 100644 --- a/src/server/Controller/SignIn.hs +++ b/src/server/Controller/SignIn.hs @@ -18,6 +18,7 @@ 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 @@ -35,6 +36,8 @@ import Model.Message (getMessage) import Json (jsonError) +import Secure (getUserFromToken) + import qualified View.Mail.SignIn as SignIn signIn :: Config -> Text -> ActionM () @@ -59,24 +62,38 @@ signIn config login = validateSignIn :: Config -> Text -> ActionM () validateSignIn config textToken = do - mbToken <- liftIO . runDb $ getSignInToken textToken - now <- liftIO getCurrentTime + alreadySigned <- isAlreadySigned + if alreadySigned + then + redirect "/" + else do + mbSignIn <- liftIO . runDb $ getSignInToken textToken + now <- liftIO getCurrentTime + case mbSignIn of + Just signIn -> + if signInIsUsed . entityVal $ signIn + then + redirectError (getMessage SignInUsed) + else + let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn) + in if diffTime > (fromIntegral $ (signInExpirationMn config) * 60) + then + redirectError (getMessage SignInExpired) + else do + LoginSession.put (signInToken . entityVal $ signIn) + liftIO . runDb . signInTokenToUsed . entityKey $ signIn + redirect "/" + Nothing -> + redirectError (getMessage SignInInvalid) + +isAlreadySigned :: ActionM Bool +isAlreadySigned = do + mbToken <- LoginSession.get case mbToken of - Just token -> - if signInIsUsed . entityVal $ token - then - redirectError (getMessage SignInUsed) - else - let diffTime = now `diffUTCTime` (signInCreation . entityVal $ token) - in if diffTime > (fromIntegral $ (signInExpirationMn config) * 60) - then - redirectError (getMessage SignInExpired) - else do - LoginSession.put (signInToken . entityVal $ token) - liftIO . runDb . signInTokenToUsed . entityKey $ token - redirect "/" Nothing -> - redirectError (getMessage SignInInvalid) + return False + Just token -> do + liftIO . runDb . fmap isJust $ getUserFromToken token redirectError :: Text -> ActionM () redirectError msg = diff --git a/src/server/Secure.hs b/src/server/Secure.hs index 8565098..192fa10 100644 --- a/src/server/Secure.hs +++ b/src/server/Secure.hs @@ -2,6 +2,7 @@ module Secure ( loggedAction + , getUserFromToken ) where import Web.Scotty |