diff options
Diffstat (limited to 'server/src/Controller/SignIn.hs')
| -rw-r--r-- | server/src/Controller/SignIn.hs | 44 |
1 files changed, 0 insertions, 44 deletions
diff --git a/server/src/Controller/SignIn.hs b/server/src/Controller/SignIn.hs deleted file mode 100644 index cf92c9f..0000000 --- a/server/src/Controller/SignIn.hs +++ /dev/null @@ -1,44 +0,0 @@ -module Controller.SignIn - ( signIn - ) where - -import Control.Monad.IO.Class (liftIO) -import qualified Data.Text as T -import qualified Data.Text.Encoding as TE -import qualified Data.Text.Lazy as TL -import Network.HTTP.Types.Status (badRequest400, ok200) -import Web.Scotty - -import Common.Model (SignIn (..)) -import qualified Common.Msg as Msg - -import Conf (Conf) -import qualified Conf -import qualified Model.Query as Query -import qualified Model.SignIn as SignIn -import qualified Model.User as User -import qualified SendMail -import qualified Text.Email.Validate as Email -import qualified View.Mail.SignIn as SignIn - -signIn :: Conf -> SignIn -> ActionM () -signIn conf (SignIn email) = - if Email.isValid (TE.encodeUtf8 email) - then do - maybeUser <- liftIO . Query.run $ User.get email - case maybeUser of - Just user -> do - token <- liftIO . Query.run $ SignIn.createSignInToken email - let url = T.concat [ - if Conf.https conf then "https://" else "http://", - Conf.hostname conf, - "?signInToken=", - token - ] - maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email] - case maybeSentMail of - Right _ -> textKey ok200 Msg.SignIn_EmailSent - Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail - Nothing -> textKey badRequest400 Msg.Secure_Unauthorized - else textKey badRequest400 Msg.SignIn_EmailInvalid - where textKey st key = status st >> (text . TL.fromStrict $ Msg.get key) |