diff options
Diffstat (limited to 'server/src/Controller/Index.hs')
| -rw-r--r-- | server/src/Controller/Index.hs | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/server/src/Controller/Index.hs b/server/src/Controller/Index.hs index 0b276d3..fbda527 100644 --- a/server/src/Controller/Index.hs +++ b/server/src/Controller/Index.hs @@ -9,18 +9,18 @@ import Control.Monad.IO.Class (liftIO) import qualified Data.Aeson as Json import Data.Text (Text) import qualified Data.Text as T -import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import Data.Time.Clock (diffUTCTime, getCurrentTime) -import Network.HTTP.Types.Status (badRequest400, ok200) +import qualified Network.HTTP.Types.Status as Status import Prelude hiding (error) import Web.Scotty (ActionM) import qualified Web.Scotty as S -import Common.Model (InitResult (..), SignIn (..), - User (..)) +import Common.Model (Email (..), InitResult (..), + SignInForm (..), User (..)) import Common.Msg (Key) import qualified Common.Msg as Msg +import qualified Common.Validation.SignIn as SignInValidation import Conf (Conf (..)) import qualified LoginSession @@ -30,7 +30,6 @@ import qualified Persistence.Init as InitPersistence import qualified Persistence.User as UserPersistence import qualified Secure import qualified SendMail -import qualified Text.Email.Validate as Email import qualified View.Mail.SignIn as SignIn import View.Page (page) @@ -45,10 +44,12 @@ get conf = do liftIO . Query.run . fmap InitSuccess $ InitPersistence.getInit user conf S.html $ page initResult -askSignIn :: Conf -> SignIn -> ActionM () -askSignIn conf (SignIn email) = - if Email.isValid (TE.encodeUtf8 email) - then do +askSignIn :: Conf -> SignInForm -> ActionM () +askSignIn conf form = + case SignInValidation.signIn form of + Nothing -> + textKey Status.badRequest400 Msg.SignIn_EmailInvalid + Just (Email email) -> do maybeUser <- liftIO . Query.run $ UserPersistence.get email case maybeUser of Just user -> do @@ -62,9 +63,8 @@ askSignIn conf (SignIn email) = maybeSentMail <- liftIO . SendMail.sendMail conf $ SignIn.mail conf user url [email] case maybeSentMail of Right _ -> S.json (Json.String . Msg.get $ Msg.SignIn_EmailSent) - Left _ -> textKey badRequest400 Msg.SignIn_EmailSendFail - Nothing -> textKey badRequest400 Msg.Secure_Unauthorized - else textKey badRequest400 Msg.SignIn_EmailInvalid + Left _ -> textKey Status.badRequest400 Msg.SignIn_EmailSendFail + Nothing -> textKey Status.badRequest400 Msg.Secure_Unauthorized where textKey st key = S.status st >> (S.text . TL.fromStrict $ Msg.get key) trySignIn :: Conf -> Text -> ActionM () @@ -116,4 +116,4 @@ getLoggedUser = do liftIO . Query.run . Secure.getUserFromToken $ token signOut :: Conf -> ActionM () -signOut conf = LoginSession.delete conf >> S.status ok200 +signOut conf = LoginSession.delete conf >> S.status Status.ok200 |