yesod-test: have request not default to the form-urlencoded Content-Type

* Only set the Content-Type to "application/x-www-form-urlencoded" if key-value pairs are added
* Previously the "application/x-www-form-urlencoded" Content-Type would be added even if you set a binary request body.
	* You could add your own Content-Type with addRequestHeader, but this resulted in multiple Content-Type headers.
* Closes #1063

yesod-test/ChangeLog.md

@@ -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

yesod-test/Yesod/Test.hs

@@ -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 "&"
@@ -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

yesod-test/test/main.hs

@@ -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
@@ -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)
@@ -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

yesod-test/yesod-test.cabal

@@ -60,6 +60,7 @@ test-suite test
                           , yesod-form
                           , text
                           , wai
+                          , http-types
 
 source-repository head
   type: git