b50ca99566
`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.
57 lines
1.5 KiB
Haskell
57 lines
1.5 KiB
Haskell
{-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, TypeFamilies, MultiParamTypeClasses, ViewPatterns #-}
|
|
module YesodCoreTest.Json
|
|
( specs
|
|
, Widget
|
|
, resourcesApp
|
|
) where
|
|
|
|
import Yesod.Core
|
|
import Test.Hspec
|
|
import qualified Data.Map as Map
|
|
import Network.Wai.Test
|
|
import Data.Text (Text)
|
|
import Data.ByteString.Lazy (ByteString)
|
|
|
|
data App = App
|
|
|
|
mkYesod "App" [parseRoutes|
|
|
/ HomeR GET
|
|
/has-multiple-pieces/#Int/#Int MultiplePiecesR GET
|
|
|]
|
|
|
|
instance Yesod App
|
|
|
|
getHomeR :: Handler RepPlain
|
|
getHomeR = do
|
|
val <- requireInsecureJsonBody
|
|
case Map.lookup ("foo" :: Text) val of
|
|
Nothing -> invalidArgs ["foo not found"]
|
|
Just foo -> return $ RepPlain $ toContent (foo :: Text)
|
|
|
|
getMultiplePiecesR :: Int -> Int -> Handler ()
|
|
getMultiplePiecesR _ _ = return ()
|
|
|
|
test :: String
|
|
-> ByteString
|
|
-> (SResponse -> Session ())
|
|
-> Spec
|
|
test name rbody f = it name $ do
|
|
app <- toWaiApp App
|
|
flip runSession app $ do
|
|
sres <- srequest SRequest
|
|
{ simpleRequest = defaultRequest
|
|
, simpleRequestBody = rbody
|
|
}
|
|
f sres
|
|
|
|
specs :: Spec
|
|
specs = describe "Yesod.Json" $ do
|
|
test "parses valid content" "{\"foo\":\"bar\"}" $ \sres -> do
|
|
assertStatus 200 sres
|
|
assertBody "bar" sres
|
|
test "400 for bad JSON" "{\"foo\":\"bar\"" $ \sres -> do
|
|
assertStatus 400 sres
|
|
test "400 for bad structure" "{\"foo2\":\"bar\"}" $ \sres -> do
|
|
assertStatus 400 sres
|
|
assertBodyContains "foo not found" sres
|