Don't ignore the content-type in ReqBody
This commit is contained in:
parent
48030a6a1b
commit
40a941e0e3
3 changed files with 8 additions and 15 deletions
|
@ -50,7 +50,6 @@ library
|
|||
, network-uri >= 2.6
|
||||
, safe
|
||||
, servant >= 0.2.2
|
||||
, servant-server
|
||||
, string-conversions
|
||||
, text
|
||||
, transformers
|
||||
|
|
|
@ -26,8 +26,8 @@ import GHC.TypeLits
|
|||
import Network.HTTP.Media
|
||||
import qualified Network.HTTP.Types as H
|
||||
import Servant.API
|
||||
import Servant.API.ContentTypes
|
||||
import Servant.Common.BaseUrl
|
||||
import Servant.Server.ContentTypes
|
||||
import Servant.Common.Req
|
||||
import Servant.Common.Text
|
||||
|
||||
|
@ -438,15 +438,16 @@ instance HasClient Raw where
|
|||
-- > addBook :: Book -> BaseUrl -> EitherT String IO Book
|
||||
-- > addBook = client myApi
|
||||
-- > -- then you can just use "addBook" to query that endpoint
|
||||
instance (ToJSON a, HasClient sublayout)
|
||||
instance (MimeRender ct a, HasClient sublayout)
|
||||
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where
|
||||
|
||||
type Client (ReqBody (ct ': cts) a :> sublayout) =
|
||||
a -> Client sublayout
|
||||
|
||||
clientWithRoute Proxy req body =
|
||||
clientWithRoute (Proxy :: Proxy sublayout) $
|
||||
setRQBody (encode body) ("application" // "json" /: ("charset", "utf-8")) req
|
||||
clientWithRoute (Proxy :: Proxy sublayout) $ do
|
||||
let ctProxy = Proxy :: Proxy ct
|
||||
setRQBody (toByteString ctProxy body) (contentType ctProxy) req
|
||||
|
||||
-- | Make the querying function append @path@ to the request path.
|
||||
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
|
||||
|
|
|
@ -24,9 +24,9 @@ import Network.HTTP.Client.TLS
|
|||
import Network.HTTP.Media
|
||||
import Network.HTTP.Types
|
||||
import Network.URI
|
||||
import Servant.API.ContentTypes
|
||||
import Servant.Common.BaseUrl
|
||||
import Servant.Common.Text
|
||||
import Servant.Server.ContentTypes
|
||||
import System.IO.Unsafe
|
||||
|
||||
import qualified Network.HTTP.Client as Client
|
||||
|
@ -152,8 +152,8 @@ performRequestCT ct reqMethod req wantedStatus reqHost = do
|
|||
performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
|
||||
unless (matches respCT (acceptCT)) $
|
||||
left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT
|
||||
maybe
|
||||
(left (displayHttpRequest reqMethod ++ " returned invalid response of type: " ++ show respCT))
|
||||
either
|
||||
(left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))
|
||||
return
|
||||
(fromByteString ct respBody)
|
||||
|
||||
|
@ -164,10 +164,3 @@ catchStatusCodeException action =
|
|||
case e of
|
||||
Client.StatusCodeException status _ _ -> return $ Left status
|
||||
exc -> throwIO exc
|
||||
|
||||
-- | Like 'Data.Aeson.decode' but allows all JSON values instead of just
|
||||
-- objects and arrays.
|
||||
decodeLenient :: FromJSON a => ByteString -> Either String a
|
||||
decodeLenient input = do
|
||||
v :: Value <- parseOnly (Data.Aeson.Parser.value <* endOfInput) (cs input)
|
||||
parseEither parseJSON v
|
||||
|
|
Loading…
Reference in a new issue