From bc04d120ec39efce41f3130f59f758fd39d3ee99 Mon Sep 17 00:00:00 2001 From: Andres Loeh Date: Thu, 12 Jan 2017 12:01:36 +0100 Subject: [PATCH] Allow more flexbility in setting the request body. Rather than hard-coding the `RequestBodyLBS` constructor and be limited to lazy bytestrings, the new function `setReqBody` just takes any value of type `RequestBody`. The old function `setRQBody` has been renamed to `setReqBodyLBS`. The old name is still available, but deprecated. The change has the advantage the we can define new servant API combinators that use streaming request bodies such as for example constructed by the `streamFile` function in http-client. The behaviour for the existing `ReqBody` API combinator is unaffected by this change. --- servant-client/servant-client.cabal | 2 +- servant-client/src/Servant/Client.hs | 2 +- servant-client/src/Servant/Common/Req.hs | 29 +++++++++++++++++++++--- 3 files changed, 28 insertions(+), 5 deletions(-) diff --git a/servant-client/servant-client.cabal b/servant-client/servant-client.cabal index 65983a3d..10ea1d6e 100644 --- a/servant-client/servant-client.cabal +++ b/servant-client/servant-client.cabal @@ -1,5 +1,5 @@ name: servant-client -version: 0.9.1.1 +version: 0.9.2.0 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that diff --git a/servant-client/src/Servant/Client.hs b/servant-client/src/Servant/Client.hs index e77c1f16..d6084edf 100644 --- a/servant-client/src/Servant/Client.hs +++ b/servant-client/src/Servant/Client.hs @@ -406,7 +406,7 @@ instance (MimeRender ct a, HasClient api) clientWithRoute Proxy req body = clientWithRoute (Proxy :: Proxy api) (let ctProxy = Proxy :: Proxy ct - in setRQBody (mimeRender ctProxy body) + in setReqBodyLBS (mimeRender ctProxy body) -- We use first contentType from the Accept list (contentType ctProxy) req diff --git a/servant-client/src/Servant/Common/Req.hs b/servant-client/src/Servant/Common/Req.hs index 57471967..3a880b5e 100644 --- a/servant-client/src/Servant/Common/Req.hs +++ b/servant-client/src/Servant/Common/Req.hs @@ -87,7 +87,7 @@ instance Exception ServantError data Req = Req { reqPath :: String , qs :: QueryText - , reqBody :: Maybe (ByteString, MediaType) + , reqBody :: Maybe (RequestBody, MediaType) , reqAccept :: [MediaType] , headers :: [(String, Text)] } @@ -112,8 +112,31 @@ addHeader name val req = req { headers = headers req ++ [(name, decodeUtf8 (toHeader val))] } +-- | Set body and media type of the request being constructed. +-- +-- The body is set to the given bytestring using the 'RequestBodyLBS' +-- constructor. +-- +{-# DEPRECATED setRQBody "Use setReqBodyLBS instead" #-} setRQBody :: ByteString -> MediaType -> Req -> Req -setRQBody b t req = req { reqBody = Just (b, t) } +setRQBody = setReqBodyLBS + +-- | Set body and media type of the request being constructed. +-- +-- The body is set to the given bytestring using the 'RequestBodyLBS' +-- constructor. +-- +-- @since 0.9.2.0 +-- +setReqBodyLBS :: ByteString -> MediaType -> Req -> Req +setReqBodyLBS b t req = req { reqBody = Just (RequestBodyLBS b, t) } + +-- | Set body and media type of the request being constructed. +-- +-- @since 0.9.2.0 +-- +setReqBody :: RequestBody -> MediaType -> Req -> Req +setReqBody b t req = req { reqBody = Just (b, t) } reqToRequest :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = @@ -132,7 +155,7 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = setrqb r = case reqBody req of Nothing -> r - Just (b,t) -> r { requestBody = RequestBodyLBS b + Just (b,t) -> r { requestBody = b , requestHeaders = requestHeaders r ++ [(hContentType, cs . show $ t)] } setQS = setQueryString $ queryTextToQuery (qs req)