Refactor servant-client-core Response+StreamingResponse
This commit is contained in:
parent
ff268941a1
commit
f4fc2b321f
9 changed files with 27 additions and 18 deletions
|
@ -40,7 +40,8 @@ module Servant.Client.Core
|
||||||
|
|
||||||
|
|
||||||
-- * Response
|
-- * Response
|
||||||
, Response(..)
|
, Response
|
||||||
|
, GenResponse (..)
|
||||||
, RunClient(..)
|
, RunClient(..)
|
||||||
, module Servant.Client.Core.Internal.BaseUrl
|
, module Servant.Client.Core.Internal.BaseUrl
|
||||||
, StreamingResponse(..)
|
, StreamingResponse(..)
|
||||||
|
|
|
@ -269,7 +269,8 @@ instance OVERLAPPABLE_
|
||||||
, requestMethod = reflectMethod (Proxy :: Proxy method)
|
, requestMethod = reflectMethod (Proxy :: Proxy method)
|
||||||
}
|
}
|
||||||
return . buildFromStream $ ResultStream $ \k ->
|
return . buildFromStream $ ResultStream $ \k ->
|
||||||
runStreamingResponse sresp $ \(_status,_headers,_httpversion,reader) -> do
|
runStreamingResponse sresp $ \gres -> do
|
||||||
|
let reader = responseBody gres
|
||||||
let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
|
let unrender = unrenderFrames (Proxy :: Proxy framing) (Proxy :: Proxy a)
|
||||||
loop bs = do
|
loop bs = do
|
||||||
res <- BL.fromStrict <$> reader
|
res <- BL.fromStrict <$> reader
|
||||||
|
|
|
@ -1,8 +1,9 @@
|
||||||
{-# LANGUAGE CPP #-}
|
{-# LANGUAGE CPP #-}
|
||||||
{-# LANGUAGE DeriveDataTypeable #-}
|
{-# LANGUAGE DeriveDataTypeable #-}
|
||||||
{-# LANGUAGE DeriveFunctor #-}
|
{-# LANGUAGE DeriveFunctor #-}
|
||||||
|
{-# LANGUAGE DeriveFoldable #-}
|
||||||
|
{-# LANGUAGE DeriveTraversable #-}
|
||||||
{-# LANGUAGE DeriveGeneric #-}
|
{-# LANGUAGE DeriveGeneric #-}
|
||||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
|
||||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
@ -65,14 +66,15 @@ type Request = RequestF Builder.Builder
|
||||||
newtype RequestBody = RequestBodyLBS LBS.ByteString
|
newtype RequestBody = RequestBodyLBS LBS.ByteString
|
||||||
deriving (Eq, Ord, Read, Show, Typeable)
|
deriving (Eq, Ord, Read, Show, Typeable)
|
||||||
|
|
||||||
data Response = Response
|
data GenResponse a = Response
|
||||||
{ responseStatusCode :: Status
|
{ responseStatusCode :: Status
|
||||||
, responseBody :: LBS.ByteString
|
|
||||||
, responseHeaders :: Seq.Seq Header
|
, responseHeaders :: Seq.Seq Header
|
||||||
, responseHttpVersion :: HttpVersion
|
, responseHttpVersion :: HttpVersion
|
||||||
} deriving (Eq, Show, Generic, Typeable)
|
, responseBody :: a
|
||||||
|
} deriving (Eq, Show, Generic, Typeable, Functor, Foldable, Traversable)
|
||||||
|
|
||||||
data StreamingResponse = StreamingResponse { runStreamingResponse :: forall a. ((Status, Seq.Seq Header, HttpVersion, IO BS.ByteString) -> IO a) -> IO a }
|
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
|
-- A GET request to the top-level path
|
||||||
defaultRequest :: Request
|
defaultRequest :: Request
|
||||||
|
|
|
@ -18,7 +18,7 @@ import Network.HTTP.Media (MediaType, matches,
|
||||||
import Servant.API (MimeUnrender,
|
import Servant.API (MimeUnrender,
|
||||||
contentTypes,
|
contentTypes,
|
||||||
mimeUnrender)
|
mimeUnrender)
|
||||||
import Servant.Client.Core.Internal.Request (Request, Response (..),
|
import Servant.Client.Core.Internal.Request (Request, Response, GenResponse (..),
|
||||||
StreamingResponse (..),
|
StreamingResponse (..),
|
||||||
ServantError (..))
|
ServantError (..))
|
||||||
|
|
||||||
|
|
|
@ -5,8 +5,11 @@ module Servant.Client.Core.Reexport
|
||||||
(
|
(
|
||||||
-- * HasClient
|
-- * HasClient
|
||||||
HasClient(..)
|
HasClient(..)
|
||||||
|
|
||||||
-- * Response (for @Raw@)
|
-- * Response (for @Raw@)
|
||||||
, Response(..)
|
, Response
|
||||||
|
, StreamingResponse
|
||||||
|
, GenResponse(..)
|
||||||
|
|
||||||
-- * Generic Client
|
-- * Generic Client
|
||||||
, ClientLike(..)
|
, ClientLike(..)
|
||||||
|
|
|
@ -49,6 +49,9 @@ library
|
||||||
, time >= 1.4.2 && < 1.9
|
, time >= 1.4.2 && < 1.9
|
||||||
, transformers >= 0.3.0.0 && < 0.6
|
, transformers >= 0.3.0.0 && < 0.6
|
||||||
|
|
||||||
|
if !impl(ghc >= 8.0)
|
||||||
|
build-depends: semigroups >=0.18.3 && <0.19
|
||||||
|
|
||||||
-- Servant dependencies
|
-- Servant dependencies
|
||||||
build-depends:
|
build-depends:
|
||||||
servant-client-core == 0.12.*
|
servant-client-core == 0.12.*
|
||||||
|
|
|
@ -1,3 +1,5 @@
|
||||||
|
|
||||||
|
|
||||||
-- | This module provides 'client' which can automatically generate
|
-- | This module provides 'client' which can automatically generate
|
||||||
-- querying functions for each endpoint just from the type representing your
|
-- querying functions for each endpoint just from the type representing your
|
||||||
-- API.
|
-- API.
|
||||||
|
@ -10,5 +12,5 @@ module Servant.Client
|
||||||
, module Servant.Client.Core.Reexport
|
, module Servant.Client.Core.Reexport
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Servant.Client.Internal.HttpClient
|
|
||||||
import Servant.Client.Core.Reexport
|
import Servant.Client.Core.Reexport
|
||||||
|
import Servant.Client.Internal.HttpClient
|
||||||
|
|
|
@ -8,11 +8,8 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
{-# LANGUAGE TypeFamilies #-}
|
{-# LANGUAGE TypeFamilies #-}
|
||||||
|
|
||||||
-- | @http-client@-based client requests executor
|
|
||||||
module Servant.Client.Internal.HttpClient where
|
module Servant.Client.Internal.HttpClient where
|
||||||
|
|
||||||
|
|
||||||
import Prelude ()
|
import Prelude ()
|
||||||
import Prelude.Compat
|
import Prelude.Compat
|
||||||
|
|
||||||
|
@ -31,7 +28,7 @@ import qualified Data.ByteString.Lazy as BSL
|
||||||
import Data.Foldable (toList, for_)
|
import Data.Foldable (toList, for_)
|
||||||
import Data.Functor.Alt (Alt (..))
|
import Data.Functor.Alt (Alt (..))
|
||||||
import Data.Maybe (maybeToList)
|
import Data.Maybe (maybeToList)
|
||||||
import Data.Monoid ((<>))
|
import Data.Semigroup ((<>))
|
||||||
import Data.Proxy (Proxy (..))
|
import Data.Proxy (Proxy (..))
|
||||||
import Data.Sequence (fromList)
|
import Data.Sequence (fromList)
|
||||||
import Data.String (fromString)
|
import Data.String (fromString)
|
||||||
|
@ -151,10 +148,10 @@ performStreamingRequest req = do
|
||||||
status_code = statusCode status
|
status_code = statusCode status
|
||||||
unless (status_code >= 200 && status_code < 300) $ do
|
unless (status_code >= 200 && status_code < 300) $ do
|
||||||
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)
|
b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody r)
|
||||||
throw $ FailureResponse $ Response status b (fromList $ Client.responseHeaders r) (Client.responseVersion r)
|
throw $ FailureResponse $ clientResponseToResponse r { Client.responseBody = b }
|
||||||
k (status, fromList $ Client.responseHeaders r, Client.responseVersion r, Client.responseBody r)
|
k (clientResponseToResponse r)
|
||||||
|
|
||||||
clientResponseToResponse :: Client.Response BSL.ByteString -> Response
|
clientResponseToResponse :: Client.Response a -> GenResponse a
|
||||||
clientResponseToResponse r = Response
|
clientResponseToResponse r = Response
|
||||||
{ responseStatusCode = Client.responseStatus r
|
{ responseStatusCode = Client.responseStatus r
|
||||||
, responseBody = Client.responseBody r
|
, responseBody = Client.responseBody r
|
||||||
|
|
|
@ -71,7 +71,7 @@ library
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 4.11
|
base >= 4.7 && < 4.11
|
||||||
, bytestring >= 0.10.4.0 && < 0.11
|
, bytestring >= 0.10.4.0 && < 0.11
|
||||||
, mtl >= 2.0.1 && < 2.3
|
, mtl >= 2.1 && < 2.3
|
||||||
, text >= 1.2.3.0 && < 1.3
|
, text >= 1.2.3.0 && < 1.3
|
||||||
|
|
||||||
if !impl(ghc >= 8.0)
|
if !impl(ghc >= 8.0)
|
||||||
|
|
Loading…
Reference in a new issue