diff options
| author | Joris | 2016-03-31 18:45:36 +0200 |
|---|---|---|
| committer | Joris | 2016-03-31 18:46:23 +0200 |
| commit | 01e4ce0fa7c369996ec4ef3a033d16d6fa0eb715 (patch) | |
| tree | 5a81013be23c3f368fc7e6e1a0a41008a269d0fc /src/server/Controller | |
| parent | 84f53fac431df20afd54817cca14260f1202e9ff (diff) | |
Use https link and secure cookie when activated
Diffstat (limited to 'src/server/Controller')
| -rw-r--r-- | src/server/Controller/Index.hs | 8 | ||||
| -rw-r--r-- | src/server/Controller/SignIn.hs | 10 |
2 files changed, 11 insertions, 7 deletions
diff --git a/src/server/Controller/Index.hs b/src/server/Controller/Index.hs index f84f945..1e1f942 100644 --- a/src/server/Controller/Index.hs +++ b/src/server/Controller/Index.hs @@ -69,7 +69,7 @@ validateSignIn conf textToken = do then return . Left $ SignInExpired else do - LoginSession.put (signInToken . entityVal $ signInValue) + LoginSession.put conf (signInToken . entityVal $ signInValue) mbUser <- liftIO . runDb $ do signInTokenToUsed . entityKey $ signInValue getUser . signInEmail . entityVal $ signInValue @@ -86,7 +86,5 @@ getLoggedUser = do Just token -> do liftIO . runDb . getUserFromToken $ token -signOut :: ActionM () -signOut = do - LoginSession.delete - status ok200 +signOut :: Conf -> ActionM () +signOut conf = LoginSession.delete conf >> status ok200 diff --git a/src/server/Controller/SignIn.hs b/src/server/Controller/SignIn.hs index f6804e1..0fbe7c5 100644 --- a/src/server/Controller/SignIn.hs +++ b/src/server/Controller/SignIn.hs @@ -17,7 +17,8 @@ import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Encoding as TE -import Conf +import Conf (Conf) +import qualified Conf import SendMail @@ -38,7 +39,12 @@ signIn conf login = case maybeUser of Just user -> do token <- liftIO . runDb $ createSignInToken login - let url = T.concat ["http://", hostname conf, "?signInToken=", token] + let url = T.concat [ + if Conf.https conf then "https://" else "http://", + Conf.hostname conf, + "?signInToken=", + token + ] maybeSentMail <- liftIO . sendMail $ SignIn.getMail conf (entityVal user) url [login] case maybeSentMail of Right _ -> |