aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/server/Application.hs31
-rw-r--r--src/server/Model/SignIn.hs12
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]