yesod-core 1.4.37.1 → 1.4.37.2
raw patch · 3 files changed
+51/−17 lines, 3 files
Files
- ChangeLog.md +6/−1
- Yesod/Core/Handler.hs +44/−15
- yesod-core.cabal +1/−1
ChangeLog.md view
@@ -1,5 +1,10 @@+## 1.4.37.2++* Improve error messages for the CSRF checking functions [#1455](https://github.com/yesodweb/yesod/issues/1455)+ ## 1.4.37.1-* Fix documentation on `languages` function, update `getMessageRender` to use said function. [#1457] (https://github.com/yesodweb/yesod/pull/1457)++* Fix documentation on `languages` function, update `getMessageRender` to use said function. [#1457](https://github.com/yesodweb/yesod/pull/1457) ## 1.4.37
Yesod/Core/Handler.hs view
@@ -242,7 +242,7 @@ import Yesod.Routes.Class (Route) import Blaze.ByteString.Builder (Builder) import Safe (headMay)-import Data.CaseInsensitive (CI)+import Data.CaseInsensitive (CI, original) import qualified Data.Conduit.List as CL import Control.Monad.Trans.Resource (MonadResource, InternalState, runResourceT, withInternalState, getInternalState, liftResourceT, resourceForkIO) import qualified System.PosixCompat.Files as PC@@ -1501,18 +1501,22 @@ -- @since 1.4.14 checkCsrfHeaderNamed :: MonadHandler m => CI S8.ByteString -> m () checkCsrfHeaderNamed headerName = do- valid <- hasValidCsrfHeaderNamed headerName- unless valid (permissionDenied csrfErrorMessage)+ (valid, mHeader) <- hasValidCsrfHeaderNamed' headerName+ unless valid (permissionDenied $ csrfErrorMessage [CSRFHeader (decodeUtf8 $ original headerName) mHeader]) -- | Takes a header name to lookup a CSRF token, and returns whether the value matches the token stored in the session. -- -- @since 1.4.14 hasValidCsrfHeaderNamed :: MonadHandler m => CI S8.ByteString -> m Bool-hasValidCsrfHeaderNamed headerName = do+hasValidCsrfHeaderNamed headerName = fst <$> hasValidCsrfHeaderNamed' headerName++-- | Like 'hasValidCsrfHeaderNamed', but also returns the header value to be used in error messages.+hasValidCsrfHeaderNamed' :: MonadHandler m => CI S8.ByteString -> m (Bool, Maybe Text)+hasValidCsrfHeaderNamed' headerName = do mCsrfToken <- reqToken <$> getRequest mXsrfHeader <- lookupHeader headerName - return $ validCsrf mCsrfToken mXsrfHeader+ return $ (validCsrf mCsrfToken mXsrfHeader, decodeUtf8 <$> mXsrfHeader) -- CSRF Parameter checking @@ -1528,18 +1532,22 @@ -- @since 1.4.14 checkCsrfParamNamed :: MonadHandler m => Text -> m () checkCsrfParamNamed paramName = do- valid <- hasValidCsrfParamNamed paramName- unless valid (permissionDenied csrfErrorMessage)+ (valid, mParam) <- hasValidCsrfParamNamed' paramName+ unless valid (permissionDenied $ csrfErrorMessage [CSRFParam paramName mParam]) -- | Takes a POST parameter name to lookup a CSRF token, and returns whether the value matches the token stored in the session. -- -- @since 1.4.14 hasValidCsrfParamNamed :: MonadHandler m => Text -> m Bool-hasValidCsrfParamNamed paramName = do+hasValidCsrfParamNamed paramName = fst <$> hasValidCsrfParamNamed' paramName++-- | Like 'hasValidCsrfParamNamed', but also returns the param value to be used in error messages.+hasValidCsrfParamNamed' :: MonadHandler m => Text -> m (Bool, Maybe Text)+hasValidCsrfParamNamed' paramName = do mCsrfToken <- reqToken <$> getRequest mCsrfParam <- lookupPostParam paramName - return $ validCsrf mCsrfToken (encodeUtf8 <$> mCsrfParam)+ return $ (validCsrf mCsrfToken (encodeUtf8 <$> mCsrfParam), mCsrfParam) -- | Checks that a valid CSRF token is present in either the request headers or POST parameters. -- If the value doesn't match the token stored in the session, this function throws a 'PermissionDenied' error.@@ -1550,11 +1558,12 @@ -> Text -- ^ The POST parameter name to lookup the CSRF token -> m () checkCsrfHeaderOrParam headerName paramName = do- validHeader <- hasValidCsrfHeaderNamed headerName- validParam <- hasValidCsrfParamNamed paramName+ (validHeader, mHeader) <- hasValidCsrfHeaderNamed' headerName+ (validParam, mParam) <- hasValidCsrfParamNamed' paramName unless (validHeader || validParam) $ do- $logWarnS "yesod-core" csrfErrorMessage- permissionDenied csrfErrorMessage+ let errorMessage = csrfErrorMessage $ [CSRFHeader (decodeUtf8 $ original headerName) mHeader, CSRFParam paramName mParam]+ $logWarnS "yesod-core" errorMessage+ permissionDenied errorMessage validCsrf :: Maybe Text -> Maybe S.ByteString -> Bool -- It's important to use constant-time comparison (constEqBytes) in order to avoid timing attacks.@@ -1562,5 +1571,25 @@ validCsrf Nothing _param = True validCsrf (Just _token) Nothing = False -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."+data CSRFExpectation = CSRFHeader Text (Maybe Text) -- Key/Value+ | CSRFParam Text (Maybe Text) -- Key/Value++csrfErrorMessage :: [CSRFExpectation]+ -> Text -- ^ Error message+csrfErrorMessage expectedLocations = T.intercalate "\n"+ [ "A valid CSRF token wasn't present. Because the request could have been forged, it's been rejected altogether."+ , "If you're a developer of this site, these tips will help you debug the issue:"+ , "- Read the Yesod.Core.Handler docs of the yesod-core package for details on CSRF protection."+ , "- Check that your HTTP client is persisting cookies between requests, like a browser does."+ , "- By default, the CSRF token is sent to the client in a cookie named " `mappend` (decodeUtf8 defaultCsrfCookieName) `mappend` "."+ , "- The server is looking for the token in the following locations:\n" `mappend` T.intercalate "\n" (map csrfLocation expectedLocations)+ ]++ where csrfLocation expected = case expected of+ CSRFHeader k v -> T.intercalate " " [" - An HTTP header named", k, (formatValue v)]+ CSRFParam k v -> T.intercalate " " [" - A POST parameter named", k, (formatValue v)]++ formatValue :: Maybe Text -> Text+ formatValue maybeText = case maybeText of+ Nothing -> "(which is not currently set)"+ Just t -> T.concat ["(which has the current, incorrect value: '", t, "')"]
yesod-core.cabal view
@@ -1,5 +1,5 @@ name: yesod-core-version: 1.4.37.1+version: 1.4.37.2 license: MIT license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>