diff options
| -rw-r--r-- | src/server/Application.hs | 31 | ||||
| -rw-r--r-- | src/server/Model/SignIn.hs | 12 |
2 files changed, 25 insertions, 18 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs index 7bb305e..739fe33 100644 --- a/src/server/Application.hs +++ b/src/server/Application.hs @@ -25,6 +25,7 @@ import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as TE import Data.String (fromString) +import Data.Time.Clock (getCurrentTime, diffUTCTime) import Text.Email.Validate (isValid) @@ -100,23 +101,33 @@ signInAction login = else errorResponse "Please enter a valid email address." -errorResponse :: Text -> ActionM () -errorResponse message = do - status badRequest400 - json (Message message) - validateSignInAction :: Text -> ActionM () validateSignInAction token = do maybeSignIn <- liftIO . runDb $ getSignInToken token + now <- liftIO getCurrentTime case maybeSignIn of - Just signIn -> do - LoginSession.put (signInEmail . entityVal $ signIn) - liftIO . runDb . signInTokenIsUsed . entityKey $ signIn - redirect "/" + Just signIn -> + if signInIsUsed . entityVal $ signIn + then + errorResponse "The token has already been used." + else + let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn) + in if diffTime > 2 * 60 -- 2 minutes + then + errorResponse "The token has expired." + else do + LoginSession.put (signInEmail . entityVal $ signIn) + liftIO . runDb . signInTokenToUsed . entityKey $ signIn + redirect "/" Nothing -> - status badRequest400 + errorResponse "The token is invalid." signOutAction :: ActionM () signOutAction = do LoginSession.delete status ok200 + +errorResponse :: Text -> ActionM () +errorResponse msg = do + status badRequest400 + json (Message msg) diff --git a/src/server/Model/SignIn.hs b/src/server/Model/SignIn.hs index c447416..0f9c6ce 100644 --- a/src/server/Model/SignIn.hs +++ b/src/server/Model/SignIn.hs @@ -1,7 +1,7 @@ module Model.SignIn ( createSignInToken , getSignInToken - , signInTokenIsUsed + , signInTokenToUsed ) where import Data.Text (Text) @@ -23,12 +23,8 @@ createSignInToken email = do getSignInToken :: Text -> Persist (Maybe (Entity SignIn)) getSignInToken token = - selectFirst - [ SignInToken ==. token - , SignInIsUsed ==. False - ] - [] + selectFirst [SignInToken ==. token] [] -signInTokenIsUsed :: SignInId -> Persist () -signInTokenIsUsed tokenId = +signInTokenToUsed :: SignInId -> Persist () +signInTokenToUsed tokenId = update tokenId [SignInIsUsed =. True] |