servant-client-core 0.13.0.1 → 0.14
raw patch · 7 files changed
+192/−40 lines, 7 filesdep +freedep −mtldep ~QuickCheckdep ~base-compatdep ~exceptions
Dependencies added: free
Dependencies removed: mtl
Dependency ranges changed: QuickCheck, base-compat, exceptions, generics-sop, hspec, http-api-data, http-media, http-types, safe, semigroups, servant
Files
- CHANGELOG.md +47/−1
- servant-client-core.cabal +21/−19
- src/Servant/Client/Core/Internal/ClientF.hs +10/−0
- src/Servant/Client/Core/Internal/HasClient.hs +67/−2
- src/Servant/Client/Core/Internal/Request.hs +23/−16
- src/Servant/Client/Core/Internal/RunClient.hs +9/−2
- src/Servant/Client/Free.hs +15/−0
CHANGELOG.md view
@@ -1,11 +1,57 @@ [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.14+----++- `Stream` takes a status code argument++ ```diff+ -Stream method framing ctype a+ +Stream method status framing ctype a+ ```++ ([#966](https://github.com/haskell-servant/servant/pull/966)+ [#972](https://github.com/haskell-servant/servant/pull/972))++- `ToStreamGenerator` definition changed, so it's possible to write an instance+ for conduits.++ ```diff+ -class ToStreamGenerator f a where+ - toStreamGenerator :: f a -> StreamGenerator a+ +class ToStreamGenerator a b | a -> b where+ + toStreamGenerator :: a -> StreamGenerator b+ ```++ ([#959](https://github.com/haskell-servant/servant/pull/959))++- Added `NoFraming` streaming strategy+ ([#959](https://github.com/haskell-servant/servant/pull/959))++- *servant-client-core* Free `Client` implementation.+ Useful for testing `HasClient` instances.+ ([#920](https://github.com/haskell-servant/servant/pull/920))++- *servant-client-core* Add `hoistClient` to `HasClient`.+ 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).+ ([#936](https://github.com/haskell-servant/servant/pull/936))++ iF you have own combinators, you'll need to define a new method of+ `HasClient` class, for example:++ ```haskell+ type Client m (MyCombinator :> api) = MyValue :> Client m api+ hoistClientMonad pm _ nt cl = hoistClientMonad pm (Proxy :: Proxy api) nt . cl+ ```+ 0.13.0.1 -------- - Support `base-compat-0.10`- 0.13 ----
servant-client-core.cabal view
@@ -1,5 +1,5 @@ name: servant-client-core-version: 0.13.0.1+version: 0.14 synopsis: Core functionality and class for client function generation for servant APIs description: This library provides backend-agnostic generation of client functions. For@@ -19,11 +19,11 @@ CHANGELOG.md README.md tested-with:- GHC==7.8.4,- GHC==7.10.3,- GHC==8.0.2,- GHC==8.2.2,- GHC==8.4.1+ GHC==7.8.4+ GHC==7.10.3+ GHC==8.0.2+ GHC==8.2.2+ GHC==8.4.3 source-repository head type: git@@ -32,10 +32,12 @@ library exposed-modules: Servant.Client.Core+ Servant.Client.Free Servant.Client.Core.Reexport Servant.Client.Core.Internal.Auth Servant.Client.Core.Internal.BaseUrl Servant.Client.Core.Internal.BasicAuth+ Servant.Client.Core.Internal.ClientF Servant.Client.Core.Internal.Generic Servant.Client.Core.Internal.HasClient Servant.Client.Core.Internal.Request@@ -49,29 +51,29 @@ base >= 4.7 && < 4.12 , bytestring >= 0.10.4.0 && < 0.11 , containers >= 0.5.5.1 && < 0.6- , mtl >= 2.1 && < 2.3 , text >= 1.2.3.0 && < 1.3 if !impl(ghc >= 8.0) build-depends:- semigroups >=0.18.3 && <0.19+ semigroups >=0.18.4 && <0.19 -- Servant dependencies build-depends:- servant == 0.13.*+ servant == 0.14.* -- 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:- base-compat >= 0.9.3 && < 0.11+ base-compat >= 0.10.1 && < 0.11 , base64-bytestring >= 1.0.0.1 && < 1.1- , exceptions >= 0.8.3 && < 0.11- , generics-sop >= 0.3.1.0 && < 0.4- , http-api-data >= 0.3.7.1 && < 0.4- , http-media >= 0.7.0 && < 0.8- , http-types >= 0.12 && < 0.13+ , exceptions >= 0.10.0 && < 0.11+ , free >= 5.0.2 && < 5.1+ , generics-sop >= 0.3.2.0 && < 0.4+ , http-api-data >= 0.3.8.1 && < 0.4+ , http-media >= 0.7.1.2 && < 0.8+ , http-types >= 0.12.1 && < 0.13 , network-uri >= 2.6.1.0 && < 2.7- , safe >= 0.3.15 && < 0.4+ , safe >= 0.3.17 && < 0.4 hs-source-dirs: src default-language: Haskell2010@@ -96,8 +98,8 @@ -- Additonal dependencies build-depends: deepseq >= 1.3.0.2 && <1.5- , hspec >= 2.4.4 && <2.6- , QuickCheck >= 2.10.1 && < 2.12+ , hspec >= 2.4.1 && <2.6+ , QuickCheck >= 2.11.3 && < 2.12 build-tool-depends:- hspec-discover:hspec-discover >= 2.4.4 && <2.6+ hspec-discover:hspec-discover >= 2.5.1 && <2.6
+ src/Servant/Client/Core/Internal/ClientF.hs view
@@ -0,0 +1,10 @@+{-# LANGUAGE DeriveFunctor #-}+module Servant.Client.Core.Internal.ClientF where++import Servant.Client.Core.Internal.Request++data ClientF a+ = RunRequest Request (Response -> a)+ | StreamingRequest Request (StreamingResponse -> a)+ | Throw ServantError+ deriving (Functor)
src/Servant/Client/Core/Internal/HasClient.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -97,6 +98,12 @@ class RunClient m => HasClient m api where type Client (m :: * -> *) (api :: *) :: * clientWithRoute :: Proxy m -> Proxy api -> Request -> Client m api+ hoistClientMonad+ :: Proxy m+ -> Proxy api+ -> (forall x. mon x -> mon' x)+ -> Client mon api+ -> Client mon' api -- | A client querying function for @a ':<|>' b@ will actually hand you@@ -118,6 +125,10 @@ clientWithRoute pm (Proxy :: Proxy a) req :<|> clientWithRoute pm (Proxy :: Proxy b) req + hoistClientMonad pm _ f (ca :<|> cb) =+ hoistClientMonad pm (Proxy :: Proxy a) f ca :<|>+ hoistClientMonad pm (Proxy :: Proxy b) f cb+ -- | Singleton type representing a client for an empty API. data EmptyClient = EmptyClient deriving (Eq, Show, Bounded, Enum) @@ -134,6 +145,7 @@ instance RunClient m => HasClient m EmptyAPI where type Client m EmptyAPI = EmptyClient clientWithRoute _pm Proxy _ = EmptyClient+ hoistClientMonad _ _ _ EmptyClient = EmptyClient -- | If you use a 'Capture' in one of your endpoints in your API, -- the corresponding querying function will automatically take@@ -166,6 +178,9 @@ where p = (toUrlPiece val) + hoistClientMonad pm _ f cl = \a ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl a)+ -- | If you use a 'CaptureAll' in one of your endpoints in your API, -- the corresponding querying function will automatically take an -- additional argument of a list of the type specified by your@@ -198,6 +213,9 @@ where ps = map (toUrlPiece) vals + hoistClientMonad pm _ f cl = \as ->+ hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)+ instance OVERLAPPABLE_ -- Note [Non-Empty Content Types] ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)@@ -213,6 +231,8 @@ accept = contentTypes (Proxy :: Proxy ct) method = reflectMethod (Proxy :: Proxy method) + hoistClientMonad _ _ f ma = f ma+ instance OVERLAPPING_ ( RunClient m, ReflectMethod method ) => HasClient m (Verb method status cts NoContent) where@@ -223,6 +243,8 @@ 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@@ -244,6 +266,8 @@ where method = reflectMethod (Proxy :: Proxy method) accept = contentTypes (Proxy :: Proxy ct) + hoistClientMonad _ _ f ma = f ma+ instance OVERLAPPING_ ( RunClient m, BuildHeadersTo ls, ReflectMethod method ) => HasClient m (Verb method status cts (Headers ls NoContent)) where@@ -256,12 +280,14 @@ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response } + hoistClientMonad _ _ f ma = f ma+ instance OVERLAPPABLE_ ( RunClient m, MimeUnrender ct a, ReflectMethod method, FramingUnrender framing a, BuildFromStream a (f a)- ) => HasClient m (Stream method framing ct (f a)) where+ ) => HasClient m (Stream method status framing ct (f a)) where - type Client m (Stream method framing ct (f a)) = m (f a)+ type Client m (Stream method status framing ct (f a)) = m (f a) clientWithRoute _pm Proxy req = do sresp <- streamingRequest req@@ -304,6 +330,7 @@ processResult (Left err, _) = Just (Left err) k go + hoistClientMonad _ _ f ma = f ma -- | If you use a 'Header' in one of your endpoints in your API, -- the corresponding querying function will automatically take@@ -345,6 +372,9 @@ add :: a -> Request add value = addHeader hname value req + hoistClientMonad pm _ f cl = \arg ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)+ -- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- functions. instance HasClient m api@@ -356,18 +386,24 @@ clientWithRoute pm Proxy = clientWithRoute pm (Proxy :: Proxy api) + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ -- | Ignore @'Summary'@ in client functions. instance HasClient m api => HasClient m (Summary desc :> api) where type Client m (Summary desc :> api) = Client m api clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ -- | Ignore @'Description'@ in client functions. instance HasClient m api => HasClient m (Description desc :> api) where type Client m (Description desc :> api) = Client m api clientWithRoute pm _ = clientWithRoute pm (Proxy :: Proxy api) + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ -- | If you use a 'QueryParam' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'QueryParam',@@ -410,6 +446,9 @@ pname :: Text pname = pack $ symbolVal (Proxy :: Proxy sym) + hoistClientMonad pm _ f cl = \arg ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl arg)+ -- | 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@@ -453,6 +492,9 @@ where pname = pack $ symbolVal (Proxy :: Proxy sym) paramlist' = map (Just . toQueryParam) paramlist + hoistClientMonad pm _ f cl = \as ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl as)+ -- | If you use a 'QueryFlag' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional 'Bool' argument.@@ -489,6 +531,8 @@ where paramname = pack $ symbolVal (Proxy :: Proxy sym) + hoistClientMonad pm _ f cl = \b ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl b) -- | Pick a 'Method' and specify where the server you want to query is. You get -- back the full `Response`.@@ -500,6 +544,8 @@ 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'.@@ -533,6 +579,9 @@ req ) + hoistClientMonad pm _ f cl = \a ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl a)+ -- | Make the querying function append @path@ to the request path. instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where type Client m (path :> api) = Client m api@@ -543,30 +592,40 @@ where p = pack $ symbolVal (Proxy :: Proxy path) + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ instance HasClient m api => HasClient m (Vault :> api) where type Client m (Vault :> api) = Client m api clientWithRoute pm Proxy req = clientWithRoute pm (Proxy :: Proxy api) req + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ instance HasClient m api => HasClient m (RemoteHost :> api) where type Client m (RemoteHost :> api) = Client m api clientWithRoute pm Proxy req = clientWithRoute pm (Proxy :: Proxy api) req + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ instance HasClient m api => HasClient m (IsSecure :> api) where type Client m (IsSecure :> api) = Client m api clientWithRoute pm Proxy req = clientWithRoute pm (Proxy :: Proxy api) req + hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl+ instance HasClient m subapi => HasClient m (WithNamedContext name context subapi) where type Client m (WithNamedContext name context 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)@@ -575,6 +634,9 @@ clientWithRoute pm Proxy req (AuthenticatedRequest (val,func)) = clientWithRoute pm (Proxy :: Proxy api) (func val req) + hoistClientMonad pm _ f cl = \authreq ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl authreq)+ -- * Basic Authentication instance HasClient m api => HasClient m (BasicAuth realm usr :> api) where@@ -582,6 +644,9 @@ clientWithRoute pm Proxy req val = clientWithRoute pm (Proxy :: Proxy api) (basicAuthReq val req)++ hoistClientMonad pm _ f cl = \bauth ->+ hoistClientMonad pm (Proxy :: Proxy api) f (cl bauth) {- Note [Non-Empty Content Types]
src/Servant/Client/Core/Internal/Request.hs view
@@ -1,14 +1,14 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-} module Servant.Client.Core.Internal.Request where @@ -16,9 +16,10 @@ import Prelude.Compat import Control.Monad.Catch (Exception)-import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString as BS+import qualified Data.ByteString.Builder as Builder import qualified Data.ByteString.Lazy as LBS+import Data.Int (Int64) import Data.Semigroup ((<>)) import qualified Data.Sequence as Seq import Data.Text (Text)@@ -58,13 +59,19 @@ , requestHeaders :: Seq.Seq Header , requestHttpVersion :: HttpVersion , requestMethod :: Method- } deriving (Eq, Show, Functor, Generic, Typeable)+ } deriving (Generic, Typeable) type Request = RequestF Builder.Builder --- | The request body. Currently only lazy ByteStrings are supported.-newtype RequestBody = RequestBodyLBS LBS.ByteString- deriving (Eq, Ord, Read, Show, Typeable)+-- | The request body. A replica of the @http-client@ @RequestBody@.+data RequestBody+ = RequestBodyLBS LBS.ByteString+ | RequestBodyBS BS.ByteString+ | RequestBodyBuilder Int64 Builder.Builder+ | RequestBodyStream Int64 ((IO BS.ByteString -> IO ()) -> IO ())+ | RequestBodyStreamChunked ((IO BS.ByteString -> IO ()) -> IO ())+ | RequestBodyIO (IO RequestBody)+ deriving (Generic, Typeable) data GenResponse a = Response { responseStatusCode :: Status
src/Servant/Client/Core/Internal/RunClient.hs view
@@ -10,6 +10,7 @@ import Prelude.Compat import Control.Monad (unless)+import Control.Monad.Free (Free (..), liftF) import Data.Foldable (toList) import Data.Proxy (Proxy) import qualified Data.Text as T@@ -18,16 +19,17 @@ import Servant.API (MimeUnrender, contentTypes, mimeUnrender)+ import Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..), StreamingResponse (..), ServantError (..))+import Servant.Client.Core.Internal.ClientF -class (Monad m) => RunClient m where+class Monad m => RunClient m where -- | How to make a request. runRequest :: Request -> m Response streamingRequest :: Request -> m StreamingResponse throwServantError :: ServantError -> m a- catchServantError :: m a -> (ServantError -> m a) -> m a checkContentTypeHeader :: RunClient m => Response -> m MediaType checkContentTypeHeader response =@@ -48,3 +50,8 @@ Right val -> return val where accept = toList $ contentTypes contentType++instance ClientF ~ f => RunClient (Free f) where+ runRequest req = liftF (RunRequest req id)+ streamingRequest req = liftF (StreamingRequest req id)+ throwServantError = liftF . Throw
+ src/Servant/Client/Free.hs view
@@ -0,0 +1,15 @@+{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, GADTs #-}+module Servant.Client.Free (+ client,+ ClientF (..),+ module Servant.Client.Core.Reexport,+ ) where++import Data.Proxy (Proxy (..))+import Control.Monad.Free+import Servant.Client.Core+import Servant.Client.Core.Reexport+import Servant.Client.Core.Internal.ClientF++client :: HasClient (Free ClientF) api => Proxy api -> Client (Free ClientF) api+client api = api `clientIn` (Proxy :: Proxy (Free ClientF))