{-# LANGUAGE OverloadedStrings #-} module Controller.SignIn ( signInAction , validateSignInAction ) where import Web.Scotty import Network.HTTP.Types.Status (ok200, badRequest400) import Database.Persist 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.Time.Clock (getCurrentTime, diffUTCTime) import qualified LoginSession import Config import SendMail import Text.Email.Validate (isValid) import Model.Database import Model.User import Model.SignIn import Model.Message import qualified View.Mail.SignIn as SignIn signInAction :: Config -> Text -> ActionM () signInAction config login = if isValid (TE.encodeUtf8 login) then do maybeUser <- liftIO . runDb $ getUser login case maybeUser of Just user -> do token <- liftIO . runDb $ createSignInToken login let url = T.concat ["http://", hostname config, "/validateSignIn?token=", token] maybeSentMail <- liftIO . sendMail $ SignIn.getMail (entityVal user) url [login] case maybeSentMail of Right _ -> status ok200 Left _ -> errorResponse "Sorry, we failed to send you the sign up email." Nothing -> errorResponse "You are not authorized to sign in." else errorResponse "Please enter a valid email address." errorResponse :: Text -> ActionM () errorResponse msg = do status badRequest400 json (Message msg) validateSignInAction :: Text -> ActionM () validateSignInAction token = do maybeSignIn <- liftIO . runDb $ getSignInToken token now <- liftIO getCurrentTime case maybeSignIn of Just signIn -> if signInIsUsed . entityVal $ signIn then redirectError "The token has already been used." else let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn) in if diffTime > 2 * 60 -- 2 minutes then redirectError "The token has expired." else do LoginSession.put (signInEmail . entityVal $ signIn) liftIO . runDb . signInTokenToUsed . entityKey $ signIn redirect "/" Nothing -> redirectError "The token is invalid." redirectError :: Text -> ActionM () redirectError msg = redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]