eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Correctly set the content type for ReqBody

Browse source
This commit is contained in:
Timo von Holtz 2015-02-17 10:05:39 +11:00
parent 8ef4b5dbcc
commit 7a1eac4e86
3 changed files with 15 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
servant-client.cabal
View file

@ -45,6 +45,7 @@ library
, exceptions , exceptions
, http-client , http-client
, http-client-tls , http-client-tls
, http-media
, http-types , http-types
, network-uri >= 2.6 , network-uri >= 2.6
, safe , safe

3
src/Servant/Client.hs
View file

@ -22,6 +22,7 @@ import Data.Proxy
import Data.String.Conversions import Data.String.Conversions
import Data.Text (unpack) import Data.Text (unpack)
import GHC.TypeLits import GHC.TypeLits
import Network.HTTP.Media
import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types as H
import Servant.API import Servant.API
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
@ -443,7 +444,7 @@ instance (ToJSON a, HasClient sublayout)
clientWithRoute Proxy req body = clientWithRoute Proxy req body =
clientWithRoute (Proxy :: Proxy sublayout) $ 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. -- | Make the querying function append @path@ to the request path.
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

18
src/Servant/Common/Req.hs
View file

@ -14,12 +14,14 @@ import Data.Aeson.Parser
import Data.Aeson.Types import Data.Aeson.Types
import Data.Attoparsec.ByteString import Data.Attoparsec.ByteString
import Data.ByteString.Lazy hiding (pack) import Data.ByteString.Lazy hiding (pack)
import qualified Data.ByteString.Char8 as BS
import Data.String import Data.String
import Data.String.Conversions import Data.String.Conversions
import Data.Text import Data.Text
import Data.Text.Encoding import Data.Text.Encoding
import Network.HTTP.Client import Network.HTTP.Client
import Network.HTTP.Client.TLS import Network.HTTP.Client.TLS
import Network.HTTP.Media
import Network.HTTP.Types import Network.HTTP.Types
import Network.URI import Network.URI
import Servant.Common.BaseUrl import Servant.Common.BaseUrl
@ -31,12 +33,12 @@ import qualified Network.HTTP.Client as Client
data Req = Req data Req = Req
{ reqPath :: String { reqPath :: String
, qs :: QueryText , qs :: QueryText
, reqBody :: ByteString , reqBody :: Maybe (ByteString, MediaType)
, headers :: [(String, Text)] , headers :: [(String, Text)]
} }
defReq :: Req defReq :: Req
defReq = Req "" [] "" [] defReq = Req "" [] Nothing []
appendToPath :: String -> Req -> Req appendToPath :: String -> Req -> Req
appendToPath p req = appendToPath p req =
@ -62,8 +64,8 @@ addHeader name val req = req { headers = headers req
++ [(name, toText val)] ++ [(name, toText val)]
} }
setRQBody :: ByteString -> Req -> Req setRQBody :: ByteString -> MediaType -> Req -> Req
setRQBody b req = req { reqBody = b } setRQBody b t req = req { reqBody = Just (b, t) }
reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
reqToRequest req (BaseUrl reqScheme reqHost reqPort) = reqToRequest req (BaseUrl reqScheme reqHost reqPort) =
@ -80,9 +82,13 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort) =
, uriPath = reqPath req , 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) 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) = toProperHeader (name, val) =
(fromString name, encodeUtf8 val) (fromString name, encodeUtf8 val)