From b50ca99566fc07c8546eb25921fde89989450a4d Mon Sep 17 00:00:00 2001 From: Evan Rutledge Borden Date: Thu, 24 Jan 2019 09:12:48 -0600 Subject: [PATCH] Deprecate insecure JSON body functions MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit `parseJsonBody` and `requireJsonBody` do not require a mime type when parsing `JSON` content. This leaves them open to CSRF. They are now deprecated and `insecure` versions are added in their place. Consumers are now given a proper choice between secure and insecure functions. There is a potential attack vector in that the browser does not trigger CORS requests for "simple requests", which includes POST requests that are form or text content-types. An attacker can craft a form whose body is valid JSON, and when a user visits attacker.com and submits that form, it can be submitted to bank.com and bypass CORS. Checking the content-type is application/json prevents this, because if the content-type was set to application/json, then the browser would send a CORS request—a preflight OPTIONS request to the server asking if the current domain (and some other values) are whitelisted to send requests to that server. If the server doesn't say attacker.com is whitelisted, the browser will not send the real request to the server. --- yesod-core/Yesod/Core/Json.hs | 66 ++++++++++++++++++--------- yesod-core/test/YesodCoreTest/Json.hs | 2 +- 2 files changed, 45 insertions(+), 23 deletions(-) diff --git a/yesod-core/Yesod/Core/Json.hs b/yesod-core/Yesod/Core/Json.hs index abf9e1dd..3681cf87 100644 --- a/yesod-core/Yesod/Core/Json.hs +++ b/yesod-core/Yesod/Core/Json.hs @@ -10,11 +10,14 @@ module Yesod.Core.Json , provideJson -- * Convert to a JSON value - , parseJsonBody , parseCheckJsonBody + , parseInsecureJsonBody + , requireCheckJsonBody + , requireInsecureJsonBody + -- ** Deprecated JSON conversion + , parseJsonBody , parseJsonBody_ , requireJsonBody - , requireCheckJsonBody -- * Produce JSON values , J.Value (..) @@ -92,51 +95,70 @@ returnJsonEncoding = return . J.toEncoding provideJson :: (Monad m, J.ToJSON a) => a -> Writer (Endo [ProvidedRep m]) () provideJson = provideRep . return . J.toEncoding +-- | Same as 'parseInsecureJsonBody' +-- +-- @since 0.3.0 +parseJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) +parseJsonBody = parseInsecureJsonBody +{-# DEPRECATED parseJsonBody "Use parseCheckJsonBody or parseInsecureJsonBody instead" #-} + +-- | Same as 'parseCheckJsonBody', but does not check that the mime type +-- indicates JSON content. +-- +-- Note: This function is vulnerable to CSRF attacks. +parseInsecureJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) +parseInsecureJsonBody = do + eValue <- runConduit $ rawRequestBody .| runCatchC (sinkParser JP.value') + return $ case eValue of + Left e -> J.Error $ show e + Right value -> J.fromJSON value + -- | Parse the request body to a data type as a JSON value. The -- data type must support conversion from JSON via 'J.FromJSON'. -- If you want the raw JSON value, just ask for a @'J.Result' -- 'J.Value'@. -- +-- The MIME type must indicate JSON content. Requiring a JSON +-- content-type helps secure your site against CSRF attacks +-- (browsers will perform POST requests for form and text/plain +-- content-types without doing a CORS check, and those content-types +-- can easily contain valid JSON). +-- -- Note that this function will consume the request body. As such, calling it -- twice will result in a parse error on the second call, since the request -- body will no longer be available. -- -- @since 0.3.0 -parseJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) -parseJsonBody = do - eValue <- runConduit $ rawRequestBody .| runCatchC (sinkParser JP.value') - return $ case eValue of - Left e -> J.Error $ show e - Right value -> J.fromJSON value - --- | Same as 'parseJsonBody', but ensures that the mime type indicates --- JSON content. parseCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m (J.Result a) parseCheckJsonBody = do mct <- lookupHeader "content-type" case fmap (B8.takeWhile (/= ';')) mct of - Just "application/json" -> parseJsonBody + Just "application/json" -> parseInsecureJsonBody _ -> return $ J.Error $ "Non-JSON content type: " ++ show mct --- | Same as 'parseJsonBody', but return an invalid args response on a parse +-- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse -- error. parseJsonBody_ :: (MonadHandler m, J.FromJSON a) => m a -parseJsonBody_ = requireJsonBody -{-# DEPRECATED parseJsonBody_ "Use requireJsonBody instead" #-} +parseJsonBody_ = requireInsecureJsonBody +{-# DEPRECATED parseJsonBody_ "Use requireCheckJsonBody or requireInsecureJsonBody instead" #-} --- | Same as 'parseJsonBody', but return an invalid args response on a parse +-- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse -- error. requireJsonBody :: (MonadHandler m, J.FromJSON a) => m a -requireJsonBody = do - ra <- parseJsonBody +requireJsonBody = requireInsecureJsonBody +{-# DEPRECATED requireJsonBody "Use requireCheckJsonBody or requireInsecureJsonBody instead" #-} + +-- | Same as 'parseInsecureJsonBody', but return an invalid args response on a parse +-- error. +requireInsecureJsonBody :: (MonadHandler m, J.FromJSON a) => m a +requireInsecureJsonBody = do + ra <- parseInsecureJsonBody case ra of J.Error s -> invalidArgs [pack s] J.Success a -> return a --- | Same as 'requireJsonBody', but ensures that the MIME type --- indicates JSON content. Requiring a JSON content-type helps secure your site against --- CSRF attacks (browsers will perform POST requests for form and text/plain content-types --- without doing a CORS check, and those content-types can easily contain valid JSON). +-- | Same as 'parseCheckJsonBody', but return an invalid args response on a parse +-- error. requireCheckJsonBody :: (MonadHandler m, J.FromJSON a) => m a requireCheckJsonBody = do ra <- parseCheckJsonBody diff --git a/yesod-core/test/YesodCoreTest/Json.hs b/yesod-core/test/YesodCoreTest/Json.hs index a338765e..2997a65a 100644 --- a/yesod-core/test/YesodCoreTest/Json.hs +++ b/yesod-core/test/YesodCoreTest/Json.hs @@ -23,7 +23,7 @@ instance Yesod App getHomeR :: Handler RepPlain getHomeR = do - val <- requireJsonBody + val <- requireInsecureJsonBody case Map.lookup ("foo" :: Text) val of Nothing -> invalidArgs ["foo not found"] Just foo -> return $ RepPlain $ toContent (foo :: Text)