blob: 0086fa51aca52154c660a98c2550bb671d4da972 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
|
{-# LANGUAGE OverloadedStrings #-}
module Controller.SignIn
( signIn
) where
import Control.Monad.IO.Class (liftIO)
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 Common.Model (SignIn(..))
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 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)
|
