haskell/yesod
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Use checkCsrfHeaderOrParam instead of manual check

Browse Source
This commit is contained in:
Sibi Prabakaran 2016-11-20 13:32:15 +05:30
parent 7f17d829b3
commit 10850f5cee
No known key found for this signature in database
GPG Key ID: D19E3E0EBB557613
1 changed files with 5 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
yesod-auth/Yesod/Auth/Email.hs
View File

@ -5,7 +5,6 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE Rank2Types #-} {-# LANGUAGE Rank2Types #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DoAndIfThenElse #-}
-- | A Yesod plugin for Authentication via e-mail -- | A Yesod plugin for Authentication via e-mail
-- --
-- This plugin works out of the box by only setting a few methods on the type class -- This plugin works out of the box by only setting a few methods on the type class
@ -72,7 +71,6 @@ import Safe (readMay)
import System.IO.Unsafe (unsafePerformIO) import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Email.Validate import qualified Text.Email.Validate
loginR, registerR, forgotPasswordR, setpassR :: AuthRoute loginR, registerR, forgotPasswordR, setpassR :: AuthRoute
loginR = PluginR "email" ["login"] loginR = PluginR "email" ["login"]
registerR = PluginR "email" ["register"] registerR = PluginR "email" ["register"]
@ -386,20 +384,17 @@ registerHelper allowUsername dest = do
y <- lift getYesod y <- lift getYesod
req <- getRequest req <- getRequest
midentifier <- lookupPostParam "email" midentifier <- lookupPostParam "email"
csrfToken <- lookupPostParam "_token" checkCsrfHeaderOrParam defaultCsrfHeaderName defaultCsrfParamName
if (csrfToken /= reqToken req) let eidentifier = case midentifier of
then permissionDenied csrfErrorMessage
else do
let eidentifier = case midentifier of
Nothing -> Left Msg.NoIdentifierProvided Nothing -> Left Msg.NoIdentifierProvided
Just x Just x
| Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) -> | Just x' <- Text.Email.Validate.canonicalizeEmail (encodeUtf8 x) ->
Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x' Right $ normalizeEmailAddress y $ decodeUtf8With lenientDecode x'
| allowUsername -> Right $ TS.strip x | allowUsername -> Right $ TS.strip x
| otherwise -> Left Msg.InvalidEmailAddress | otherwise -> Left Msg.InvalidEmailAddress
case eidentifier of case eidentifier of
Left route -> loginErrorMessageI dest route Left route -> loginErrorMessageI dest route
Right identifier -> do Right identifier -> do
mecreds <- lift $ getEmailCreds identifier mecreds <- lift $ getEmailCreds identifier
registerCreds <- registerCreds <-
case mecreds of case mecreds of
@ -713,10 +708,6 @@ setLoginLinkKey aid = do
now <- liftIO getCurrentTime now <- liftIO getCurrentTime
setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now) setSession loginLinkKey $ TS.pack $ show (toPathPiece aid, now)
csrfErrorMessage :: Text
csrfErrorMessage = "A valid CSRF token wasn't present in HTTP headers or POST parameters. Because the request could have been forged, it's been rejected altogether. Check the Yesod.Core.Handler docs of the yesod-core package for details on CSRF protection."
-- See https://github.com/yesodweb/yesod/issues/1245 for discussion on this -- See https://github.com/yesodweb/yesod/issues/1245 for discussion on this
-- use of unsafePerformIO. -- use of unsafePerformIO.
defaultNonceGen :: Nonce.Generator defaultNonceGen :: Nonce.Generator