From 7a1eac4e8662c41f279f447c7a44f3a8974c7581 Mon Sep 17 00:00:00 2001
From: Timo von Holtz <tvh@anchor.com.au>
Date: Tue, 17 Feb 2015 10:05:39 +1100
Subject: [PATCH] Correctly set the content type for ReqBody

---
 servant-client.cabal      |  1 +
 src/Servant/Client.hs     |  3 ++-
 src/Servant/Common/Req.hs | 18 ++++++++++++------
 3 files changed, 15 insertions(+), 7 deletions(-)

diff --git a/servant-client.cabal b/servant-client.cabal
index 2b17dc21..b27e5bc2 100644
--- a/servant-client.cabal
+++ b/servant-client.cabal
@@ -45,6 +45,7 @@ library
     , exceptions
     , http-client
     , http-client-tls
+    , http-media
     , http-types
     , network-uri >= 2.6
     , safe
diff --git a/src/Servant/Client.hs b/src/Servant/Client.hs
index 6a0f4f6b..69a8d71d 100644
--- a/src/Servant/Client.hs
+++ b/src/Servant/Client.hs
@@ -22,6 +22,7 @@ import Data.Proxy
 import Data.String.Conversions
 import Data.Text (unpack)
 import GHC.TypeLits
+import Network.HTTP.Media
 import qualified Network.HTTP.Types as H
 import Servant.API
 import Servant.Common.BaseUrl
@@ -443,7 +444,7 @@ instance (ToJSON a, HasClient sublayout)
 
   clientWithRoute Proxy req body =
     clientWithRoute (Proxy :: Proxy sublayout) $
-      setRQBody (encode body) req
+      setRQBody (encode body) ("application" // "json" /: ("charset", "utf-8")) req
 
 -- | Make the querying function append @path@ to the request path.
 instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
diff --git a/src/Servant/Common/Req.hs b/src/Servant/Common/Req.hs
index da85c02a..0e8cf1c6 100644
--- a/src/Servant/Common/Req.hs
+++ b/src/Servant/Common/Req.hs
@@ -14,12 +14,14 @@ import Data.Aeson.Parser
 import Data.Aeson.Types
 import Data.Attoparsec.ByteString
 import Data.ByteString.Lazy hiding (pack)
+import qualified Data.ByteString.Char8 as BS
 import Data.String
 import Data.String.Conversions
 import Data.Text
 import Data.Text.Encoding
 import Network.HTTP.Client
 import Network.HTTP.Client.TLS
+import Network.HTTP.Media
 import Network.HTTP.Types
 import Network.URI
 import Servant.Common.BaseUrl
@@ -31,12 +33,12 @@ import qualified Network.HTTP.Client as Client
 data Req = Req
   { reqPath  :: String
   , qs       :: QueryText
-  , reqBody  :: ByteString
+  , reqBody  :: Maybe (ByteString, MediaType)
   , headers  :: [(String, Text)]
   }
 
 defReq :: Req
-defReq = Req "" [] "" []
+defReq = Req "" [] Nothing []
 
 appendToPath :: String -> Req -> Req
 appendToPath p req =
@@ -62,8 +64,8 @@ addHeader name val req = req { headers = headers req
                                       ++ [(name, toText val)]
                              }
 
-setRQBody :: ByteString -> Req -> Req
-setRQBody b req = req { reqBody = b }
+setRQBody :: ByteString -> MediaType -> Req -> Req
+setRQBody b t req = req { reqBody = Just (b, t) }
 
 reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
 reqToRequest req (BaseUrl reqScheme reqHost reqPort) =
@@ -80,9 +82,13 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort) =
                              , uriPath = reqPath req
                              }
 
-        setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }
+        setrqb r = case (reqBody req) of
+                     Nothing -> r
+                     Just (b,t) -> r { requestBody = RequestBodyLBS b
+                                     , requestHeaders = [(hContentType, BS.pack . show $ t)] }
         setQS = setQueryString $ queryTextToQuery (qs req)
-        setheaders r = r { requestHeaders = Prelude.map toProperHeader (headers req) }
+        setheaders r = r { requestHeaders = requestHeaders r
+                                         ++ Prelude.map toProperHeader (headers req) }
 
         toProperHeader (name, val) =
           (fromString name, encodeUtf8 val)