servant-client 0.13.0.1 → 0.14
raw patch · 8 files changed
+267/−72 lines, 8 filesdep +markdown-unlitdep −attoparsecdep −deepseqdep −http-client-tlsdep ~QuickCheckdep ~aesondep ~base
Dependencies added: markdown-unlit
Dependencies removed: attoparsec, deepseq, http-client-tls
Dependency ranges changed: QuickCheck, aeson, base, base-compat, containers, exceptions, generics-sop, hspec, http-client, http-media, http-types, monad-control, network, semigroupoids, semigroups, servant, servant-client-core, servant-server, stm, text, transformers-base, transformers-compat
Files
- CHANGELOG.md +42/−0
- README.lhs +41/−0
- README.md +24/−3
- servant-client.cabal +35/−33
- src/Servant/Client.hs +1/−0
- src/Servant/Client/Internal/HttpClient.hs +33/−3
- test/Servant/ClientSpec.hs +26/−0
- test/Servant/StreamSpec.hs +65/−33
CHANGELOG.md view
@@ -1,6 +1,48 @@ [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.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* 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))++- *servant-client* Add more constructors to `RequestBody`, including+ `RequestBodyStream`.+ *Note:* we are looking for http-library agnostic API,+ so the might change again soon.+ Tell us which constructors are useful for you!+ ([#913](https://github.com/haskell-servant/servant/pull/913))+ 0.13.0.1 --------
+ README.lhs view
@@ -0,0 +1,41 @@+# servant-client++++This library lets you automatically derive Haskell functions that let you query each endpoint of a *servant* webservice.++## Example++``` haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++import Data.Proxy+import Data.Text+import Network.HTTP.Client (newManager, defaultManagerSettings)+import Servant.API+import Servant.Client+++type Book = Text++type MyApi = "books" :> Get '[JSON] [Book] -- GET /books+ :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books++myApi :: Proxy MyApi+myApi = Proxy++-- 'client' allows you to produce operations to query an API from a client.+postNewBook :: Book -> ClientM Book+getAllBooks :: ClientM [Book]+(getAllBooks :<|> postNewBook) = client myApi+++main :: IO ()+main = do+ manager' <- newManager defaultManagerSettings+ res <- runClientM getAllBooks (mkClientEnv manager' (BaseUrl Http "localhost" 8081 ""))+ case res of+ Left err -> putStrLn $ "Error: " ++ show err+ Right books -> print books+```
README.md view
@@ -7,14 +7,35 @@ ## Example ``` haskell+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}++import Data.Proxy+import Data.Text+import Network.HTTP.Client (newManager, defaultManagerSettings)+import Servant.API+import Servant.Client+++type Book = Text+ type MyApi = "books" :> Get '[JSON] [Book] -- GET /books- :<|> "books" :> ReqBody Book :> Post '[JSON] Book -- POST /books+ :<|> "books" :> ReqBody '[JSON] Book :> Post '[JSON] Book -- POST /books myApi :: Proxy MyApi myApi = Proxy -getAllBooks :: Manager -> BaseUrl -> ExceptT String IO [Book]-postNewBook :: Book -> Manager -> BaseUrl -> ExceptT String IO Book -- 'client' allows you to produce operations to query an API from a client.+postNewBook :: Book -> ClientM Book+getAllBooks :: ClientM [Book] (getAllBooks :<|> postNewBook) = client myApi+++main :: IO ()+main = do+ manager' <- newManager defaultManagerSettings+ res <- runClientM getAllBooks (mkClientEnv manager' (BaseUrl Http "localhost" 8081 ""))+ case res of+ Left err -> putStrLn $ "Error: " ++ show err+ Right books -> print books ```
servant-client.cabal view
@@ -1,5 +1,5 @@ name: servant-client-version: 0.13.0.1+version: 0.14 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that@@ -17,11 +17,11 @@ build-type: Simple cabal-version: >=1.10 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 homepage: http://haskell-servant.readthedocs.org/ Bug-reports: http://github.com/haskell-servant/servant/issues extra-source-files:@@ -51,28 +51,25 @@ , transformers >= 0.3.0.0 && < 0.6 if !impl(ghc >= 8.0)- build-depends: semigroups >=0.18.3 && <0.19+ build-depends: semigroups >=0.18.4 && <0.19 -- Servant dependencies build-depends:- servant-client-core == 0.13.*+ servant-client-core == 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:- aeson >= 1.2.3.0 && < 1.4- , base-compat >= 0.9.3 && < 0.11- , 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.0 && < 0.8- , http-types >= 0.12 && < 0.13- , exceptions >= 0.8.3 && < 0.11- , 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.5.1 && < 0.7+ base-compat >= 0.10.1 && < 0.11+ , http-client >= 0.5.12 && < 0.6+ , http-media >= 0.7.1.2 && < 0.8+ , http-types >= 0.12.1 && < 0.13+ , exceptions >= 0.10.0 && < 0.11+ , monad-control >= 1.0.2.3 && < 1.1+ , semigroupoids >= 5.2.2 && < 5.3+ , stm >= 2.4.5.0 && < 2.5+ , transformers-base >= 0.4.5.2 && < 0.5+ , transformers-compat >= 0.6.2 && < 0.7 hs-source-dirs: src default-language: Haskell2010@@ -83,7 +80,7 @@ test-suite spec type: exitcode-stdio-1.0- ghc-options: -Wall+ ghc-options: -Wall -rtsopts -with-rtsopts=-T default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs@@ -97,10 +94,8 @@ , aeson , base-compat , bytestring- , containers , http-api-data , http-client- , http-media , http-types , mtl , servant-client@@ -117,14 +112,21 @@ -- Additonal dependencies build-depends:- deepseq >= 1.3.0.2 && < 1.5- , generics-sop >= 0.3.1.0 && < 0.4- , hspec >= 2.4.4 && < 2.6- , 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.*+ generics-sop >= 0.3.2.0 && < 0.4+ , hspec >= 2.5.1 && < 2.6+ , HUnit >= 1.6 && < 1.7+ , network >= 2.6.3.2 && < 2.8+ , QuickCheck >= 2.10.1 && < 2.12+ , servant == 0.14.*+ , servant-server == 0.14.* build-tool-depends:- hspec-discover:hspec-discover >= 2.4.4 && < 2.6+ hspec-discover:hspec-discover >= 2.5.1 && < 2.6++test-suite readme+ type: exitcode-stdio-1.0+ main-is: README.lhs+ build-depends: base, servant, http-client, text, servant-client, markdown-unlit+ build-tool-depends: markdown-unlit:markdown-unlit+ ghc-options: -pgmL markdown-unlit+ default-language: Haskell2010
src/Servant/Client.hs view
@@ -9,6 +9,7 @@ , runClientM , ClientEnv(..) , mkClientEnv+ , hoistClient , module Servant.Client.Core.Reexport ) where
src/Servant/Client/Internal/HttpClient.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} module Servant.Client.Internal.HttpClient where@@ -70,6 +71,28 @@ client :: HasClient ClientM api => Proxy api -> Client ClientM api client api = api `clientIn` (Proxy :: Proxy ClientM) +-- | Change the monad the client functions live in, by+-- supplying a conversion function+-- (a natural transformation to be precise).+--+-- For example, assuming you have some @manager :: 'Manager'@ and+-- @baseurl :: 'BaseUrl'@ around:+--+-- > type API = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int+-- > api :: Proxy API+-- > api = Proxy+-- > getInt :: IO Int+-- > postInt :: Int -> IO Int+-- > getInt :<|> postInt = hoistClient api (flip runClientM cenv) (client api)+-- > where cenv = mkClientEnv manager baseurl+hoistClient+ :: HasClient ClientM api+ => Proxy api+ -> (forall a. m a -> n a)+ -> Client m api+ -> Client n api+hoistClient = hoistClientMonad (Proxy :: Proxy ClientM)+ -- | @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@@ -96,7 +119,6 @@ runRequest = performRequest streamingRequest = performStreamingRequest throwServantError = throwError- catchServantError = catchError instance ClientLike (ClientM a) (ClientM a) where mkClient = id@@ -184,10 +206,18 @@ where hs = toList $ requestAccept r + convertBody bd = case bd of+ RequestBodyLBS body' -> Client.RequestBodyLBS body'+ RequestBodyBS body' -> Client.RequestBodyBS body'+ RequestBodyBuilder size body' -> Client.RequestBodyBuilder size body'+ RequestBodyStream size body' -> Client.RequestBodyStream size body'+ RequestBodyStreamChunked body' -> Client.RequestBodyStreamChunked body'+ RequestBodyIO body' -> Client.RequestBodyIO (convertBody <$> body')+ (body, contentTypeHdr) = case requestBody r of Nothing -> (Client.RequestBodyLBS "", Nothing)- Just (RequestBodyLBS body', typ)- -> (Client.RequestBodyLBS body', Just (hContentType, renderHeader typ))+ Just (body', typ)+ -> (convertBody body', Just (hContentType, renderHeader typ)) isSecure = case baseUrlScheme burl of Http -> False
test/Servant/ClientSpec.hs view
@@ -90,6 +90,7 @@ basicAuthSpec genAuthSpec genericClientSpec+ hoistClientSpec -- * test data types @@ -104,6 +105,9 @@ instance ToForm Person instance FromForm Person +instance Arbitrary Person where+ arbitrary = Person <$> arbitrary <*> arbitrary+ alice :: Person alice = Person "Alice" 42 @@ -488,6 +492,28 @@ left show <$> runClient (idChar (Just 'c')) baseUrl `shouldReturn` Right 'c' left show <$> runClient (getSum 3 4) baseUrl `shouldReturn` Right 7 left show <$> runClient doNothing baseUrl `shouldReturn` Right ()++-- * hoistClient++type HoistClientAPI = Get '[JSON] Int :<|> Capture "n" Int :> Post '[JSON] Int++hoistClientAPI :: Proxy HoistClientAPI+hoistClientAPI = Proxy++hoistClientServer :: Application -- implements HoistClientAPI+hoistClientServer = serve hoistClientAPI $ return 5 :<|> (\n -> return n)++hoistClientSpec :: Spec+hoistClientSpec = beforeAll (startWaiApp hoistClientServer) $ afterAll endWaiApp $ do+ describe "Servant.Client.hoistClient" $ do+ it "allows us to GET/POST/... requests in IO instead of ClientM" $ \(_, baseUrl) -> do+ let (getInt :<|> postInt)+ = hoistClient hoistClientAPI+ (fmap (either (error . show) id) . flip runClient baseUrl)+ (client hoistClientAPI)++ getInt `shouldReturn` 5+ postInt 5 `shouldReturn` 5 -- * utils
test/Servant/StreamSpec.hs view
@@ -26,26 +26,32 @@ #include "overlapping-compat.h" module Servant.StreamSpec (spec) where -import Prelude ()-import Prelude.Compat+import Control.Monad (replicateM_, void)+import qualified Data.ByteString as BS import Data.Proxy-import qualified Network.HTTP.Client as C-import System.IO.Unsafe (unsafePerformIO)+import qualified Network.HTTP.Client as C+import Prelude ()+import Prelude.Compat+import System.IO (IOMode (ReadMode), withFile)+import System.IO.Unsafe (unsafePerformIO) import Test.Hspec+import Test.QuickCheck -import Servant.API ((:<|>) ((:<|>)),- (:>),- EmptyAPI, JSON,- StreamGet,- NewlineFraming,- NetstringFraming,- ResultStream(..),- StreamGenerator(..))+import Servant.API ((:<|>) ((:<|>)), (:>), JSON,+ NetstringFraming, NewlineFraming,+ OctetStream, ResultStream (..),+ StreamGenerator (..), StreamGet,+ NoFraming) import Servant.Client+import Servant.ClientSpec (Person (..))+import qualified Servant.ClientSpec as CS import Servant.Server-import qualified Servant.ClientSpec as CS-import Servant.ClientSpec (Person(..)) +#if MIN_VERSION_base(4,10,0)+import GHC.Stats (gcdetails_mem_in_use_bytes, gc, getRTSStats)+#else+import GHC.Stats (currentBytesUsed, getGCStats)+#endif spec :: Spec spec = describe "Servant.Stream" $ do@@ -54,7 +60,7 @@ type StreamApi f = "streamGetNewline" :> StreamGet NewlineFraming JSON (f Person) :<|> "streamGetNetstring" :> StreamGet NetstringFraming JSON (f Person)- :<|> EmptyAPI+ :<|> "streamALot" :> StreamGet NoFraming OctetStream (f BS.ByteString) capi :: Proxy (StreamApi ResultStream)@@ -63,12 +69,9 @@ sapi :: Proxy (StreamApi StreamGenerator) sapi = Proxy --getGetNL :<|> getGetNS :<|> EmptyClient = client capi---getGetNL :: ClientM (ResultStream Person)-getGetNS :: ClientM (ResultStream Person)+getGetNL, getGetNS :: ClientM (ResultStream Person)+getGetALot :: ClientM (ResultStream BS.ByteString)+getGetNL :<|> getGetNS :<|> getGetALot = client capi alice :: Person alice = Person "Alice" 42@@ -77,16 +80,26 @@ 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)+server = serve sapi+ $ return (StreamGenerator (\f r -> f alice >> r bob >> r alice))+ :<|> return (StreamGenerator (\f r -> f alice >> r bob >> r alice))+ :<|> return (StreamGenerator lotsGenerator)+ where+ lotsGenerator f r = do+ void $ f ""+ void $ withFile "/dev/urandom" ReadMode $+ \handle -> streamFiveMBNTimes handle 1000 r+ return () + streamFiveMBNTimes handle left sink+ | left <= (0 :: Int) = return ()+ | otherwise = do+ msg <- BS.hGet handle (megabytes 5)+ _ <- sink msg+ streamFiveMBNTimes handle (left - 1) sink ++ {-# NOINLINE manager' #-} manager' :: C.Manager manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings@@ -94,20 +107,39 @@ 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+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+ it "works with 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+ it "works with 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)++ it "streams in constant memory" $ \(_, baseUrl) -> do+ Right (ResultStream res) <- runClient getGetALot baseUrl+ let consumeNChunks n = replicateM_ n (res void)+ consumeNChunks 900+#if MIN_VERSION_base(4,10,0)+ memUsed <- gcdetails_mem_in_use_bytes . gc <$> getRTSStats+#else+ memUsed <- currentBytesUsed <$> getGCStats+#endif+ memUsed `shouldSatisfy` (< megabytes 22)++megabytes :: Num a => a -> a+megabytes n = n * (1000 ^ (2 :: Int))