servant-client 0.12.0.1 → 0.13
raw patch · 6 files changed
+235/−48 lines, 6 filesdep +semigroupsdep +stmdep +timedep ~HUnitdep ~QuickCheckdep ~aeson
Dependencies added: semigroups, stm, time
Dependency ranges changed: HUnit, QuickCheck, aeson, attoparsec, base, base-compat, bytestring, containers, deepseq, exceptions, generics-sop, hspec, http-client, http-client-tls, http-media, http-types, network, semigroupoids, servant, servant-client-core, servant-server, text, transformers, transformers-compat
Files
- CHANGELOG.md +11/−0
- servant-client.cabal +54/−29
- src/Servant/Client.hs +4/−1
- src/Servant/Client/Internal/HttpClient.hs +51/−16
- test/Servant/ClientSpec.hs +2/−2
- test/Servant/StreamSpec.hs +113/−0
CHANGELOG.md view
@@ -1,6 +1,17 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/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.13+----++- Streaming endpoint support.+ ([#836](https://github.com/haskell-servant/servant/pull/836))+- *servant* Add `Servant.API.Modifiers`+ ([#873](https://github.com/haskell-servant/servant/pull/873))+- *servant-client* Support `http-client`’s `CookieJar`+ ([#897](https://github.com/haskell-servant/servant/pull/897)+ [#883](https://github.com/haskell-servant/servant/pull/883))+ 0.12.0.1 --------
servant-client.cabal view
@@ -1,5 +1,5 @@ name: servant-client-version: 0.12.0.1+version: 0.13 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that@@ -20,7 +20,7 @@ GHC==7.8.4 GHC==7.10.3 GHC==8.0.2- GHC==8.2.1+ GHC==8.2.2 homepage: http://haskell-servant.readthedocs.org/ Bug-reports: http://github.com/haskell-servant/servant/issues extra-source-files:@@ -35,26 +35,44 @@ exposed-modules: Servant.Client Servant.Client.Internal.HttpClient++ -- Bundled with GHC: Lower bound to not force re-installs+ -- text and mtl are bundled starting with GHC-8.4+ --+ -- note: mtl lower bound is so low because of GHC-7.8 build-depends: base >= 4.7 && < 4.11- , base-compat >= 0.9.1 && < 0.10- , bytestring >= 0.10 && < 0.11- , aeson >= 0.7 && < 1.3- , attoparsec >= 0.12 && < 0.14- , containers >= 0.5 && < 0.6- , http-client >= 0.4.30 && < 0.6- , http-client-tls >= 0.2.2 && < 0.4- , http-media >= 0.6.2 && < 0.8- , http-types >= 0.8.6 && < 0.11- , exceptions >= 0.8 && < 0.9- , monad-control >= 1.0.0.4 && < 1.1+ , bytestring >= 0.10.4.0 && < 0.11+ , containers >= 0.5.5.1 && < 0.6 , mtl >= 2.1 && < 2.3- , semigroupoids >= 4.3 && < 5.3- , servant-client-core == 0.12.*- , text >= 1.2 && < 1.3- , transformers >= 0.3 && < 0.6+ , text >= 1.2.3.0 && < 1.3+ , time >= 1.4.2 && < 1.9+ , transformers >= 0.3.0.0 && < 0.6++ if !impl(ghc >= 8.0)+ build-depends: semigroups >=0.18.3 && <0.19++ -- Servant dependencies+ build-depends:+ servant-client-core == 0.13.*++ -- 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.2.3.0 && < 1.3+ , base-compat >= 0.9.3 && < 0.10+ , attoparsec >= 0.13.2.0 && < 0.14+ , http-client >= 0.5.7.1 && < 0.6+ , http-client-tls >= 0.3.5.1 && < 0.4+ , http-media >= 0.7.1.1 && < 0.8+ , http-types >= 0.12 && < 0.13+ , exceptions >= 0.8.3 && < 0.9+ , monad-control >= 1.0.0.4 && < 1.1+ , semigroupoids >= 5.2.1 && < 5.3+ , stm >= 2.4.4.1 && < 2.5 , transformers-base >= 0.4.4 && < 0.5- , transformers-compat >= 0.4 && < 0.6+ , transformers-compat >= 0.5.1 && < 0.6+ hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall@@ -68,33 +86,40 @@ default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs- build-tool-depends:- hspec-discover:hspec-discover other-modules: Servant.ClientSpec+ Servant.StreamSpec++ -- Dependencies inherited from the library. No need to specify bounds. build-depends:- base == 4.*+ base , aeson , base-compat , bytestring , containers- , deepseq- , hspec == 2.* , http-api-data , http-client , http-media , http-types- , HUnit , mtl- , network >= 2.6- , QuickCheck >= 2.7- , servant , servant-client , servant-client-core- , servant-server == 0.12.* , text , transformers , transformers-compat , wai , warp- , generics-sop++ -- Additonal dependencies+ build-depends:+ deepseq >= 1.3.0.2 && < 1.5+ , generics-sop >= 0.3.1.0 && < 0.4+ , hspec >= 2.4.4 && < 2.5+ , HUnit >= 1.6 && < 1.7+ , network >= 2.6.3.2 && < 2.7+ , QuickCheck >= 2.10.1 && < 2.12+ , servant == 0.13.*+ , servant-server == 0.13.*++ build-tool-depends:+ hspec-discover:hspec-discover >= 2.4.4 && < 2.5
src/Servant/Client.hs view
@@ -1,3 +1,5 @@++ -- | This module provides 'client' which can automatically generate -- querying functions for each endpoint just from the type representing your -- API.@@ -6,8 +8,9 @@ , ClientM , runClientM , ClientEnv(..)+ , mkClientEnv , module Servant.Client.Core.Reexport ) where -import Servant.Client.Internal.HttpClient import Servant.Client.Core.Reexport+import Servant.Client.Internal.HttpClient
src/Servant/Client/Internal/HttpClient.hs view
@@ -8,32 +8,32 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-}---- | @http-client@-based client requests executor module Servant.Client.Internal.HttpClient where - import Prelude () import Prelude.Compat +import Control.Concurrent.STM.TVar import Control.Exception import Control.Monad import Control.Monad.Base (MonadBase (..)) import Control.Monad.Catch (MonadCatch, MonadThrow) import Control.Monad.Error.Class (MonadError (..)) import Control.Monad.Reader+import Control.Monad.STM (atomically) import Control.Monad.Trans.Control (MonadBaseControl (..)) import Control.Monad.Trans.Except import Data.ByteString.Builder (toLazyByteString) import qualified Data.ByteString.Lazy as BSL-import Data.Foldable (toList)+import Data.Foldable (toList, for_) import Data.Functor.Alt (Alt (..)) import Data.Maybe (maybeToList)-import Data.Monoid ((<>))+import Data.Semigroup ((<>)) import Data.Proxy (Proxy (..)) import Data.Sequence (fromList) import Data.String (fromString) import qualified Data.Text as T+import Data.Time.Clock (getCurrentTime) import GHC.Generics import Network.HTTP.Media (renderHeader) import Network.HTTP.Types (hContentType, renderQuery,@@ -47,8 +47,13 @@ = ClientEnv { manager :: Client.Manager , baseUrl :: BaseUrl+ , cookieJar :: Maybe (TVar Client.CookieJar) } +-- | 'ClientEnv' smart constructor.+mkClientEnv :: Client.Manager -> BaseUrl -> ClientEnv+mkClientEnv mgr burl = ClientEnv mgr burl Nothing+ -- | Generates a set of client functions for an API. -- -- Example:@@ -68,7 +73,7 @@ -- | @ClientM@ is the monad in which client functions run. Contains the -- 'Client.Manager' and 'BaseUrl' used for requests in the reader environment. newtype ClientM a = ClientM- { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }+ { unClientM :: ReaderT ClientEnv (ExceptT ServantError IO) a } deriving ( Functor, Applicative, Monad, MonadIO, Generic , MonadReader ClientEnv, MonadError ServantError, MonadThrow , MonadCatch)@@ -79,7 +84,7 @@ instance MonadBaseControl IO ClientM where type StM ClientM a = Either ServantError a - liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . runClientM')))+ liftBaseWith f = ClientM (liftBaseWith (\g -> f (g . unClientM))) restoreM st = ClientM (restoreM st) @@ -89,6 +94,7 @@ instance RunClient ClientM where runRequest = performRequest+ streamingRequest = performStreamingRequest throwServantError = throwError catchServantError = catchError @@ -96,28 +102,57 @@ mkClient = id runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)-runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm-+runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm performRequest :: Request -> ClientM Response performRequest req = do- m <- asks manager- burl <- asks baseUrl- let request = requestToClientRequest burl req+ ClientEnv m burl cookieJar' <- ask+ let clientRequest = requestToClientRequest burl req+ request <- case cookieJar' of+ Nothing -> pure clientRequest+ Just cj -> liftIO $ do+ now <- getCurrentTime+ atomically $ do+ oldCookieJar <- readTVar cj+ let (newRequest, newCookieJar) =+ Client.insertCookiesIntoRequest+ (requestToClientRequest burl req)+ oldCookieJar+ now+ writeTVar cj newCookieJar+ pure newRequest eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m case eResponse of- Left err -> throwError $ err+ Left err -> throwError err Right response -> do+ for_ cookieJar' $ \cj -> liftIO $ do+ now' <- getCurrentTime+ atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now') let status = Client.responseStatus response status_code = statusCode status- ourResponse = clientResponseToReponse response+ ourResponse = clientResponseToResponse response unless (status_code >= 200 && status_code < 300) $ throwError $ FailureResponse ourResponse return ourResponse -clientResponseToReponse :: Client.Response BSL.ByteString -> Response-clientResponseToReponse r = Response+performStreamingRequest :: Request -> ClientM StreamingResponse+performStreamingRequest req = do+ m <- asks manager+ burl <- asks baseUrl+ let request = requestToClientRequest burl req+ return $ StreamingResponse $+ \k -> Client.withResponse request m $+ \r -> do+ let status = Client.responseStatus r+ status_code = statusCode status+ unless (status_code >= 200 && status_code < 300) $ do+ b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)+ throw $ FailureResponse $ clientResponseToResponse r { Client.responseBody = b }+ k (clientResponseToResponse r)++clientResponseToResponse :: Client.Response a -> GenResponse a+clientResponseToResponse r = Response { responseStatusCode = Client.responseStatus r , responseBody = Client.responseBody r , responseHeaders = fromList $ Client.responseHeaders r
test/Servant/ClientSpec.hs view
@@ -24,7 +24,7 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-} #include "overlapping-compat.h"-module Servant.ClientSpec (spec) where+module Servant.ClientSpec (spec, Person(..), startWaiApp, endWaiApp) where import Prelude () import Prelude.Compat@@ -302,7 +302,7 @@ manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)-runClient x baseUrl' = runClientM x (ClientEnv manager' baseUrl')+runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl') sucessSpec :: Spec sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
+ test/Servant/StreamSpec.hs view
@@ -0,0 +1,113 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+#if __GLASGOW_HASKELL__ >= 800+{-# OPTIONS_GHC -freduction-depth=100 #-}+#else+{-# OPTIONS_GHC -fcontext-stack=100 #-}+#endif+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++#include "overlapping-compat.h"+module Servant.StreamSpec (spec) where++import Prelude ()+import Prelude.Compat+import Data.Proxy+import qualified Network.HTTP.Client as C+import System.IO.Unsafe (unsafePerformIO)+import Test.Hspec++import Servant.API ((:<|>) ((:<|>)),+ (:>),+ EmptyAPI, JSON,+ StreamGet,+ NewlineFraming,+ NetstringFraming,+ ResultStream(..),+ StreamGenerator(..))+import Servant.Client+import Servant.Server+import qualified Servant.ClientSpec as CS+import Servant.ClientSpec (Person(..))+++spec :: Spec+spec = describe "Servant.Stream" $ do+ streamSpec++type StreamApi f =+ "streamGetNewline" :> StreamGet NewlineFraming JSON (f Person)+ :<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (f Person)+ :<|> EmptyAPI+++capi :: Proxy (StreamApi ResultStream)+capi = Proxy++sapi :: Proxy (StreamApi StreamGenerator)+sapi = Proxy+++getGetNL :<|> getGetNS :<|> EmptyClient = client capi+++getGetNL :: ClientM (ResultStream Person)+getGetNS :: ClientM (ResultStream Person)++alice :: Person+alice = Person "Alice" 42++bob :: Person+bob = Person "Bob" 25++server :: Application+server = serve sapi (+ (return (StreamGenerator (\f r -> f alice >> r bob >> r alice))+ :: Handler (StreamGenerator Person))+ :<|>+ (return (StreamGenerator (\f r -> f alice >> r bob >> r alice))+ :: Handler (StreamGenerator Person))+ :<|>+ emptyServer)+++{-# NOINLINE manager' #-}+manager' :: C.Manager+manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings++runClient :: ClientM a -> BaseUrl -> IO (Either ServantError a)+runClient x baseUrl' = runClientM x (mkClientEnv manager' baseUrl')++runResultStream :: ResultStream a -> IO (Maybe (Either String a), Maybe (Either String a), Maybe (Either String a), Maybe (Either String a))+runResultStream (ResultStream k) = k $ \act -> (,,,) <$> act <*> act <*> act <*> act++streamSpec :: Spec+streamSpec = beforeAll (CS.startWaiApp server) $ afterAll CS.endWaiApp $ do++ it "Servant.API.StreamGet.Newline" $ \(_, baseUrl) -> do+ Right res <- runClient getGetNL baseUrl+ let jra = Just (Right alice)+ jrb = Just (Right bob)+ runResultStream res `shouldReturn` (jra, jrb, jra, Nothing)++ it "Servant.API.StreamGet.Netstring" $ \(_, baseUrl) -> do+ Right res <- runClient getGetNS baseUrl+ let jra = Just (Right alice)+ jrb = Just (Right bob)+ runResultStream res `shouldReturn` (jra, jrb, jra, Nothing)