on master help sign in
Don't ignore the content-type in ReqBody
commit40a941e0e384d48f52cdb96ce57d80b423389099 authorTimo von Holtz <tvh@anchor.com.au> dateWed 25 Feb 2015, 09:30 (12 years ago) parent48030a6
3 files changed+8−15
servant-client.cabal−1 src/Servant/Client.hs+5−4 src/Servant/Common/Req.hs+3−10
servant-client.cabal−1
@@ -50,7 +50,6 @@ library
5050 , network-uri >= 2.6
5151 , safe
5252 , servant >= 0.2.2
53− , servant-server
5453 , string-conversions
5554 , text
5655 , transformers
src/Servant/Client.hs+5−4
@@ -26,8 +26,8 @@ import GHC.TypeLits
2626import Network.HTTP.Media
2727import qualified Network.HTTP.Types as H
2828import Servant.API
29+import Servant.API.ContentTypes
2930import Servant.Common.BaseUrl
30−import Servant.Server.ContentTypes
3131import Servant.Common.Req
3232import Servant.Common.Text
3333
@@ -438,15 +438,16 @@ instance HasClient Raw where
438438-- > addBook :: Book -> BaseUrl -> EitherT String IO Book
439439-- > addBook = client myApi
440440-- > -- then you can just use "addBook" to query that endpoint
441−instance (ToJSON a, HasClient sublayout)
441+instance (MimeRender ct a, HasClient sublayout)
442442 => HasClient (ReqBody (ct ': cts) a :> sublayout) where
443443
444444 type Client (ReqBody (ct ': cts) a :> sublayout) =
445445 a -> Client sublayout
446446
447447 clientWithRoute Proxy req body =
448− clientWithRoute (Proxy :: Proxy sublayout) $
449− setRQBody (encode body) ("application" // "json" /: ("charset", "utf-8")) req
448+ clientWithRoute (Proxy :: Proxy sublayout) $ do
449+ let ctProxy = Proxy :: Proxy ct
450+ setRQBody (toByteString ctProxy body) (contentType ctProxy) req
450451
451452-- | Make the querying function append @path@ to the request path.
452453instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
src/Servant/Common/Req.hs+3−10
@@ -24,9 +24,9 @@ import Network.HTTP.Client.TLS
2424import Network.HTTP.Media
2525import Network.HTTP.Types
2626import Network.URI
27+import Servant.API.ContentTypes
2728import Servant.Common.BaseUrl
2829import Servant.Common.Text
29−import Servant.Server.ContentTypes
3030import System.IO.Unsafe
3131
3232import qualified Network.HTTP.Client as Client
@@ -152,8 +152,8 @@ performRequestCT ct reqMethod req wantedStatus reqHost = do
152152 performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
153153 unless (matches respCT (acceptCT)) $
154154 left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT
155− maybe
156− (left (displayHttpRequest reqMethod ++ " returned invalid response of type: " ++ show respCT))
155+ either
156+ (left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))
157157 return
158158 (fromByteString ct respBody)
159159
@@ -164,10 +164,3 @@ catchStatusCodeException action =
164164 case e of
165165 Client.StatusCodeException status _ _ -> return $ Left status
166166 exc -> throwIO exc
167−
168−-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just
169−-- objects and arrays.
170−decodeLenient :: FromJSON a => ByteString -> Either String a
171−decodeLenient input = do
172− v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
173− parseEither parseJSON v