diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,45 @@ [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.17 +---- + +### Significant changes + +- Add NoContentVerb [#1028](https://github.com/haskell-servant/servant/issues/1028) [#1219](https://github.com/haskell-servant/servant/pull/1219) [#1228](https://github.com/haskell-servant/servant/pull/1228) + + The `NoContent` API endpoints should now use `NoContentVerb` combinator. + The API type changes are usually of the kind + + ```diff + - :<|> PostNoContent '[JSON] NoContent + + :<|> PostNoContent + ``` + + i.e. one doesn't need to specify the content-type anymore. There is no content. + +- `Capture` can be `Lenient` [#1155](https://github.com/haskell-servant/servant/issues/1155) [#1156](https://github.com/haskell-servant/servant/pull/1156) + + You can specify a lenient capture as + + ```haskell + :<|> "capture-lenient" :> Capture' '[Lenient] "foo" Int :> GET + ``` + + which will make the capture always succeed. Handlers will be of the + type `Either String CapturedType`, where `Left err` represents + the possible parse failure. + +### Other changes + +- *servant-client* *servant-client-core* *servant-http-streams* Fix Verb with headers checking content type differently [#1200](https://github.com/haskell-servant/servant/issues/1200) [#1204](https://github.com/haskell-servant/servant/pull/1204) + + For `Verb`s with response `Headers`, the implementation didn't check + for the content-type of the response. Now it does. + +- *servant-client* *servant-http-streams* `HasClient` instance for `Stream` with `Headers` [#1170](https://github.com/haskell-servant/servant/issues/1170) [#1197](https://github.com/haskell-servant/servant/pull/1197) +- *servant-client* Redact the authorization header in Show and exceptions [#1238](https://github.com/haskell-servant/servant/pull/1238) + 0.16 ---- @@ -168,7 +207,7 @@ Just like `hoistServer` allows us to change the monad in which request handlers of a web application live in, we also have `hoistClient` for changing the monad in which *client functions* live. - Read [tutorial section for more information](https://haskell-servant.readthedocs.io/en/release-0.14/tutorial/Client.html#changing-the-monad-the-client-functions-live-in). + Read [tutorial section for more information](https://docs.servant.dev/en/release-0.14/tutorial/Client.html#changing-the-monad-the-client-functions-live-in). ([#936](https://github.com/haskell-servant/servant/pull/936)) iF you have own combinators, you'll need to define a new method of 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.16 +version: 0.17 synopsis: Core functionality and class for client function generation for servant APIs category: Servant, Web @@ -8,7 +8,7 @@ This library provides backend-agnostic generation of client functions. For more information, see the README. -homepage: http://haskell-servant.readthedocs.org/ +homepage: http://docs.servant.dev/ bug-reports: http://github.com/haskell-servant/servant/issues license: BSD3 license-file: LICENSE @@ -20,7 +20,9 @@ GHC ==8.0.2 || ==8.2.2 || ==8.4.4 - || ==8.6.3 + || ==8.6.5 + || ==8.8.2 + , GHCJS == 8.4 extra-source-files: CHANGELOG.md @@ -53,13 +55,13 @@ -- -- note: mtl lower bound is so low because of GHC-7.8 build-depends: - base >= 4.9 && < 4.13 + base >= 4.9 && < 4.14 , bytestring >= 0.10.8.1 && < 0.11 , 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.15 + , template-haskell >= 2.11.1.0 && < 2.16 if !impl(ghc >= 8.2) build-depends: @@ -67,17 +69,17 @@ -- Servant dependencies build-depends: - servant >= 0.16 && <0.17 + servant >= 0.17 && <0.18 -- 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.5 - , base-compat >= 0.10.5 && < 0.11 + , base-compat >= 0.10.5 && < 0.12 , base64-bytestring >= 1.0.0.1 && < 1.1 , exceptions >= 0.10.0 && < 0.11 , free >= 5.1 && < 5.2 - , http-media >= 0.7.1.3 && < 0.8 + , http-media >= 0.7.1.3 && < 0.9 , http-types >= 0.12.2 && < 0.13 , network-uri >= 2.6.1.0 && < 2.7 , safe >= 0.3.17 && < 0.4 @@ -94,6 +96,7 @@ main-is: Spec.hs other-modules: Servant.Client.Core.Internal.BaseUrlSpec + Servant.Client.Core.RequestSpec -- Dependencies inherited from the library. No need to specify bounds. build-depends: @@ -105,7 +108,7 @@ build-depends: deepseq >= 1.4.2.0 && < 1.5 , hspec >= 2.6.0 && < 2.8 - , QuickCheck >= 2.12.6.1 && < 2.13 + , QuickCheck >= 2.12.6.1 && < 2.14 build-tool-depends: hspec-discover:hspec-discover >= 2.6.0 && <2.8 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 @@ -50,8 +50,9 @@ MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData, - ToSourceIO (..), Vault, Verb, WithNamedContext, contentType, - getHeadersHList, getResponse, toQueryParam, toUrlPiece) + ToSourceIO (..), Vault, Verb, NoContentVerb, WithNamedContext, + contentType, getHeadersHList, getResponse, toQueryParam, + toUrlPiece) import Servant.API.ContentTypes (contentTypes) import Servant.API.Modifiers @@ -241,6 +242,17 @@ hoistClientMonad _ _ f ma = f ma +instance (RunClient m, ReflectMethod method) => + HasClient m (NoContentVerb method) where + type Client m (NoContentVerb method) + = m NoContent + clientWithRoute _pm Proxy req = do + _response <- runRequest req { requestMethod = method } + return NoContent + where method = reflectMethod (Proxy :: Proxy method) + + hoistClientMonad _ _ f ma = f ma + instance {-# OVERLAPPING #-} -- Note [Non-Empty Content Types] ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls @@ -253,12 +265,10 @@ { requestMethod = method , requestAccept = fromList $ toList accept } - case mimeUnrender (Proxy :: Proxy ct) $ responseBody response of - Left err -> throwClientError $ DecodeFailure (pack err) response - Right val -> return $ Headers - { getResponse = val - , getHeadersHList = buildHeadersTo . toList $ responseHeaders response - } + val <- response `decodedAs` (Proxy :: Proxy ct) + return $ Headers { getResponse = val + , getHeadersHList = buildHeadersTo . toList $ responseHeaders response + } where method = reflectMethod (Proxy :: Proxy method) accept = contentTypes (Proxy :: Proxy ct) @@ -291,6 +301,31 @@ let mimeUnrender' = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender' return $ fromSourceIO $ framingUnrender' $ responseBody gres + where + req' = req + { requestAccept = fromList [contentType (Proxy :: Proxy ct)] + , requestMethod = reflectMethod (Proxy :: Proxy method) + } + +instance {-# OVERLAPPING #-} + ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method, + FramingUnrender framing, FromSourceIO chunk a, + BuildHeadersTo hs + ) => HasClient m (Stream method status framing ct (Headers hs a)) where + + type Client m (Stream method status framing ct (Headers hs a)) = m (Headers hs a) + + hoistClientMonad _ _ f ma = f ma + + clientWithRoute _pm Proxy req = withStreamingRequest req' $ \gres -> do + let mimeUnrender' = mimeUnrender (Proxy :: Proxy ct) :: BL.ByteString -> Either String chunk + framingUnrender' = framingUnrender (Proxy :: Proxy framing) mimeUnrender' + val = fromSourceIO $ framingUnrender' $ responseBody gres + return $ Headers + { getResponse = val + , getHeadersHList = buildHeadersTo . toList $ responseHeaders gres + } + where req' = req { requestAccept = fromList [contentType (Proxy :: Proxy ct)] diff --git a/src/Servant/Client/Core/Request.hs b/src/Servant/Client/Core/Request.hs --- a/src/Servant/Client/Core/Request.hs +++ b/src/Servant/Client/Core/Request.hs @@ -64,8 +64,32 @@ , requestHeaders :: Seq.Seq Header , requestHttpVersion :: HttpVersion , requestMethod :: Method - } deriving (Generic, Typeable, Eq, Show, Functor, Foldable, Traversable) + } deriving (Generic, Typeable, Eq, Functor, Foldable, Traversable) +instance (Show a, Show b) => + Show (Servant.Client.Core.Request.RequestF a b) where + showsPrec p req + = showParen + (p >= 11) + ( showString "Request {requestPath = " + . showsPrec 0 (requestPath req) + . showString ", requestQueryString = " + . showsPrec 0 (requestQueryString req) + . showString ", requestBody = " + . showsPrec 0 (requestBody req) + . showString ", requestAccept = " + . showsPrec 0 (requestAccept req) + . showString ", requestHeaders = " + . showsPrec 0 (redactSensitiveHeader <$> requestHeaders req)) + . showString ", requestHttpVersion = " + . showsPrec 0 (requestHttpVersion req) + . showString ", requestMethod = " + . showsPrec 0 (requestMethod req) + . showString "}" + where + redactSensitiveHeader :: Header -> Header + redactSensitiveHeader ("Authorization", _) = ("Authorization", "") + redactSensitiveHeader h = h instance Bifunctor RequestF where bimap = bimapDefault instance Bifoldable RequestF where bifoldMap = bifoldMapDefault instance Bitraversable RequestF where diff --git a/src/Servant/Client/Generic.hs b/src/Servant/Client/Generic.hs --- a/src/Servant/Client/Generic.hs +++ b/src/Servant/Client/Generic.hs @@ -16,7 +16,7 @@ import Servant.API.Generic import Servant.Client.Core --- | A type that specifies that an API reocrd contains a client implementation. +-- | A type that specifies that an API record contains a client implementation. data AsClientT (m :: * -> *) instance GenericMode (AsClientT m) where type AsClientT m :- api = Client m api diff --git a/test/Servant/Client/Core/RequestSpec.hs b/test/Servant/Client/Core/RequestSpec.hs new file mode 100644 --- /dev/null +++ b/test/Servant/Client/Core/RequestSpec.hs @@ -0,0 +1,19 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# LANGUAGE OverloadedStrings #-} +module Servant.Client.Core.RequestSpec (spec) where + + +import Prelude () +import Prelude.Compat +import Control.Monad +import Data.List (isInfixOf) +import Servant.Client.Core.Request +import Test.Hspec + +spec :: Spec +spec = do + describe "Request" $ do + describe "show" $ do + it "redacts the authorization header" $ do + let request = void $ defaultRequest { requestHeaders = pure ("authorization", "secret") } + isInfixOf "secret" (show request) `shouldBe` False