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
|
, network-uri >= 2.6
|
||||||
, safe
|
, safe
|
||||||
, servant >= 0.2.2
|
, servant >= 0.2.2
|
||||||
, servant-server
|
|
||||||
, string-conversions
|
, string-conversions
|
||||||
, text
|
, text
|
||||||
, transformers
|
, transformers
|
||||||
|
|
|
@ -26,8 +26,8 @@ import GHC.TypeLits
|
||||||
import Network.HTTP.Media
|
import Network.HTTP.Media
|
||||||
import qualified Network.HTTP.Types as H
|
import qualified Network.HTTP.Types as H
|
||||||
import Servant.API
|
import Servant.API
|
||||||
|
import Servant.API.ContentTypes
|
||||||
import Servant.Common.BaseUrl
|
import Servant.Common.BaseUrl
|
||||||
import Servant.Server.ContentTypes
|
|
||||||
import Servant.Common.Req
|
import Servant.Common.Req
|
||||||
import Servant.Common.Text
|
import Servant.Common.Text
|
||||||
|
|
||||||
|
@ -438,15 +438,16 @@ instance HasClient Raw where
|
||||||
-- > addBook :: Book -> BaseUrl -> EitherT String IO Book
|
-- > addBook :: Book -> BaseUrl -> EitherT String IO Book
|
||||||
-- > addBook = client myApi
|
-- > addBook = client myApi
|
||||||
-- > -- then you can just use "addBook" to query that endpoint
|
-- > -- 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
|
=> HasClient (ReqBody (ct ': cts) a :> sublayout) where
|
||||||
|
|
||||||
type Client (ReqBody (ct ': cts) a :> sublayout) =
|
type Client (ReqBody (ct ': cts) a :> sublayout) =
|
||||||
a -> Client sublayout
|
a -> Client sublayout
|
||||||
|
|
||||||
clientWithRoute Proxy req body =
|
clientWithRoute Proxy req body =
|
||||||
clientWithRoute (Proxy :: Proxy sublayout) $
|
clientWithRoute (Proxy :: Proxy sublayout) $ do
|
||||||
setRQBody (encode body) ("application" // "json" /: ("charset", "utf-8")) req
|
let ctProxy = Proxy :: Proxy ct
|
||||||
|
setRQBody (toByteString ctProxy body) (contentType ctProxy) req
|
||||||
|
|
||||||
-- | Make the querying function append @path@ to the request path.
|
-- | Make the querying function append @path@ to the request path.
|
||||||
instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where
|
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.Media
|
||||||
import Network.HTTP.Types
|
import Network.HTTP.Types
|
||||||
import Network.URI
|
import Network.URI
|
||||||
|
import Servant.API.ContentTypes
|
||||||
import Servant.Common.BaseUrl
|
import Servant.Common.BaseUrl
|
||||||
import Servant.Common.Text
|
import Servant.Common.Text
|
||||||
import Servant.Server.ContentTypes
|
|
||||||
import System.IO.Unsafe
|
import System.IO.Unsafe
|
||||||
|
|
||||||
import qualified Network.HTTP.Client as Client
|
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
|
performRequest reqMethod (req { reqAccept = [acceptCT] }) (== wantedStatus) reqHost
|
||||||
unless (matches respCT (acceptCT)) $
|
unless (matches respCT (acceptCT)) $
|
||||||
left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT
|
left $ "requested Content-Type " <> show acceptCT <> ", but got " <> show respCT
|
||||||
maybe
|
either
|
||||||
(left (displayHttpRequest reqMethod ++ " returned invalid response of type: " ++ show respCT))
|
(left . ((displayHttpRequest reqMethod ++ " returned invalid response of type" ++ show respCT) ++))
|
||||||
return
|
return
|
||||||
(fromByteString ct respBody)
|
(fromByteString ct respBody)
|
||||||
|
|
||||||
|
@ -164,10 +164,3 @@ catchStatusCodeException action =
|
||||||
case e of
|
case e of
|
||||||
Client.StatusCodeException status _ _ -> return $ Left status
|
Client.StatusCodeException status _ _ -> return $ Left status
|
||||||
exc -> throwIO exc
|
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