{-# 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.Json.Message import Model.Message.Key import Model.Message (getMessage) 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 (getMessage SendEmailFail) Nothing -> errorResponse (getMessage Unauthorized) else errorResponse (getMessage EnterValidEmail) errorResponse :: Text -> ActionM () errorResponse msg = do status badRequest400 json (Message msg) validateSignInAction :: Config -> Text -> ActionM () validateSignInAction config token = do maybeSignIn <- liftIO . runDb $ getSignInToken token now <- liftIO getCurrentTime case maybeSignIn of Just signIn -> if signInIsUsed . entityVal $ signIn then redirectError (getMessage SignInUsed) else let diffTime = now `diffUTCTime` (signInCreation . entityVal $ signIn) in if diffTime > (fromIntegral $ (signInExpirationMn config) * 60) then redirectError (getMessage SignInExpired) else do LoginSession.put (signInEmail . entityVal $ signIn) liftIO . runDb . signInTokenToUsed . entityKey $ signIn redirect "/" Nothing -> redirectError (getMessage SignInInvalid) redirectError :: Text -> ActionM () redirectError msg = redirect . TL.fromStrict . T.concat $ ["/?signInError=", msg]