diff options
author | Joris Guyonvarch | 2015-08-08 19:50:58 +0200 |
---|---|---|
committer | Joris Guyonvarch | 2015-08-08 19:50:58 +0200 |
commit | a4f60df0f3b72553380bdd3ca960abf42048ed7e (patch) | |
tree | cf30e45801e68129eb7b1c990b142a412fa98e30 /src/server/Application.hs | |
parent | cd7ca2fcc7a2f4a10235f8807a89c8d6549b99bf (diff) | |
download | budget-a4f60df0f3b72553380bdd3ca960abf42048ed7e.tar.gz budget-a4f60df0f3b72553380bdd3ca960abf42048ed7e.tar.bz2 budget-a4f60df0f3b72553380bdd3ca960abf42048ed7e.zip |
Getting the hostname and the port in config file
Diffstat (limited to 'src/server/Application.hs')
-rw-r--r-- | src/server/Application.hs | 19 |
1 files changed, 10 insertions, 9 deletions
diff --git a/src/server/Application.hs b/src/server/Application.hs index 59aa252..5306e17 100644 --- a/src/server/Application.hs +++ b/src/server/Application.hs @@ -17,7 +17,6 @@ module Application import Web.Scotty import Network.HTTP.Types.Status (ok200, badRequest400) -import Network.Wai (requestHeaderHost) import Database.Persist @@ -29,6 +28,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE import Data.String (fromString) import Data.Time.Clock (getCurrentTime, diffUTCTime) +import Data.Maybe (isJust) import Text.Email.Validate (isValid) @@ -42,20 +42,21 @@ import Model.Payment import Model.SignIn import Model.Message +import Config + import View.Page (page) import Mail -signInAction :: Text -> ActionM () -signInAction login = +signInAction :: Config -> Text -> ActionM () +signInAction config 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 + if isJust maybeUser + then do token <- liftIO . runDb $ createSignInToken login - let url = T.concat ["http://", host ,"/validateSignIn?token=", token] + let url = T.concat ["http://", hostname config, "/validateSignIn?token=", token] let mail = Mail [login] "Sign in" url url maybeSentMail <- liftIO . sendMail $ mail case maybeSentMail of @@ -63,8 +64,8 @@ signInAction login = status ok200 Left _ -> errorResponse "Sorry, we failed to send you the sign up email." - _ -> - errorResponse "You are not authorized to sign in." + else + errorResponse "You are not authorized to sign in." else errorResponse "Please enter a valid email address." |