blob: 152168c6e92c2f9f35b62ed40fc87c57cdd7dd6e (
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
48
49
50
51
|
{-# LANGUAGE OverloadedStrings #-}
module Controller.SignIn
( 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 Conf (Conf)
import Model.Message.Key
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 -> Text -> ActionM ()
signIn conf login =
if Email.isValid (TE.encodeUtf8 login)
then do
maybeUser <- liftIO . Query.run $ User.getUser login
case maybeUser of
Just user -> do
token <- liftIO . Query.run $ SignIn.createSignInToken login
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]
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
|
