servant-client-core 0.14.1 → 0.15

raw patch · 16 files changed

+357/−208 lines, 16 filesdep +aesondep +template-haskelldep +transformersdep −http-api-datadep −semigroupsdep ~QuickCheckdep ~basedep ~base-compatsetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies added: aeson, template-haskell, transformers

Dependencies removed: http-api-data, semigroups

Dependency ranges changed: QuickCheck, base, base-compat, bytestring, containers, deepseq, free, generics-sop, hspec, http-media, http-types, servant

API changes (from Hackage documentation)

Files

• CHANGELOG.md +75/−0
• LICENSE +1/−1
• Setup.hs +1/−1
• include/overlapping-compat.h +0/−8
• servant-client-core.cabal +31/−32
• src/Servant/Client/Core.hs +7/−7
• src/Servant/Client/Core/Internal/Auth.hs +2/−1
• src/Servant/Client/Core/Internal/BaseUrl.hs +71/−7
• src/Servant/Client/Core/Internal/BasicAuth.hs +10/−5
• src/Servant/Client/Core/Internal/ClientF.hs +1/−1
• src/Servant/Client/Core/Internal/Generic.hs +12/−13
• src/Servant/Client/Core/Internal/HasClient.hs +62/−95
• src/Servant/Client/Core/Internal/Request.hs +49/−15
• src/Servant/Client/Core/Internal/RunClient.hs +25/−15
• src/Servant/Client/Core/Reexport.hs +1/−1
• src/Servant/Client/Free.hs +9/−6

