Showing login token error message in the UI

1 files changed, 8 insertions, 3 deletions

diff --git a/src/server/Application.hs b/src/server/Application.hs
index 739fe33..7e93fe1 100644
--- a/src/server/Application.hs
+++ b/src/server/Application.hs
@@ -23,6 +23,7 @@ import Control.Monad.IO.Class (liftIO)
 
 import Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Encoding as TE
 import Data.String (fromString)
 import Data.Time.Clock (getCurrentTime, diffUTCTime)
@@ -109,18 +110,22 @@ validateSignInAction token = do
     Just signIn ->
       if signInIsUsed . entityVal $ signIn
         then
-          errorResponse "The token has already been used."
+          redirectError "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."
+                  redirectError "The token has expired."
                 else do
                   LoginSession.put (signInEmail . entityVal $ signIn)
                   liftIO . runDb . signInTokenToUsed . entityKey $ signIn
                   redirect "/"
     Nothing ->
-      errorResponse "The token is invalid."
+      redirectError "The token is invalid."
+
+redirectError :: Text -> ActionM ()
+redirectError msg =
+  redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]
 
 signOutAction :: ActionM ()
 signOutAction = do