7a1eac4 · servant · git.iko.soy

git.iko.soy/servant

on master help sign in

Correctly set the content type for ReqBody

7a1eac4Timo von Holtz12 years ago

servant-client.cabal+1

compare with master

unifiedsplit

@@ -45,6 +45,7 @@ library

45 , exceptions

46 , http-client

47 , http-client-tls

48+ , http-media

48 , http-types

49 , http-types

49 , network-uri >= 2.6

50 , network-uri >= 2.6

50 , safe

51 , safe

src/Servant/Client.hs+2−1

@@ -22,6 +22,7 @@ import Data.Proxy

22import Data.String.Conversions

23import Data.Text (unpack)

24import GHC.TypeLits

25+import Network.HTTP.Media

25import qualified Network.HTTP.Types as H

26import qualified Network.HTTP.Types as H

26import Servant.API

27import Servant.API

27import Servant.Common.BaseUrl

28import Servant.Common.BaseUrl

@@ -443,7 +444,7 @@ instance (ToJSON a, HasClient sublayout)

443

444

444 clientWithRoute Proxy req body =

445 clientWithRoute Proxy req body =

445 clientWithRoute (Proxy :: Proxy sublayout) $

446 clientWithRoute (Proxy :: Proxy sublayout) $

446− setRQBody (encode body) req

447+ setRQBody (encode body) ("application" // "json" /: ("charset", "utf-8")) req

447

448

448-- | Make the querying function append @path@ to the request path.

449-- | Make the querying function append @path@ to the request path.

449instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

450instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where

src/Servant/Common/Req.hs+12−6

@@ -14,12 +14,14 @@ import Data.Aeson.Parser

14import Data.Aeson.Types

15import Data.Attoparsec.ByteString

16import Data.ByteString.Lazy hiding (pack)

17+import qualified Data.ByteString.Char8 as BS

17import Data.String

18import Data.String

18import Data.String.Conversions

19import Data.String.Conversions

19import Data.Text

20import Data.Text

20import Data.Text.Encoding

21import Data.Text.Encoding

21import Network.HTTP.Client

22import Network.HTTP.Client

22import Network.HTTP.Client.TLS

23import Network.HTTP.Client.TLS

24+import Network.HTTP.Media

23import Network.HTTP.Types

25import Network.HTTP.Types

24import Network.URI

26import Network.URI

25import Servant.Common.BaseUrl

27import Servant.Common.BaseUrl

@@ -31,12 +33,12 @@ import qualified Network.HTTP.Client as Client

31data Req = Req

33data Req = Req

32 { reqPath :: String

34 { reqPath :: String

33 , qs :: QueryText

35 , qs :: QueryText

34− , reqBody :: ByteString

36+ , reqBody :: Maybe (ByteString, MediaType)

35 , headers :: [(String, Text)]

37 , headers :: [(String, Text)]

36 }

38 }

38defReq :: Req

40defReq :: Req

39−defReq = Req "" [] "" []

41+defReq = Req "" [] Nothing []

41appendToPath :: String -> Req -> Req

43appendToPath :: String -> Req -> Req

42appendToPath p req =

44appendToPath p req =

@@ -62,8 +64,8 @@ addHeader name val req = req { headers = headers req

62 ++ [(name, toText val)]

64 ++ [(name, toText val)]

63 }

65 }

65−setRQBody :: ByteString -> Req -> Req

67+setRQBody :: ByteString -> MediaType -> Req -> Req

66−setRQBody b req = req { reqBody = b }

68+setRQBody b t req = req { reqBody = Just (b, t) }

68reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

70reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request

69reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

71reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

@@ -80,9 +82,13 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort) =

80 , uriPath = reqPath req

82 , uriPath = reqPath req

81 }

83 }

85+ setrqb r = case (reqBody req) of

86+ Nothing -> r

83− setrqb r = r { requestBody = RequestBodyLBS (reqBody req) }

87+ Just (b,t) -> r { requestBody = RequestBodyLBS b

88+ , requestHeaders = [(hContentType, BS.pack . show $ t)] }

84 setQS = setQueryString $ queryTextToQuery (qs req)

89 setQS = setQueryString $ queryTextToQuery (qs req)

90+ setheaders r = r { requestHeaders = requestHeaders r

85− setheaders r = r { requestHeaders = Prelude.map toProperHeader (headers req) }

91+ ++ Prelude.map toProperHeader (headers req) }

87 toProperHeader (name, val) =

93 toProperHeader (name, val) =

88 (fromString name, encodeUtf8 val)

94 (fromString name, encodeUtf8 val)