1 files changed, 21 insertions, 10 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)