diff options
Diffstat (limited to 'src/server/Application.hs')
-rw-r--r-- | src/server/Application.hs | 30 |
1 files changed, 21 insertions, 9 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs index 75d0323..6a18102 100644 --- a/src/server/Application.hs +++ b/src/server/Application.hs @@ -15,6 +15,7 @@ module Application import Web.Scotty import Network.HTTP.Types.Status (ok200, badRequest400) +import Network.Wai (requestHeaderHost) import Database.Persist @@ -23,8 +24,11 @@ import Control.Monad.IO.Class (liftIO) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as TIO +import qualified Data.Text.Encoding as TE import Data.String (fromString) +import Text.Email.Validate (isValid) + import qualified LoginSession import qualified Secure @@ -33,6 +37,7 @@ import Model.Database import Model.User import Model.Payment import Model.SignIn +import Model.Message import View.Page (page) @@ -73,16 +78,23 @@ createPaymentAction email name cost = do status ok200 signInAction :: Text -> ActionM () -signInAction login = do - maybeUser <- liftIO . runDb $ getUser login - case maybeUser of - Just _ -> do - token <- liftIO . runDb $ createSignInToken login - let url = T.concat ["http://localhost:3000/validateSignIn?token=", token] - liftIO . TIO.putStrLn $ url - status ok200 - Nothing -> +signInAction login = + if isValid (TE.encodeUtf8 login) + then do + maybeUser <- liftIO . runDb $ getUser login + maybeHost <- fmap TE.decodeUtf8 . requestHeaderHost <$> request + case (maybeUser, maybeHost) of + (Just _, Just host) -> do + token <- liftIO . runDb $ createSignInToken login + let url = T.concat ["http://", host ,"/validateSignIn?token=", token] + liftIO . TIO.putStrLn $ url + status ok200 + _ -> do + status badRequest400 + json (Message "You are not authorized to sign in.") + else do status badRequest400 + json (Message "Please enter a valid email address.") validateSignInAction :: Text -> ActionM () validateSignInAction token = do |