@@ -1,6 +1,81 @@ [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.15+----++- Streaming refactoring.+  [#991](https://github.com/haskell-servant/servant/pull/991)+  [#1076](https://github.com/haskell-servant/servant/pull/1076)+  [#1077](https://github.com/haskell-servant/servant/pull/1077)++  The streaming functionality (`Servant.API.Stream`) is refactored to use+  `servant`'s own `SourceIO` type (see `Servant.Types.SourceT` documentation),+  which replaces both `StreamGenerator` and `ResultStream` types.++  New conversion type-classes are `ToSourceIO` and `FromSourceIO`+  (replacing `ToStreamGenerator` and `BuildFromStream`).+  There are instances for *conduit*, *pipes* and *machines* in new packages:+  [servant-conduit](https://hackage.haskell.org/package/servant-conduit)+  [servant-pipes](https://hackage.haskell.org/package/servant-pipes) and+  [servant-machines](https://hackage.haskell.org/package/servant-machines)+  respectively.++  Writing new framing strategies is simpler. Check existing strategies for examples.++  This change shouldn't affect you, if you don't use streaming endpoints.++- *servant-client* Separate streaming client.+  [#1066](https://github.com/haskell-servant/servant/pull/1066)++  We now have two `http-client` based clients,+  in `Servant.Client` and `Servant.Client.Streaming`.++  Their API is the same, except for+  - `Servant.Client` **cannot** request `Stream` endpoints.+  - `Servant.Client` is *run* by direct+    `runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)`+  - `Servant.Client.Streaming` **can** request `Stream` endpoints.+  - `Servant.Client.Streaming` is *used* by CPSised+    `withClientM :: ClientM a -> ClientEnv -> (Either ServantError a -> IO b) -> IO b`++  To access `Stream` endpoints use `Servant.Client.Streaming` with+  `withClientM`; otherwise you can continue using `Servant.Client` with `runClientM`.+  You can use both too, `ClientEnv` and `BaseUrl` types are same for both.++  **Note:** `Servant.Client.Streaming` doesn't *stream* non-`Stream` endpoints.+  Requesting ordinary `Verb` endpoints (e.g. `Get`) will block until+  the whole response is received.++  There is `Servant.Client.Streaming.runClientM` function, but it has+  restricted type. `NFData a` constraint prevents using it with+  `SourceT`, `Conduit` etc. response types.++  ```haskell+  runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ServantError a)+  ```++  This change shouldn't affect you, if you don't use streaming endpoints.++- *servant-client-core* Related to the previous:+  `streamingResponse` is removed from `RunClient`.+  We have a new type-class:++  ```haskell+  class RunClient m =>  RunStreamingClient m where+      withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a+  ```++- Drop support for GHC older than 8.0+  [#1008](https://github.com/haskell-servant/servant/pull/1008)+  [#1009](https://github.com/haskell-servant/servant/pull/1009)++- *servant-client-core* Add `NFData (GenResponse a)` and `NFData ServantError` instances.+  [#1076](https://github.com/haskell-servant/servant/pull/1076)++- *servant-client-core* Add `aeson` and `Lift BaseUrl` instances+  [#1037](https://github.com/haskell-servant/servant/pull/1037)+ 0.14.1 ------ 

@@ -1,4 +1,4 @@-Copyright (c) 2017, Servant Contributors+Copyright (c) 2017-2018, Servant Contributors  All rights reserved. 

@@ -1,2 +1,2 @@-import Distribution.Simple+import           Distribution.Simple main = defaultMain

@@ -1,8 +0,0 @@-#if __GLASGOW_HASKELL__ >= 710-#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}-#define OVERLAPPING_  {-# OVERLAPPING #-}-#else-{-# LANGUAGE OverlappingInstances #-}-#define OVERLAPPABLE_-#define OVERLAPPING_-#endif

@@ -1,29 +1,30 @@+cabal-version:       >=1.10 name:                servant-client-core-version:             0.14.1+version:             0.15+ synopsis:            Core functionality and class for client function generation for servant APIs+category:            Servant, Web description:   This library provides backend-agnostic generation of client functions. For   more information, see the README.++homepage:            http://haskell-servant.readthedocs.org/+bug-reports:         http://github.com/haskell-servant/servant/issues license:             BSD3 license-file:        LICENSE author:              Servant Contributors maintainer:          haskell-servant-maintainers@googlegroups.com-homepage:            http://haskell-servant.readthedocs.org/-bug-reports:         http://github.com/haskell-servant/servant/issues-cabal-version:       >=1.10-copyright:           2014-2016 Zalora South East Asia Pte Ltd, 2016-2017 Servant Contributors-category:            Web+copyright:           2014-2016 Zalora South East Asia Pte Ltd, 2016-2018 Servant Contributors build-type:          Simple+tested-with:+  GHC ==8.0.2+   || ==8.2.2+   || ==8.4.4+   || ==8.6.2+ extra-source-files:-  include/*.h   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.3  source-repository head   type:              git@@ -49,37 +50,35 @@   --   -- note: mtl lower bound is so low because of GHC-7.8   build-depends:-      base                  >= 4.7      && < 4.12-    , bytestring            >= 0.10.4.0 && < 0.11-    , containers            >= 0.5.5.1  && < 0.6+      base                  >= 4.9      && < 4.13+    , bytestring            >= 0.10.8.1 && < 0.11+    , containers            >= 0.5.7.1  && < 0.7+    , deepseq               >= 1.4.2.0  && < 1.5     , text                  >= 1.2.3.0  && < 1.3--  if !impl(ghc >= 8.0)-    build-depends:-        semigroups          >=0.18.4 && <0.19+    , transformers          >= 0.5.2.0  && < 0.6+    , template-haskell      >= 2.11.1.0 && < 2.15    -- Servant dependencies   build-depends:-        servant            >= 0.14.1 && <0.15+        servant            >= 0.15 && <0.16    -- 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.10.1   && < 0.11+      aeson                 >= 1.4.1.0  && < 1.5+    , base-compat           >= 0.10.5   && < 0.11     , base64-bytestring     >= 1.0.0.1  && < 1.1     , exceptions            >= 0.10.0   && < 0.11-    , free                  >= 5.0.2    && < 5.2-    , 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+    , free                  >= 5.1      && < 5.2+    , generics-sop          >= 0.4.0.1  && < 0.5+    , http-media            >= 0.7.1.3  && < 0.8+    , http-types            >= 0.12.2   && < 0.13     , network-uri           >= 2.6.1.0  && < 2.7     , safe                  >= 0.3.17   && < 0.4    hs-source-dirs:      src   default-language:    Haskell2010   ghc-options:         -Wall-  include-dirs:        include  test-suite spec   type:                exitcode-stdio-1.0@@ -98,9 +97,9 @@    -- Additonal dependencies   build-depends:-      deepseq    >= 1.3.0.2 && <1.5-    , hspec      >= 2.4.1   && <2.6-    , QuickCheck >= 2.11.3  && < 2.12+      deepseq    >= 1.4.2.0  && < 1.5+    , hspec      >= 2.6.0    && < 2.7+    , QuickCheck >= 2.12.6.1 && < 2.13    build-tool-depends:-    hspec-discover:hspec-discover >= 2.5.1 && <2.6+    hspec-discover:hspec-discover >= 2.6.0 && <2.7

@@ -44,7 +44,9 @@   , GenResponse (..)   , RunClient(..)   , module Servant.Client.Core.Internal.BaseUrl-  , StreamingResponse(..)+  -- ** Streaming+  , RunStreamingClient(..)+  , StreamingResponse    -- * Writing HasClient instances   -- | These functions need not be re-exported by backend libraries.@@ -55,13 +57,11 @@   , setRequestBody   ) where import           Servant.Client.Core.Internal.Auth-import           Servant.Client.Core.Internal.BaseUrl   (BaseUrl (..),-                                                         InvalidBaseUrlException,-                                                         Scheme (..),-                                                         parseBaseUrl,-                                                         showBaseUrl)+import           Servant.Client.Core.Internal.BaseUrl+                 (BaseUrl (..), InvalidBaseUrlException, Scheme (..),+                 parseBaseUrl, showBaseUrl) import           Servant.Client.Core.Internal.BasicAuth-import           Servant.Client.Core.Internal.HasClient import           Servant.Client.Core.Internal.Generic+import           Servant.Client.Core.Internal.HasClient import           Servant.Client.Core.Internal.Request import           Servant.Client.Core.Internal.RunClient

@@ -6,7 +6,8 @@  module Servant.Client.Core.Internal.Auth where -import           Servant.Client.Core.Internal.Request (Request)+import           Servant.Client.Core.Internal.Request+                 (Request)  -- | For a resource protected by authentication (e.g. AuthProtect), we need -- to provide the client with some data used to add authentication data

@@ -1,13 +1,25 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE DeriveLift         #-} {-# LANGUAGE ViewPatterns       #-} module Servant.Client.Core.Internal.BaseUrl where -import           Control.Monad.Catch (Exception, MonadThrow, throwM)+import           Control.Monad.Catch+                 (Exception, MonadThrow, throwM)+import           Data.Aeson+                 (FromJSON (..), FromJSONKey (..), ToJSON (..), ToJSONKey (..))+import           Data.Aeson.Types+                 (FromJSONKeyFunction (..), contramapToJSONKeyFunction,+                 withText)+import           Data.Data+                 (Data) import           Data.List-import           Data.Typeable+import qualified Data.Text                  as T import           GHC.Generics-import           Network.URI         hiding (path)+import           Language.Haskell.TH.Syntax+                 (Lift)+import           Network.URI                hiding+                 (path) import           Safe import           Text.Read @@ -15,16 +27,18 @@ data Scheme =     Http  -- ^ http://   | Https -- ^ https://-  deriving (Show, Eq, Ord, Generic)+  deriving (Show, Eq, Ord, Generic, Lift, Data)  -- | Simple data type to represent the target of HTTP requests --   for servant's automatically-generated clients. data BaseUrl = BaseUrl-  { baseUrlScheme :: Scheme -- ^ URI scheme to use+  { baseUrlScheme :: Scheme   -- ^ URI scheme to use   , baseUrlHost   :: String   -- ^ host (eg "haskell.org")   , baseUrlPort   :: Int      -- ^ port (eg 80)   , baseUrlPath   :: String   -- ^ path (eg "/a/b/c")-  } deriving (Show, Ord, Generic)+  } deriving (Show, Ord, Generic, Lift, Data)+-- TODO: Ord is more precise than Eq+-- TODO: Add Hashable instance?  instance Eq BaseUrl where     BaseUrl a b c path == BaseUrl a' b' c' path'@@ -32,6 +46,36 @@         where s ('/':x) = x               s x       = x +-- | >>> traverse_ (LBS8.putStrLn . encode) $ parseBaseUrl "api.example.com"+-- "http://api.example.com"+instance ToJSON BaseUrl where+    toJSON     = toJSON . showBaseUrl+    toEncoding = toEncoding . showBaseUrl++-- | >>> parseBaseUrl "api.example.com" >>= decode . encode :: Maybe BaseUrl+-- Just (BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""})+instance FromJSON BaseUrl where+    parseJSON = withText "BaseUrl" $ \t -> case parseBaseUrl (T.unpack t) of+        Just u  -> return u+        Nothing -> fail $ "Invalid base url: " ++ T.unpack t++-- | >>> :{+-- traverse_ (LBS8.putStrLn . encode) $ do+--   u1 <- parseBaseUrl "api.example.com"+--   u2 <- parseBaseUrl "example.com"+--   return $ Map.fromList [(u1, 'x'), (u2, 'y')]+-- :}+-- {"http://api.example.com":"x","http://example.com":"y"}+instance ToJSONKey BaseUrl where+    toJSONKey = contramapToJSONKeyFunction showBaseUrl toJSONKey++instance FromJSONKey BaseUrl where+    fromJSONKey = FromJSONKeyTextParser $ \t -> case parseBaseUrl (T.unpack t) of+        Just u  -> return u+        Nothing -> fail $ "Invalid base url: " ++ T.unpack t++-- | >>> showBaseUrl <$> parseBaseUrl "api.example.com"+-- "http://api.example.com" showBaseUrl :: BaseUrl -> String showBaseUrl (BaseUrl urlscheme host port path) =   schemeString ++ "//" ++ host ++ (portString </> path)@@ -45,9 +89,22 @@         (Https, 443) -> ""         _ -> ":" ++ show port -data InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show, Typeable)+newtype InvalidBaseUrlException = InvalidBaseUrlException String deriving (Show) instance Exception InvalidBaseUrlException +-- |+--+-- >>> parseBaseUrl "api.example.com"+-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}+--+-- /Note:/ trailing slash is removed+--+-- >>> parseBaseUrl "api.example.com/"+-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = ""}+--+-- >>> parseBaseUrl "api.example.com/dir/"+-- BaseUrl {baseUrlScheme = Http, baseUrlHost = "api.example.com", baseUrlPort = 80, baseUrlPath = "/dir"}+-- parseBaseUrl :: MonadThrow m => String -> m BaseUrl parseBaseUrl s = case parseURI (removeTrailingSlash s) of   -- This is a rather hacky implementation and should be replaced with something@@ -67,3 +124,10 @@   removeTrailingSlash str = case lastMay str of     Just '/' -> init str     _ -> str++-- $setup+--+-- >>> import Data.Aeson+-- >>> import Data.Foldable (traverse_)+-- >>> import qualified Data.ByteString.Lazy.Char8 as LBS8+-- >>> import qualified Data.Map.Strict as Map

@@ -6,11 +6,16 @@  module Servant.Client.Core.Internal.BasicAuth where -import           Data.ByteString.Base64               (encode)-import           Data.Monoid                          ((<>))-import           Data.Text.Encoding                   (decodeUtf8)-import           Servant.API.BasicAuth                (BasicAuthData (BasicAuthData))-import           Servant.Client.Core.Internal.Request (Request, addHeader)+import           Data.ByteString.Base64+                 (encode)+import           Data.Monoid+                 ((<>))+import           Data.Text.Encoding+                 (decodeUtf8)+import           Servant.API.BasicAuth+                 (BasicAuthData (BasicAuthData))+import           Servant.Client.Core.Internal.Request+                 (Request, addHeader)  -- | Authenticate a request using Basic Authentication basicAuthReq :: BasicAuthData -> Request -> Request

@@ -1,7 +1,7 @@ {-# LANGUAGE DeriveFunctor #-} module Servant.Client.Core.Internal.ClientF where -import Servant.Client.Core.Internal.Request+import           Servant.Client.Core.Internal.Request  data ClientF a     = RunRequest Request (Response -> a)

@@ -1,19 +1,18 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE DataKinds             #-}+{-# LANGUAGE DefaultSignatures     #-}+{-# LANGUAGE FlexibleContexts      #-}+{-# LANGUAGE FlexibleInstances     #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}--#include "overlapping-compat.h"+{-# LANGUAGE TypeFamilies          #-}+{-# LANGUAGE TypeOperators         #-}+{-# LANGUAGE UndecidableInstances  #-}  module Servant.Client.Core.Internal.Generic where -import Generics.SOP   (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)-import Servant.API    ((:<|>)(..))+import           Generics.SOP+                 (Code, Generic, I (..), NP (..), NS (Z), SOP (..), to)+import           Servant.API+                 ((:<|>) (..))  -- | This class allows us to match client structure with client functions -- produced with 'client' without explicit pattern-matching.@@ -140,7 +139,7 @@   => GClientList (a :<|> b) acc where   gClientList (a :<|> b) acc = gClientList a (gClientList b acc) -instance OVERLAPPABLE_ (ClientList client acc ~ (client ': acc))+instance {-# OVERLAPPABLE #-} (ClientList client acc ~ (client ': acc))   => GClientList client acc where   gClientList c acc = I c :* acc 

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP                   #-} {-# LANGUAGE DataKinds             #-} {-# LANGUAGE FlexibleContexts      #-} {-# LANGUAGE FlexibleInstances     #-}@@ -12,56 +11,43 @@ {-# LANGUAGE TypeOperators         #-} {-# LANGUAGE UndecidableInstances  #-} -#include "overlapping-compat.h" module Servant.Client.Core.Internal.HasClient where -import           Prelude                                ()+import           Prelude () import           Prelude.Compat -import           Control.Concurrent                     (newMVar, modifyMVar)-import           Data.Foldable                          (toList)+import qualified Data.ByteString                        as BS import qualified Data.ByteString.Lazy                   as BL-import           Data.List                              (foldl')-import           Data.Proxy                             (Proxy (Proxy))-import           Data.Semigroup                         ((<>))-import           Data.Sequence                          (fromList)-import           Data.String                            (fromString)-import           Data.Text                              (Text, pack)-import           GHC.TypeLits                           (KnownSymbol, symbolVal)+import           Data.Foldable+                 (toList)+import           Data.List+                 (foldl')+import           Data.Proxy+                 (Proxy (Proxy))+import           Data.Sequence+                 (fromList)+import           Data.String+                 (fromString)+import           Data.Text+                 (Text, pack)+import           GHC.TypeLits+                 (KnownSymbol, symbolVal) import qualified Network.HTTP.Types                     as H-import           Servant.API                            ((:<|>) ((:<|>)), (:>),-                                                         AuthProtect, BasicAuth,-                                                         BasicAuthData,-                                                         BuildHeadersTo (..),-                                                         BuildFromStream (..),-                                                         ByteStringParser (..),-                                                         Capture', CaptureAll,-                                                         Description, EmptyAPI,-                                                         FramingUnrender (..),-                                                         Header', Headers (..),-                                                         HttpVersion, IsSecure,-                                                         MimeRender (mimeRender),-                                                         MimeUnrender (mimeUnrender),-                                                         NoContent (NoContent),-                                                         QueryFlag, QueryParam',-                                                         QueryParams, Raw,-                                                         ReflectMethod (..),-                                                         RemoteHost, ReqBody',-                                                         ResultStream(..),-                                                         SBoolI,-                                                         Stream,-                                                         Summary, ToHttpApiData,-                                                         Vault, Verb,-                                                         WithNamedContext,-                                                         contentType,-                                                         getHeadersHList,-                                                         getResponse,-                                                         toQueryParam,-                                                         toUrlPiece)-import           Servant.API.ContentTypes               (contentTypes)-import           Servant.API.Modifiers                  (FoldRequired,-                                                         RequiredArgument,-                                                         foldRequiredArgument)+import           Servant.API+                 ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData,+                 BuildHeadersTo (..), Capture', CaptureAll, Description,+                 EmptyAPI, FramingUnrender (..), FromSourceIO (..), Header',+                 Headers (..), HttpVersion, IsSecure, MimeRender (mimeRender),+                 MimeUnrender (mimeUnrender), NoContent (NoContent), QueryFlag,+                 QueryParam', QueryParams, Raw, ReflectMethod (..), RemoteHost,+                 ReqBody', SBoolI, Stream, StreamBody', Summary, ToHttpApiData,+                 Vault, Verb, WithNamedContext, contentType, getHeadersHList,+                 getResponse, toQueryParam, toUrlPiece)+import           Servant.API.ContentTypes+                 (contentTypes)+import           Servant.API.Modifiers+                 (FoldRequired, RequiredArgument, foldRequiredArgument)+import qualified Servant.Types.SourceT                  as S  import           Servant.Client.Core.Internal.Auth import           Servant.Client.Core.Internal.BasicAuth@@ -216,7 +202,7 @@   hoistClientMonad pm _ f cl = \as ->     hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as) -instance OVERLAPPABLE_+instance {-# OVERLAPPABLE #-}   -- Note [Non-Empty Content Types]   ( RunClient m, MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)   ) => HasClient m (Verb method status cts' a) where@@ -233,7 +219,7 @@    hoistClientMonad _ _ f ma = f ma -instance OVERLAPPING_+instance {-# OVERLAPPING #-}   ( RunClient m, ReflectMethod method   ) => HasClient m (Verb method status cts NoContent) where   type Client m (Verb method status cts NoContent)@@ -245,7 +231,7 @@    hoistClientMonad _ _ f ma = f ma -instance OVERLAPPING_+instance {-# OVERLAPPING #-}   -- Note [Non-Empty Content Types]   ( RunClient m, MimeUnrender ct a, BuildHeadersTo ls   , ReflectMethod method, cts' ~ (ct ': cts)@@ -268,7 +254,7 @@    hoistClientMonad _ _ f ma = f ma -instance OVERLAPPING_+instance {-# OVERLAPPING #-}   ( RunClient m, BuildHeadersTo ls, ReflectMethod method   ) => HasClient m (Verb method status cts (Headers ls NoContent)) where   type Client m (Verb method status cts (Headers ls NoContent))@@ -282,56 +268,25 @@    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 status framing ct (f a)) where--  type Client m (Stream method status 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+instance {-# OVERLAPPABLE #-}+  ( RunStreamingClient m, MimeUnrender ct chunk, ReflectMethod method,+    FramingUnrender framing, FromSourceIO chunk a+  ) => HasClient m (Stream method status framing ct a) where -          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+  type Client m (Stream method status framing ct a) = m a    hoistClientMonad _ _ f ma = f ma +  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' $ S.fromAction BS.null (responseBody gres)+    where+      req' = req+          { requestAccept = fromList [contentType (Proxy :: Proxy ct)]+          , requestMethod = reflectMethod (Proxy :: Proxy method)+          }+ -- | 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',@@ -581,6 +536,18 @@    hoistClientMonad pm _ f cl = \a ->     hoistClientMonad pm (Proxy :: Proxy api) f (cl a)++instance+    ( HasClient m api+    ) => HasClient m (StreamBody' mods framing ctype a :> api)+  where++    type Client m (StreamBody' mods framing ctype a :> api) = a -> Client m api++    hoistClientMonad pm _ f cl = \a ->+      hoistClientMonad pm (Proxy :: Proxy api) f (cl a)++    clientWithRoute _pm Proxy _req _body = error "HasClient @StreamBody"  -- | Make the querying function append @path@ to the request path. instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where

@@ -12,26 +12,36 @@  module Servant.Client.Core.Internal.Request where -import           Prelude                 ()+import           Prelude () import           Prelude.Compat -import           Control.Monad.Catch     (Exception)+import           Control.DeepSeq+                 (NFData (..))+import           Control.Monad.Catch+                 (Exception) 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           Data.Int+                 (Int64)+import           Data.Semigroup+                 ((<>)) import qualified Data.Sequence           as Seq-import           Data.Text               (Text)-import           Data.Text.Encoding      (encodeUtf8)-import           Data.Typeable           (Typeable)-import           GHC.Generics            (Generic)-import           Network.HTTP.Media      (MediaType)-import           Network.HTTP.Types      (Header, HeaderName, HttpVersion,-                                          Method, QueryItem, Status, http11,-                                          methodGet)-import           Web.HttpApiData         (ToHttpApiData, toEncodedUrlPiece,-                                          toHeader)+import           Data.Text+                 (Text)+import           Data.Text.Encoding+                 (encodeUtf8)+import           Data.Typeable+                 (Typeable)+import           GHC.Generics+                 (Generic)+import           Network.HTTP.Media+                 (MediaType, mainType, parameters, subType)+import           Network.HTTP.Types+                 (Header, HeaderName, HttpVersion (..), Method, QueryItem,+                 Status (..), http11, methodGet)+import           Servant.API+                 (ToHttpApiData, toEncodedUrlPiece, toHeader)  -- | A type representing possible errors in a request --@@ -51,6 +61,20 @@  instance Exception ServantError +instance NFData ServantError where+    rnf (FailureResponse res)            = rnf res+    rnf (DecodeFailure err res)          = rnf err `seq` rnf res+    rnf (UnsupportedContentType mt' res) =+        mediaTypeRnf mt' `seq`+        rnf res+      where+        mediaTypeRnf mt =+            rnf (mainType mt) `seq`+            rnf (subType mt) `seq`+            rnf (parameters mt)+    rnf (InvalidContentTypeHeader res)   = rnf res+    rnf (ConnectionError err)            = rnf err+ data RequestF a = Request   { requestPath        :: a   , requestQueryString :: Seq.Seq QueryItem@@ -80,8 +104,18 @@   , responseBody        :: a   } deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable) +instance NFData a => NFData (GenResponse a) where+    rnf (Response sc hs hv body) =+        rnfStatus sc `seq`+        rnf hs `seq`+        rnfHttpVersion hv `seq`+        rnf body+      where+        rnfStatus (Status code msg) = rnf code `seq` rnf msg+        rnfHttpVersion (HttpVersion _ _) = () -- HttpVersion fields are strict+ type Response = GenResponse LBS.ByteString-newtype StreamingResponse = StreamingResponse { runStreamingResponse :: forall a. (GenResponse (IO BS.ByteString) -> IO a) -> IO a }+type StreamingResponse = GenResponse (IO BS.ByteString)  -- A GET request to the top-level path defaultRequest :: Request

@@ -6,31 +6,36 @@ -- | Types for possible backends to run client-side `Request` queries module Servant.Client.Core.Internal.RunClient where -import           Prelude                              ()+import           Prelude () import           Prelude.Compat -import           Control.Monad                        (unless)-import           Control.Monad.Free                   (Free (..), liftF)-import           Data.Foldable                        (toList)-import           Data.Proxy                           (Proxy)+import           Control.Monad+                 (unless)+import           Control.Monad.Free+                 (Free (..), liftF)+import           Data.Foldable+                 (toList)+import           Data.Proxy+                 (Proxy) import qualified Data.Text                            as T-import           Network.HTTP.Media                   (MediaType, matches,-                                                       parseAccept, (//))-import           Servant.API                          (MimeUnrender,-                                                       contentTypes,-                                                       mimeUnrender)+import           Network.HTTP.Media+                 (MediaType, matches, parseAccept, (//))+import           Servant.API+                 (MimeUnrender, contentTypes, mimeUnrender) -import           Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..),-                                                       StreamingResponse (..),-                                                       ServantError (..)) import           Servant.Client.Core.Internal.ClientF+import           Servant.Client.Core.Internal.Request+                 (GenResponse (..), Request, Response, ServantError (..),+                 StreamingResponse)  class Monad m => RunClient m where   -- | How to make a request.   runRequest :: Request -> m Response-  streamingRequest :: Request -> m StreamingResponse   throwServantError :: ServantError -> m a +class RunClient m =>  RunStreamingClient m where+    withStreamingRequest :: Request -> (StreamingResponse -> IO a) ->  m a+ checkContentTypeHeader :: RunClient m => Response -> m MediaType checkContentTypeHeader response =   case lookup "Content-Type" $ toList $ responseHeaders response of@@ -53,5 +58,10 @@  instance ClientF ~ f => RunClient (Free f) where     runRequest req  = liftF (RunRequest req id)-    streamingRequest req = liftF (StreamingRequest req id)     throwServantError = liftF . Throw++{-+Free and streaming?+instance ClientF ~ f => RunStreamingClient (Free f) where+    streamingRequest req = liftF (StreamingRequest req id)+-}

@@ -28,6 +28,6 @@   import           Servant.Client.Core.Internal.BaseUrl-import           Servant.Client.Core.Internal.HasClient import           Servant.Client.Core.Internal.Generic+import           Servant.Client.Core.Internal.HasClient import           Servant.Client.Core.Internal.Request

@@ -1,15 +1,18 @@-{-# LANGUAGE ScopedTypeVariables, FlexibleContexts, GADTs #-}+{-# LANGUAGE FlexibleContexts    #-}+{-# LANGUAGE GADTs               #-}+{-# LANGUAGE ScopedTypeVariables #-} 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+import           Control.Monad.Free+import           Data.Proxy+                 (Proxy (..))+import           Servant.Client.Core+import           Servant.Client.Core.Internal.ClientF+import           Servant.Client.Core.Reexport  client :: HasClient (Free ClientF) api => Proxy api -> Client (Free ClientF) api client api = api `clientIn` (Proxy :: Proxy (Free ClientF))