1abf84f · typeable/servant

git.iko.soy/typeable/servant

servant-client asks for any content-type in Accept contentTypes ne-list

commit1abf84fecaae0ab95d583f958b78081dd51a583b authorOleg Grenrus <oleg.grenrus@iki.fi> dateTue 11 Oct 2016, 08:20 (10 years ago) parent148bb15

2 files changed+6−4

unifiedsplit

servant-client/src/Servant/Client.hs+1

@@ -407,6 +407,7 @@ instance (MimeRender ct a, HasClient api)

407407 clientWithRoute (Proxy :: Proxy api)

408408 (let ctProxy = Proxy :: Proxy ct

409409 in setRQBody (mimeRender ctProxy body)

410+ -- We use first contentType from the Accept list

410411 (contentType ctProxy)

411412 req

412413 )

servant-client/src/Servant/Common/Req.hs+5−4

@@ -13,6 +13,7 @@ import Prelude.Compat

1313import Control.Exception

1414import Control.Monad

1515import Control.Monad.Catch (MonadThrow, MonadCatch)

16+import Data.Foldable (toList)

1617

1718#if MIN_VERSION_mtl(2,2,0)

1819import Control.Monad.Except (MonadError(..))

@@ -25,7 +26,7 @@ import Control.Monad.Trans.Except

2526import GHC.Generics

2627import Control.Monad.IO.Class ()

2728import Control.Monad.Reader

28−import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)

29+import Data.ByteString.Lazy hiding (pack, filter, map, null, elem, any)

2930import Data.String

3031import Data.String.Conversions

3132import Data.Proxy

@@ -215,10 +216,10 @@ performRequest reqMethod req = do

215216performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req

216217 -> ClientM ([HTTP.Header], result)

217218performRequestCT ct reqMethod req = do

218− let acceptCT = contentType ct

219+ let acceptCTS = contentTypes ct

219220 (_status, respBody, respCT, hdrs, _response) <-

220− performRequest reqMethod (req { reqAccept = [acceptCT] })

221− unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType respCT respBody

221+ performRequest reqMethod (req { reqAccept = toList acceptCTS })

222+ unless (any (matches respCT) acceptCTS) $ throwError $ UnsupportedContentType respCT respBody

222223 case mimeUnrender ct respBody of

223224 Left err -> throwError $ DecodeFailure err respCT respBody

224225 Right val -> return (hdrs, val)