diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,25 @@ Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions. +0.20 +---- + +- Escape special chars in QueryParams. [#1584](https://github.com/haskell-servant/servant/issues/1584) [#1597](https://github.com/haskell-servant/servant/pull/1597) + + Escape special chars in QueryParam (`:@&=+$`) in servant-client. Note that this + mean binary data will not work as is, and so reverts the functionality in + [#1432](https://github.com/haskell-servant/servant/pull/1432). + +- Handle Cookies correctly for RunStreamingClient [#1605](https://github.com/haskell-servant/servant/issues/1605) [#1606](https://github.com/haskell-servant/servant/pull/1606) + + Makes `performWithStreamingRequest` take into consideration the + CookieJar, which it previously didn't. + +- Fix the handling of multiple headers with the same name. [#1666](https://github.com/haskell-servant/servant/pull/1666) + + servant-client no longer concatenates the values of response headers with the same name. + This fixes an issue with parsing multiple `Set-Cookie` headers. + 0.19 ---- 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: 2.2 name: servant-client-core -version: 0.19 +version: 0.20 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.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1 +tested-with: GHC==8.6.5, GHC==8.8.4, GHC ==8.10.7, GHC ==9.0.2, GHC ==9.2.7, GHC ==9.4.4 , GHCJS ==8.6.0.1 extra-source-files: @@ -50,28 +50,28 @@ -- -- note: mtl lower bound is so low because of GHC-7.8 build-depends: - base >= 4.9 && < 4.16 + base >= 4.9 && < 4.19 , bytestring >= 0.10.8.1 && < 0.12 , constraints >= 0.2 && < 0.14 , 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.18 + , text >= 1.2.3.0 && < 2.1 + , transformers >= 0.5.2.0 && < 0.7 + , template-haskell >= 2.11.1.0 && < 2.21 if !impl(ghc >= 8.2) build-depends: - bifunctors >= 5.5.3 && < 5.6 + bifunctors >= 5.5.3 && < 5.7 -- Servant dependencies build-depends: - servant >= 0.19 + servant >= 0.20 -- 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 && < 3 - , base-compat >= 0.10.5 && < 0.12 + , base-compat >= 0.10.5 && < 0.14 , base64-bytestring >= 1.0.0.1 && < 1.3 , exceptions >= 0.10.0 && < 0.11 , free >= 5.1 && < 5.2 @@ -104,8 +104,8 @@ -- Additional dependencies build-depends: deepseq >= 1.4.2.0 && < 1.5 - , hspec >= 2.6.0 && < 2.9 + , hspec >= 2.6.0 && < 2.11 , QuickCheck >= 2.12.6.1 && < 2.15 build-tool-depends: - hspec-discover:hspec-discover >= 2.6.0 && <2.9 + hspec-discover:hspec-discover >= 2.6.0 && <2.11 diff --git a/src/Servant/Client/Core.hs b/src/Servant/Client/Core.hs --- a/src/Servant/Client/Core.hs +++ b/src/Servant/Client/Core.hs @@ -59,6 +59,7 @@ , appendToPath , setRequestBodyLBS , setRequestBody + , encodeQueryParamValue ) where import Servant.Client.Core.Auth import Servant.Client.Core.BaseUrl diff --git a/src/Servant/Client/Core/BaseUrl.hs b/src/Servant/Client/Core/BaseUrl.hs --- a/src/Servant/Client/Core/BaseUrl.hs +++ b/src/Servant/Client/Core/BaseUrl.hs @@ -57,7 +57,7 @@ where s ('/':x) = x s x = x --- | >>> traverse_ (LBS8.putStrLn . encode) $ parseBaseUrl "api.example.com" +-- | >>> traverse_ (LBS8.putStrLn . encode) (parseBaseUrl "api.example.com" :: [BaseUrl]) -- "http://api.example.com" instance ToJSON BaseUrl where toJSON = toJSON . showBaseUrl @@ -72,8 +72,8 @@ -- | >>> :{ -- traverse_ (LBS8.putStrLn . encode) $ do --- u1 <- parseBaseUrl "api.example.com" --- u2 <- parseBaseUrl "example.com" +-- u1 <- parseBaseUrl "api.example.com" :: [BaseUrl] +-- u2 <- parseBaseUrl "example.com" :: [BaseUrl] -- return $ Map.fromList [(u1, 'x'), (u2, 'y')] -- :} -- {"http://api.example.com":"x","http://example.com":"y"} 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 @@ -33,9 +33,7 @@ import Control.Monad (unless) import qualified Data.ByteString as BS -import Data.ByteString.Builder - (toLazyByteString) -import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy as BL import Data.Either (partitionEithers) import Data.Constraint (Dict(..)) @@ -76,10 +74,10 @@ FromSourceIO (..), Header', Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent (NoContent), - NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, + NoContentVerb, QueryFlag, QueryParam', QueryParams, Raw, RawM, ReflectMethod (..), RemoteHost, ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData, ToSourceIO (..), Vault, - Verb, WithNamedContext, WithStatus (..), contentType, getHeadersHList, + Verb, WithNamedContext, WithResource, WithStatus (..), contentType, getHeadersHList, getResponse, toEncodedUrlPiece, toUrlPiece, NamedRoutes) import Servant.API.Generic (GenericMode(..), ToServant, ToServantApi @@ -210,7 +208,7 @@ clientWithRoute pm (Proxy :: Proxy api) (appendToPath p req) - where p = (toUrlPiece val) + where p = toEncodedUrlPiece val hoistClientMonad pm _ f cl = \a -> hoistClientMonad pm (Proxy :: Proxy api) f (cl a) @@ -245,7 +243,7 @@ clientWithRoute pm (Proxy :: Proxy sublayout) (foldl' (flip appendToPath) req ps) - where ps = map (toUrlPiece) vals + where ps = map toEncodedUrlPiece vals hoistClientMonad pm _ f cl = \as -> hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as) @@ -430,7 +428,7 @@ 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' - return $ fromSourceIO $ framingUnrender' $ responseBody gres + fromSourceIO $ framingUnrender' $ responseBody gres where req' = req { requestAccept = fromList [contentType (Proxy :: Proxy ct)] @@ -450,7 +448,7 @@ 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 + val <- fromSourceIO $ framingUnrender' $ responseBody gres return $ Headers { getResponse = val , getHeadersHList = buildHeadersTo . toList $ responseHeaders gres @@ -571,7 +569,7 @@ (Proxy :: Proxy mods) add (maybe req add) mparam where add :: a -> Request - add param = appendToQueryString pname (Just $ encodeQueryParam param) req + add param = appendToQueryString pname (Just $ encodeQueryParamValue param) req pname :: Text pname = pack $ symbolVal (Proxy :: Proxy sym) @@ -579,9 +577,6 @@ hoistClientMonad pm _ f cl = \arg -> hoistClientMonad pm (Proxy :: Proxy api) f (cl arg) -encodeQueryParam :: ToHttpApiData a => a -> BS.ByteString -encodeQueryParam = BL.toStrict . toLazyByteString . toEncodedUrlPiece - -- | If you use a 'QueryParams' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument, a list of values of the type specified @@ -623,7 +618,7 @@ ) where pname = pack $ symbolVal (Proxy :: Proxy sym) - paramlist' = map (Just . encodeQueryParam) paramlist + paramlist' = map (Just . encodeQueryParamValue) paramlist hoistClientMonad pm _ f cl = \as -> hoistClientMonad pm (Proxy :: Proxy api) f (cl as) @@ -679,6 +674,16 @@ hoistClientMonad _ _ f cl = \meth -> f (cl meth) +instance RunClient m => HasClient m RawM where + type Client m RawM + = H.Method -> m Response + + clientWithRoute :: Proxy m -> Proxy RawM -> Request -> Client m RawM + clientWithRoute _pm Proxy req httpMethod = do + runRequest req { requestMethod = httpMethod } + + hoistClientMonad _ _ f cl = \meth -> f (cl meth) + -- | If you use a 'ReqBody' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'ReqBody'. @@ -745,7 +750,7 @@ clientWithRoute pm (Proxy :: Proxy api) (appendToPath p req) - where p = pack $ symbolVal (Proxy :: Proxy path) + where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path) hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl @@ -781,6 +786,14 @@ hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl +instance HasClient m subapi => + HasClient m (WithResource res :> subapi) where + + type Client m (WithResource res :> subapi) = Client m subapi + clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy subapi) + + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy subapi) f cl + instance ( HasClient m api ) => HasClient m (AuthProtect tag :> api) where type Client m (AuthProtect tag :> api) @@ -847,6 +860,7 @@ ( forall n. GClient api n , HasClient m (ToServantApi api) , RunClient m + , ErrorIfNoGeneric api ) => HasClient m (NamedRoutes api) where type Client m (NamedRoutes api) = api (AsClientT m) @@ -879,7 +893,7 @@ -- -- Example: -- --- @@ +-- @ -- type Api = NamedRoutes RootApi -- -- data RootApi mode = RootApi @@ -899,8 +913,8 @@ -- rootClient = client api -- -- endpointClient :: ClientM Person --- endpointClient = client // subApi // endpoint --- @@ +-- endpointClient = client \/\/ subApi \/\/ endpoint +-- @ (//) :: a -> (a -> b) -> b x // f = f x @@ -911,7 +925,7 @@ -- -- Example: -- --- @@ +-- @ -- type Api = NamedRoutes RootApi -- -- data RootApi mode = RootApi @@ -932,11 +946,11 @@ -- rootClient = client api -- -- hello :: String -> ClientM String --- hello name = rootClient // hello /: name +-- hello name = rootClient \/\/ hello \/: name -- -- endpointClient :: ClientM Person --- endpointClient = client // subApi /: "foobar123" // endpoint --- @@ +-- endpointClient = client \/\/ subApi \/: "foobar123" \/\/ endpoint +-- @ (/:) :: (a -> b -> c) -> b -> a -> c (/:) = flip 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 @@ -17,6 +17,7 @@ addHeader, appendToPath, appendToQueryString, + encodeQueryParamValue, setRequestBody, setRequestBodyLBS, ) where @@ -33,6 +34,8 @@ import Data.Bitraversable (Bitraversable (..), bifoldMapDefault, bimapDefault) import qualified Data.ByteString as BS +import Data.ByteString.Builder + (Builder) import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LBS import qualified Data.Sequence as Seq @@ -48,9 +51,9 @@ (MediaType) import Network.HTTP.Types (Header, HeaderName, HttpVersion (..), Method, QueryItem, - http11, methodGet) + http11, methodGet, urlEncodeBuilder) import Servant.API - (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO) + (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO) import Servant.Client.Core.Internal (mediaTypeRnf) @@ -111,7 +114,7 @@ rnfB Nothing = () rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt -type Request = RequestF RequestBody Builder.Builder +type Request = RequestF RequestBody Builder -- | The request body. R replica of the @http-client@ @RequestBody@. data RequestBody @@ -142,18 +145,31 @@ , requestMethod = methodGet } -appendToPath :: Text -> Request -> Request +-- | Append extra path to the request being constructed. +-- +-- Warning: This function assumes that the path fragment is already URL-encoded. +appendToPath :: Builder -> Request -> Request appendToPath p req - = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p } + = req { requestPath = requestPath req <> "/" <> p } -appendToQueryString :: Text -- ^ param name - -> Maybe BS.ByteString -- ^ param value +-- | Append a query parameter to the request being constructed. +-- +appendToQueryString :: Text -- ^ query param name + -> Maybe BS.ByteString -- ^ query param value -> Request -> Request appendToQueryString pname pvalue req = req { requestQueryString = requestQueryString req Seq.|> (encodeUtf8 pname, pvalue)} +-- | Encode a query parameter value. +-- +encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString +encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString + . urlEncodeBuilder True . encodeUtf8 . toQueryParam + +-- | Add header to the request being constructed. +-- addHeader :: ToHttpApiData a => HeaderName -> a -> Request -> Request addHeader name val req = req { requestHeaders = requestHeaders req Seq.|> (name, toHeader val)}