Merge pull request #661 from kosmikus/pr/servant-client-streaming-request-body

servant-client: generalize the function to set the request body
This commit is contained in:
Alp Mestanogullari 2017-01-12 15:58:03 +01:00 committed by GitHub
commit eac364e98c
3 changed files with 28 additions and 5 deletions

View file

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

View file

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

View file

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