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

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

2
servant-client/servant-client.cabal
View file

@ -1,5 +1,5 @@
name: servant-client name: servant-client
version: 0.9.1.1 version: 0.9.2.0
synopsis: automatical derivation of querying functions for servant webservices synopsis: automatical derivation of querying functions for servant webservices
description: description:
This library lets you derive automatically Haskell functions that This library lets you derive automatically Haskell functions that

2
servant-client/src/Servant/Client.hs
View file

@ -406,7 +406,7 @@ instance (MimeRender ct a, HasClient api)
clientWithRoute Proxy req body = clientWithRoute Proxy req body =
clientWithRoute (Proxy :: Proxy api) clientWithRoute (Proxy :: Proxy api)
(let ctProxy = Proxy :: Proxy ct (let ctProxy = Proxy :: Proxy ct
in setRQBody (mimeRender ctProxy body) in setReqBodyLBS (mimeRender ctProxy body)
-- We use first contentType from the Accept list -- We use first contentType from the Accept list
(contentType ctProxy) (contentType ctProxy)
req req

29
servant-client/src/Servant/Common/Req.hs
View file

@ -87,7 +87,7 @@ instance Exception ServantError
data Req = Req data Req = Req
{ reqPath :: String { reqPath :: String
, qs :: QueryText , qs :: QueryText
, reqBody :: Maybe (ByteString, MediaType) , reqBody :: Maybe (RequestBody, MediaType)
, reqAccept :: [MediaType] , reqAccept :: [MediaType]
, headers :: [(String, Text)] , headers :: [(String, Text)]
} }
@ -112,8 +112,31 @@ addHeader name val req = req { headers = headers req
++ [(name, decodeUtf8 (toHeader val))] ++ [(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 :: 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 :: (Functor m, MonadThrow m) => Req -> BaseUrl -> m Request
reqToRequest req (BaseUrl reqScheme reqHost reqPort path) = reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
@ -132,7 +155,7 @@ reqToRequest req (BaseUrl reqScheme reqHost reqPort path) =
setrqb r = case reqBody req of setrqb r = case reqBody req of
Nothing -> r Nothing -> r
Just (b,t) -> r { requestBody = RequestBodyLBS b Just (b,t) -> r { requestBody = b
, requestHeaders = requestHeaders r , requestHeaders = requestHeaders r
++ [(hContentType, cs . show $ t)] } ++ [(hContentType, cs . show $ t)] }
setQS = setQueryString $ queryTextToQuery (qs req) setQS = setQueryString $ queryTextToQuery (qs req)