diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,14 @@ [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.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)) + 0.12 ---- diff --git a/servant-client-core.cabal b/servant-client-core.cabal --- a/servant-client-core.cabal +++ b/servant-client-core.cabal @@ -1,5 +1,5 @@ name: servant-client-core -version: 0.12 +version: 0.13 synopsis: Core functionality and class for client function generation for servant APIs description: This library provides backend-agnostic generation of client functions. For @@ -22,7 +22,7 @@ GHC==7.8.4 GHC==7.10.3 GHC==8.0.2 - GHC==8.2.1 + GHC==8.2.2 source-repository head type: git @@ -39,25 +39,39 @@ Servant.Client.Core.Internal.HasClient Servant.Client.Core.Internal.Request Servant.Client.Core.Internal.RunClient + + -- 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 - , base64-bytestring >= 1.0.0.1 && < 1.1 - , bytestring >= 0.10 && < 0.11 - , containers >= 0.5 && < 0.6 - , exceptions >= 0.8 && < 0.9 - , generics-sop >= 0.1.0.0 && < 0.4 - , http-api-data >= 0.3.6 && < 0.4 - , http-media >= 0.6.2 && < 0.8 - , http-types >= 0.8.6 && < 0.11 + , bytestring >= 0.10.4.0 && < 0.11 + , containers >= 0.5.5.1 && < 0.6 , mtl >= 2.1 && < 2.3 - , network-uri >= 2.6 && < 2.7 - , safe >= 0.3.9 && < 0.4 - , servant == 0.12.* - , text >= 1.2 && < 1.3 + , text >= 1.2.3.0 && < 1.3 + if !impl(ghc >= 8.0) build-depends: - semigroups >=0.16.2.2 && <0.19 + semigroups >=0.18.3 && <0.19 + + -- Servant dependencies + build-depends: + servant == 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: + base-compat >= 0.9.3 && < 0.10 + , base64-bytestring >= 1.0.0.1 && < 1.1 + , exceptions >= 0.8.3 && < 0.9 + , generics-sop >= 0.3.1.0 && < 0.4 + , http-api-data >= 0.3.7.1 && < 0.4 + , http-media >= 0.7.1.1 && < 0.8 + , http-types >= 0.12 && < 0.13 + , network-uri >= 2.6.1.0 && < 2.7 + , safe >= 0.3.15 && < 0.4 + hs-source-dirs: src default-language: Haskell2010 ghc-options: -Wall @@ -69,14 +83,20 @@ default-language: Haskell2010 hs-source-dirs: test main-is: Spec.hs + other-modules: + Servant.Client.Core.Internal.BaseUrlSpec + + -- Dependencies inherited from the library. No need to specify bounds. build-depends: base , base-compat - , deepseq , servant-client-core - , hspec == 2.* - , QuickCheck >= 2.7 && < 2.11 + + -- Additonal dependencies + build-depends: + deepseq >= 1.3.0.2 && <1.5 + , hspec >= 2.4.4 && <2.5 + , QuickCheck >= 2.10.1 && < 2.12 + build-tool-depends: - hspec-discover:hspec-discover - other-modules: - Servant.Client.Core.Internal.BaseUrlSpec + hspec-discover:hspec-discover >= 2.4.4 && <2.5 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 @@ -40,9 +40,11 @@ -- * Response - , Response(..) + , Response + , GenResponse (..) , RunClient(..) , module Servant.Client.Core.Internal.BaseUrl + , StreamingResponse(..) -- * Writing HasClient instances -- | These functions need not be re-exported by backend libraries. diff --git a/src/Servant/Client/Core/Internal/HasClient.hs b/src/Servant/Client/Core/Internal/HasClient.hs --- a/src/Servant/Client/Core/Internal/HasClient.hs +++ b/src/Servant/Client/Core/Internal/HasClient.hs @@ -17,29 +17,38 @@ import Prelude () import Prelude.Compat +import Control.Concurrent (newMVar, modifyMVar) import Data.Foldable (toList) +import qualified Data.ByteString.Lazy as BL import Data.List (foldl') +import Data.Monoid ((<>)) import Data.Proxy (Proxy (Proxy)) import Data.Sequence (fromList) import Data.String (fromString) -import Data.Text (pack) +import Data.Text (Text, pack) import GHC.TypeLits (KnownSymbol, symbolVal) import qualified Network.HTTP.Types as H import Servant.API ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData, BuildHeadersTo (..), - Capture, CaptureAll, + BuildFromStream (..), + ByteStringParser (..), + Capture', CaptureAll, Description, EmptyAPI, - Header, Headers (..), + FramingUnrender (..), + Header', Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent (NoContent), - QueryFlag, QueryParam, + QueryFlag, QueryParam', QueryParams, Raw, ReflectMethod (..), - RemoteHost, ReqBody, + RemoteHost, ReqBody', + ResultStream(..), + SBoolI, + Stream, Summary, ToHttpApiData, Vault, Verb, WithNamedContext, @@ -49,6 +58,9 @@ toQueryParam, toUrlPiece) import Servant.API.ContentTypes (contentTypes) +import Servant.API.Modifiers (FoldRequired, + RequiredArgument, + foldRequiredArgument) import Servant.Client.Core.Internal.Auth import Servant.Client.Core.Internal.BasicAuth @@ -143,9 +155,9 @@ -- > getBook = client myApi -- > -- then you can just use "getBook" to query that endpoint instance (KnownSymbol capture, ToHttpApiData a, HasClient m api) - => HasClient m (Capture capture a :> api) where + => HasClient m (Capture' mods capture a :> api) where - type Client m (Capture capture a :> api) = + type Client m (Capture' mods capture a :> api) = a -> Client m api clientWithRoute pm Proxy req val = @@ -244,7 +256,55 @@ , getHeadersHList = buildHeadersTo . toList $ responseHeaders response } +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 + type Client m (Stream method framing ct (f a)) = m (f a) + + clientWithRoute _pm Proxy req = do + sresp <- streamingRequest req + { requestAccept = fromList [contentType (Proxy :: Proxy ct)] + , requestMethod = reflectMethod (Proxy :: Proxy method) + } + return . buildFromStream $ ResultStream $ \k -> + runStreamingResponse sresp $ \gres -> do + let reader = responseBody gres + let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a) + loop bs = do + res <- BL.fromStrict <$> reader + if BL.null res + then return $ parseEOF unrender res + else let sofar = (bs <> res) + in case parseIncremental unrender sofar of + Just x -> return x + Nothing -> loop sofar + (frameParser, remainder) <- loop BL.empty + state <- newMVar remainder + let frameLoop bs = do + res <- BL.fromStrict <$> reader + let addIsEmptyInfo (a, r) = (r, (a, BL.null r && BL.null res)) + if BL.null res + then if BL.null bs + then return ("", (Right "", True)) + else return . addIsEmptyInfo $ parseEOF frameParser bs + else let sofar = (bs <> res) + in case parseIncremental frameParser sofar of + Just x -> return $ addIsEmptyInfo x + Nothing -> frameLoop sofar + + go = processResult <$> modifyMVar state frameLoop + processResult (Right bs,isDone) = + if BL.null bs && isDone + then Nothing + else Just $ case mimeUnrender (Proxy :: Proxy ct) bs :: Either String a of + Left err -> Left err + Right x -> Right x + processResult (Left err, _) = Just (Left err) + k go + + -- | If you use a 'Header' in one of your endpoints in your API, -- the corresponding querying function will automatically take -- an additional argument of the type specified by your 'Header', @@ -270,20 +330,20 @@ -- > viewReferer = client myApi -- > -- then you can just use "viewRefer" to query that endpoint -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments -instance (KnownSymbol sym, ToHttpApiData a, HasClient m api) - => HasClient m (Header sym a :> api) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods)) + => HasClient m (Header' mods sym a :> api) where - type Client m (Header sym a :> api) = - Maybe a -> Client m api + type Client m (Header' mods sym a :> api) = + RequiredArgument mods a -> Client m api clientWithRoute pm Proxy req mval = - clientWithRoute pm (Proxy :: Proxy api) - (maybe req - (\value -> addHeader hname value req) - mval - ) + clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument + (Proxy :: Proxy mods) add (maybe req add) mval + where + hname = fromString $ symbolVal (Proxy :: Proxy sym) - where hname = fromString $ symbolVal (Proxy :: Proxy sym) + add :: a -> Request + add value = addHeader hname value req -- | Using a 'HttpVersion' combinator in your API doesn't affect the client -- functions. @@ -333,22 +393,22 @@ -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov -instance (KnownSymbol sym, ToHttpApiData a, HasClient m api) - => HasClient m (QueryParam sym a :> api) where +instance (KnownSymbol sym, ToHttpApiData a, HasClient m api, SBoolI (FoldRequired mods)) + => HasClient m (QueryParam' mods sym a :> api) where - type Client m (QueryParam sym a :> api) = - Maybe a -> Client m api + type Client m (QueryParam' mods sym a :> api) = + RequiredArgument mods a -> Client m api -- if mparam = Nothing, we don't add it to the query string clientWithRoute pm Proxy req mparam = - clientWithRoute pm (Proxy :: Proxy api) - (maybe req - (flip (appendToQueryString pname) req . Just) - mparamText - ) + clientWithRoute pm (Proxy :: Proxy api) $ foldRequiredArgument + (Proxy :: Proxy mods) add (maybe req add) mparam + where + add :: a -> Request + add param = appendToQueryString pname (Just $ toQueryParam param) req - where pname = pack $ symbolVal (Proxy :: Proxy sym) - mparamText = fmap toQueryParam mparam + pname :: Text + pname = pack $ symbolVal (Proxy :: Proxy sym) -- | If you use a 'QueryParams' in one of your endpoints in your API, -- the corresponding querying function will automatically take @@ -459,9 +519,9 @@ -- > addBook = client myApi -- > -- then you can just use "addBook" to query that endpoint instance (MimeRender ct a, HasClient m api) - => HasClient m (ReqBody (ct ': cts) a :> api) where + => HasClient m (ReqBody' mods (ct ': cts) a :> api) where - type Client m (ReqBody (ct ': cts) a :> api) = + type Client m (ReqBody' mods (ct ': cts) a :> api) = a -> Client m api clientWithRoute pm Proxy req body = diff --git a/src/Servant/Client/Core/Internal/Request.hs b/src/Servant/Client/Core/Internal/Request.hs --- a/src/Servant/Client/Core/Internal/Request.hs +++ b/src/Servant/Client/Core/Internal/Request.hs @@ -1,9 +1,11 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveFoldable #-} +{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -15,6 +17,7 @@ import Control.Monad.Catch (Exception) import qualified Data.ByteString.Builder as Builder +import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import Data.Semigroup ((<>)) import qualified Data.Sequence as Seq @@ -63,12 +66,15 @@ newtype RequestBody = RequestBodyLBS LBS.ByteString deriving (Eq, Ord, Read, Show, Typeable) -data Response = Response +data GenResponse a = Response { responseStatusCode :: Status - , responseBody :: LBS.ByteString , responseHeaders :: Seq.Seq Header , responseHttpVersion :: HttpVersion - } deriving (Eq, Show, Generic, Typeable) + , responseBody :: a + } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable) + +type Response = GenResponse LBS.ByteString +newtype StreamingResponse = StreamingResponse { runStreamingResponse :: forall a. (GenResponse (IO BS.ByteString) -> IO a) -> IO a } -- A GET request to the top-level path defaultRequest :: Request diff --git a/src/Servant/Client/Core/Internal/RunClient.hs b/src/Servant/Client/Core/Internal/RunClient.hs --- a/src/Servant/Client/Core/Internal/RunClient.hs +++ b/src/Servant/Client/Core/Internal/RunClient.hs @@ -18,12 +18,14 @@ import Servant.API (MimeUnrender, contentTypes, mimeUnrender) -import Servant.Client.Core.Internal.Request (Request, Response (..), +import Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..), + StreamingResponse (..), ServantError (..)) 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 diff --git a/src/Servant/Client/Core/Reexport.hs b/src/Servant/Client/Core/Reexport.hs --- a/src/Servant/Client/Core/Reexport.hs +++ b/src/Servant/Client/Core/Reexport.hs @@ -5,8 +5,11 @@ ( -- * HasClient HasClient(..) + -- * Response (for @Raw@) - , Response(..) + , Response + , StreamingResponse + , GenResponse(..) -- * Generic Client , ClientLike(..)