aboutsummaryrefslogtreecommitdiff
path: root/src/server/Controller/SignIn.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/server/Controller/SignIn.hs')
-rw-r--r--src/server/Controller/SignIn.hs34
1 files changed, 15 insertions, 19 deletions
diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs
index 152168c..932ce53 100644
--- a/src/server/Controller/SignIn.hs
+++ b/src/server/Controller/SignIn.hs
@@ -5,15 +5,17 @@ module Controller.SignIn
) where
import Control.Monad.IO.Class (liftIO)
-import Data.Text (Text)
import Network.HTTP.Types.Status (ok200, badRequest400)
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Lazy as TL
import Web.Scotty
+import qualified Common.Message as Message
+import qualified Common.Message.Key as Key
+import qualified Common.Model.SignIn as M
+
import Conf (Conf)
-import Model.Message.Key
import qualified Conf
import qualified Model.Query as Query
import qualified Model.SignIn as SignIn
@@ -22,30 +24,24 @@ import qualified SendMail
import qualified Text.Email.Validate as Email
import qualified View.Mail.SignIn as SignIn
-signIn :: Conf -> Text -> ActionM ()
-signIn conf login =
- if Email.isValid (TE.encodeUtf8 login)
+signIn :: Conf -> M.SignIn -> ActionM ()
+signIn conf (M.SignIn email) =
+ if Email.isValid (TE.encodeUtf8 email)
then do
- maybeUser <- liftIO . Query.run $ User.getUser login
+ maybeUser <- liftIO . Query.run $ User.get email
case maybeUser of
Just user -> do
- token <- liftIO . Query.run $ SignIn.createSignInToken login
+ 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 [login]
+ maybeSentMail <- liftIO . SendMail.sendMail $ SignIn.mail conf user url [email]
case maybeSentMail of
- Right _ ->
- status ok200
- Left _ -> do
- status badRequest400
- text . TL.pack . show $ SendEmailFail
- Nothing -> do
- status badRequest400
- text . TL.pack . show $ UnauthorizedSignIn
- else do
- status badRequest400
- text . TL.pack . show $ EnterValidEmail
+ Right _ -> textKey ok200 Key.SignIn_EmailSent
+ Left _ -> textKey badRequest400 Key.SignIn_EmailSendFail
+ Nothing -> textKey badRequest400 Key.Secure_Unauthorized
+ else textKey badRequest400 Key.SignIn_EmailInvalid
+ where textKey st key = status st >> (text . TL.fromStrict $ Message.get key)