diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,18 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client-core/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +0.18.3 +------ + +### Significant changes + +- Add response header support to UVerb (#1420) + +### Other changes + +- Support GHC-9.0.1. +- Bump `bytestring`, `hspec`, `base64-bytestring` and `QuickCheck` dependencies. + 0.18.2 ------ diff --git a/servant-client-core.cabal b/servant-client-core.cabal --- a/servant-client-core.cabal +++ b/servant-client-core.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: servant-client-core -version: 0.18.2 +version: 0.18.3 synopsis: Core functionality and class for client function generation for servant APIs category: Servant, Web @@ -16,7 +16,7 @@ maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type: Simple -tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 +tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 , GHCJS == 8.4 extra-source-files: @@ -50,13 +50,13 @@ -- -- note: mtl lower bound is so low because of GHC-7.8 build-depends: - base >= 4.9 && < 4.15 - , bytestring >= 0.10.8.1 && < 0.11 + base >= 4.9 && < 4.16 + , bytestring >= 0.10.8.1 && < 0.12 , containers >= 0.5.7.1 && < 0.7 , deepseq >= 1.4.2.0 && < 1.5 , text >= 1.2.3.0 && < 1.3 , transformers >= 0.5.2.0 && < 0.6 - , template-haskell >= 2.11.1.0 && < 2.17 + , template-haskell >= 2.11.1.0 && < 2.18 if !impl(ghc >= 8.2) build-depends: @@ -64,14 +64,14 @@ -- Servant dependencies build-depends: - servant >= 0.18.1 && <0.19 + servant >= 0.18.3 && <0.19 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions. build-depends: aeson >= 1.4.1.0 && < 1.6 , base-compat >= 0.10.5 && < 0.12 - , base64-bytestring >= 1.0.0.1 && < 1.2 + , base64-bytestring >= 1.0.0.1 && < 1.3 , exceptions >= 0.10.0 && < 0.11 , free >= 5.1 && < 5.2 , http-media >= 0.7.1.3 && < 0.9 @@ -103,8 +103,8 @@ -- Additional dependencies build-depends: deepseq >= 1.4.2.0 && < 1.5 - , hspec >= 2.6.0 && < 2.8 - , QuickCheck >= 2.12.6.1 && < 2.14 + , hspec >= 2.6.0 && < 2.9 + , QuickCheck >= 2.12.6.1 && < 2.15 build-tool-depends: - hspec-discover:hspec-discover >= 2.6.0 && <2.8 + hspec-discover:hspec-discover >= 2.6.0 && <2.9 diff --git a/src/Servant/Client/Core/HasClient.hs b/src/Servant/Client/Core/HasClient.hs --- a/src/Servant/Client/Core/HasClient.hs +++ b/src/Servant/Client/Core/HasClient.hs @@ -75,7 +75,7 @@ NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault, - Verb, WithNamedContext, contentType, getHeadersHList, + Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList, getResponse, toQueryParam, toUrlPiece) import Servant.API.ContentTypes (contentTypes, AllMime (allMime), AllMimeUnrender (allMimeUnrender)) @@ -318,6 +318,25 @@ data ClientParseError = ClientParseError MediaType String | ClientStatusMismatch | ClientNoMatchingStatus deriving (Eq, Show) +class UnrenderResponse (cts :: [*]) (a :: *) where + unrenderResponse :: Seq.Seq H.Header -> BL.ByteString -> Proxy cts + -> [Either (MediaType, String) a] + +instance {-# OVERLAPPABLE #-} AllMimeUnrender cts a => UnrenderResponse cts a where + unrenderResponse _ body = map parse . allMimeUnrender + where parse (mediaType, parser) = left ((,) mediaType) (parser body) + +instance {-# OVERLAPPING #-} forall cts a h . (UnrenderResponse cts a, BuildHeadersTo h) + => UnrenderResponse cts (Headers h a) where + unrenderResponse hs body = (map . fmap) setHeaders . unrenderResponse hs body + where + setHeaders :: a -> Headers h a + setHeaders x = Headers x (buildHeadersTo (toList hs)) + +instance {-# OVERLAPPING #-} UnrenderResponse cts a + => UnrenderResponse cts (WithStatus n a) where + unrenderResponse hs body = (map . fmap) WithStatus . unrenderResponse hs body + instance {-# OVERLAPPING #-} ( RunClient m, contentTypes ~ (contentType ': otherContentTypes), @@ -326,7 +345,7 @@ as ~ (a ': as'), AllMime contentTypes, ReflectMethod method, - All (AllMimeUnrender contentTypes) as, + All (UnrenderResponse contentTypes) as, All HasStatus as, HasStatuses as', Unique (Statuses as) ) => @@ -349,7 +368,8 @@ let status = responseStatusCode response body = responseBody response - res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) body + headers = responseHeaders response + res = tryParsers status $ mimeUnrenders (Proxy @contentTypes) headers body case res of Left errors -> throwClientError $ DecodeFailure (T.pack (show errors)) response Right x -> return x @@ -370,13 +390,14 @@ -- | Given a list of types, parses the given response body as each type mimeUnrenders :: forall cts xs. - All (AllMimeUnrender cts) xs => + All (UnrenderResponse cts) xs => Proxy cts -> + Seq.Seq H.Header -> BL.ByteString -> NP ([] :.: Either (MediaType, String)) xs - mimeUnrenders ctp body = cpure_NP - (Proxy @(AllMimeUnrender cts)) - (Comp . map (\(mediaType, parser) -> left ((,) mediaType) (parser body)) . allMimeUnrender $ ctp) + mimeUnrenders ctp headers body = cpure_NP + (Proxy @(UnrenderResponse cts)) + (Comp . unrenderResponse headers body $ ctp) hoistClientMonad _ _ nt s = nt s