Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions yesod-test/ChangeLog.md
Original file line number Diff line number Diff line change
@@ -1,3 +1,9 @@
## 1.5.0.1

* Fixed the `application/x-www-form-urlencoded` header being added to all requests, even those sending a binary POST body [#1064](https://github.com/yesodweb/yesod/pull/1064/files)
* The `application/x-www-form-urlencoded` Content-Type header is now only added if key-value POST parameters are added
* If no key-values pairs are added, or the request body is set with `setRequestBody`, no default Content-Type header is set

## 1.5

* remove deprecated addNonce functions
Expand Down
10 changes: 8 additions & 2 deletions yesod-test/Yesod/Test.hs
Original file line number Diff line number Diff line change
Expand Up @@ -876,8 +876,7 @@ request reqBuilder = do
SRequest simpleRequest' (simpleRequestBody' rbdPostData)
where
simpleRequest' = (mkRequest
[ ("Cookie", cookieValue)
, ("Content-Type", "application/x-www-form-urlencoded")]
([ ("Cookie", cookieValue) ] ++ headersForPostData rbdPostData)
method extraHeaders urlPath urlQuery)
simpleRequestBody' (MultipleItemsPostData x) =
BSL8.fromChunks $ return $ TE.encodeUtf8 $ T.intercalate "&"
Expand All @@ -889,6 +888,13 @@ request reqBuilder = do
singlepartPart (ReqFilePart _ _ _ _) = ""
singlepartPart (ReqKvPart k v) = T.concat [k,"=",v]

-- If the request appears to be submitting a form (has key-value pairs) give it the form-urlencoded Content-Type.
-- The previous behavior was to always use the form-urlencoded Content-Type https://github.com/yesodweb/yesod/issues/1063
headersForPostData (MultipleItemsPostData []) = []
headersForPostData (MultipleItemsPostData _ ) = [("Content-Type", "application/x-www-form-urlencoded")]
headersForPostData (BinaryPostData _ ) = []


-- General request making
mkRequest headers method extraHeaders urlPath urlQuery = defaultRequest
{ requestMethod = method
Expand Down
36 changes: 35 additions & 1 deletion yesod-test/test/main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -18,12 +18,13 @@ import Text.XML
import Data.Text (Text, pack)
import Data.Monoid ((<>))
import Control.Applicative
import Network.Wai (pathInfo)
import Network.Wai (pathInfo, requestHeaders)
import Data.Maybe (fromMaybe)

import Data.ByteString.Lazy.Char8 ()
import qualified Data.Map as Map
import qualified Text.HTML.DOM as HD
import Network.HTTP.Types.Status (unsupportedMediaType415)

parseQuery_ = either error id . parseQuery
findBySelector_ x = either error id . findBySelector x
Expand Down Expand Up @@ -160,6 +161,30 @@ main = hspec $ do
setMethod "POST"
setUrl ("/labels" :: Text)
byLabel "Foo Bar" "yes"
ydescribe "Content-Type handling" $ do
yit "can set a content-type" $ do
request $ do
setUrl ("/checkContentType" :: Text)
addRequestHeader ("Expected-Content-Type","text/plain")
addRequestHeader ("Content-Type","text/plain")
statusIs 200
yit "adds the form-urlencoded Content-Type if you add parameters" $ do
request $ do
setUrl ("/checkContentType" :: Text)
addRequestHeader ("Expected-Content-Type","application/x-www-form-urlencoded")
addPostParam "foo" "foobarbaz"
statusIs 200
yit "defaults to no Content-Type" $ do
get ("/checkContentType" :: Text)
statusIs 200
yit "returns a 415 for the wrong Content-Type" $ do
-- Tests that the test handler is functioning
request $ do
setUrl ("/checkContentType" :: Text)
addRequestHeader ("Expected-Content-Type","application/x-www-form-urlencoded")
addRequestHeader ("Content-Type","text/plain")
statusIs 415

describe "cookies" $ yesodSpec cookieApp $ do
yit "should send the cookie #730" $ do
get ("/" :: Text)
Expand Down Expand Up @@ -225,6 +250,15 @@ app = liteApp $ do
onStatic "labels" $ dispatchTo $
return ("<html><label><input type='checkbox' name='fooname' id='foobar'>Foo Bar</label></html>" :: Text)

onStatic "checkContentType" $ dispatchTo $ do
headers <- requestHeaders <$> waiRequest

let actual = lookup "Content-Type" headers
expected = lookup "Expected-Content-Type" headers

if actual == expected
then return ()
else sendResponseStatus unsupportedMediaType415 ()

cookieApp :: LiteApp
cookieApp = liteApp $ do
Expand Down
1 change: 1 addition & 0 deletions yesod-test/yesod-test.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -60,6 +60,7 @@ test-suite test
, yesod-form
, text
, wai
, http-types

source-repository head
type: git
Expand Down