{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
module Servant.Client.Internal.HttpClient.Streaming (
    module Servant.Client.Internal.HttpClient.Streaming,
    ClientEnv (..),
    mkClientEnv,
    clientResponseToResponse,
    defaultMakeClientRequest,
    catchConnectionError,
    ) where

import           Prelude ()
import           Prelude.Compat

import           Control.Concurrent.STM.TVar
import           Control.DeepSeq
                 (NFData, force)
import           Control.Exception
                 (evaluate, throwIO)
import           Control.Monad ()
import           Control.Monad.Base
                 (MonadBase (..))
import           Control.Monad.Codensity
                 (Codensity (..))
import           Control.Monad.Error.Class
                 (MonadError (..))
import           Control.Monad.Reader
import           Control.Monad.STM
                 (atomically)
import           Control.Monad.Trans.Except
import qualified Data.ByteString                    as BS
import qualified Data.ByteString.Lazy               as BSL
import           Data.Foldable
                 (for_)
import           Data.Functor.Alt
                 (Alt (..))
import           Data.Proxy
                 (Proxy (..))
import           Data.Time.Clock
                 (getCurrentTime)
import           GHC.Generics
import           Network.HTTP.Types
                 (Status, statusIsSuccessful)

import qualified Network.HTTP.Client                as Client

import           Servant.Client.Core
import           Servant.Client.Internal.HttpClient
                 (ClientEnv (..), catchConnectionError,
                 clientResponseToResponse, mkClientEnv, mkFailureResponse,
                 defaultMakeClientRequest)
import qualified Servant.Types.SourceT              as S


-- | Generates a set of client functions for an API.
--
-- Example:
--
-- > type API = Capture "no" Int :> Get '[JSON] Int
-- >        :<|> Get '[JSON] [Bool]
-- >
-- > api :: Proxy API
-- > api = Proxy
-- >
-- > getInt :: Int -> ClientM Int
-- > getBools :: ClientM [Bool]
-- > getInt :<|> getBools = client api
client :: HasClient ClientM api => Proxy api -> Client ClientM api
client :: Proxy api -> Client ClientM api
client Proxy api
api = Proxy api
api Proxy api -> Proxy ClientM -> Client ClientM api
forall (m :: * -> *) api.
HasClient m api =>
Proxy api -> Proxy m -> Client m api
`clientIn` (Proxy ClientM
forall k (t :: k). Proxy t
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 :: Proxy api -> (forall a. m a -> n a) -> Client m api -> Client n api
hoistClient = Proxy ClientM
-> Proxy api
-> (forall a. m a -> n a)
-> Client m api
-> Client n api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad (Proxy ClientM
forall k (t :: k). Proxy t
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
  { ClientM a
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
unClientM :: ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a }
  deriving ( a -> ClientM b -> ClientM a
(a -> b) -> ClientM a -> ClientM b
(forall a b. (a -> b) -> ClientM a -> ClientM b)
-> (forall a b. a -> ClientM b -> ClientM a) -> Functor ClientM
forall a b. a -> ClientM b -> ClientM a
forall a b. (a -> b) -> ClientM a -> ClientM b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> ClientM b -> ClientM a
$c<$ :: forall a b. a -> ClientM b -> ClientM a
fmap :: (a -> b) -> ClientM a -> ClientM b
$cfmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
Functor, Functor ClientM
a -> ClientM a
Functor ClientM
-> (forall a. a -> ClientM a)
-> (forall a b. ClientM (a -> b) -> ClientM a -> ClientM b)
-> (forall a b c.
    (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c)
-> (forall a b. ClientM a -> ClientM b -> ClientM b)
-> (forall a b. ClientM a -> ClientM b -> ClientM a)
-> Applicative ClientM
ClientM a -> ClientM b -> ClientM b
ClientM a -> ClientM b -> ClientM a
ClientM (a -> b) -> ClientM a -> ClientM b
(a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
forall a. a -> ClientM a
forall a b. ClientM a -> ClientM b -> ClientM a
forall a b. ClientM a -> ClientM b -> ClientM b
forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: ClientM a -> ClientM b -> ClientM a
$c<* :: forall a b. ClientM a -> ClientM b -> ClientM a
*> :: ClientM a -> ClientM b -> ClientM b
$c*> :: forall a b. ClientM a -> ClientM b -> ClientM b
liftA2 :: (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
$cliftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
<*> :: ClientM (a -> b) -> ClientM a -> ClientM b
$c<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
pure :: a -> ClientM a
$cpure :: forall a. a -> ClientM a
$cp1Applicative :: Functor ClientM
Applicative, Applicative ClientM
a -> ClientM a
Applicative ClientM
-> (forall a b. ClientM a -> (a -> ClientM b) -> ClientM b)
-> (forall a b. ClientM a -> ClientM b -> ClientM b)
-> (forall a. a -> ClientM a)
-> Monad ClientM
ClientM a -> (a -> ClientM b) -> ClientM b
ClientM a -> ClientM b -> ClientM b
forall a. a -> ClientM a
forall a b. ClientM a -> ClientM b -> ClientM b
forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> ClientM a
$creturn :: forall a. a -> ClientM a
>> :: ClientM a -> ClientM b -> ClientM b
$c>> :: forall a b. ClientM a -> ClientM b -> ClientM b
>>= :: ClientM a -> (a -> ClientM b) -> ClientM b
$c>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
$cp1Monad :: Applicative ClientM
Monad, Monad ClientM
Monad ClientM -> (forall a. IO a -> ClientM a) -> MonadIO ClientM
IO a -> ClientM a
forall a. IO a -> ClientM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: IO a -> ClientM a
$cliftIO :: forall a. IO a -> ClientM a
$cp1MonadIO :: Monad ClientM
MonadIO, (forall x. ClientM a -> Rep (ClientM a) x)
-> (forall x. Rep (ClientM a) x -> ClientM a)
-> Generic (ClientM a)
forall x. Rep (ClientM a) x -> ClientM a
forall x. ClientM a -> Rep (ClientM a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ClientM a) x -> ClientM a
forall a x. ClientM a -> Rep (ClientM a) x
$cto :: forall a x. Rep (ClientM a) x -> ClientM a
$cfrom :: forall a x. ClientM a -> Rep (ClientM a) x
Generic
           , MonadReader ClientEnv, MonadError ClientError)

instance MonadBase IO ClientM where
  liftBase :: IO α -> ClientM α
liftBase = ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α
-> ClientM α
forall a.
ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
ClientM (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α
 -> ClientM α)
-> (IO α
    -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α)
-> IO α
-> ClientM α
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO α -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) α
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | Try clients in order, last error is preserved.
instance Alt ClientM where
  ClientM a
a <!> :: ClientM a -> ClientM a -> ClientM a
<!> ClientM a
b = ClientM a
a ClientM a -> (ClientError -> ClientM a) -> ClientM a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ClientError
_ -> ClientM a
b

instance RunClient ClientM where
  runRequestAcceptStatus :: Maybe [Status] -> Request -> ClientM Response
runRequestAcceptStatus = Maybe [Status] -> Request -> ClientM Response
performRequest
  throwClientError :: ClientError -> ClientM a
throwClientError = ClientError -> ClientM a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

instance RunStreamingClient ClientM where
  withStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
withStreamingRequest = Request -> (StreamingResponse -> IO a) -> ClientM a
forall a. Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest

withClientM :: ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
withClientM :: ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
withClientM ClientM a
cm ClientEnv
env Either ClientError a -> IO b
k =
    let Codensity forall b. (Either ClientError a -> IO b) -> IO b
f = ExceptT ClientError (Codensity IO) a
-> Codensity IO (Either ClientError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT ClientError (Codensity IO) a
 -> Codensity IO (Either ClientError a))
-> ExceptT ClientError (Codensity IO) a
-> Codensity IO (Either ClientError a)
forall a b. (a -> b) -> a -> b
$ (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
 -> ClientEnv -> ExceptT ClientError (Codensity IO) a)
-> ClientEnv
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ExceptT ClientError (Codensity IO) a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientEnv -> ExceptT ClientError (Codensity IO) a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ClientEnv
env (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
 -> ExceptT ClientError (Codensity IO) a)
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ExceptT ClientError (Codensity IO) a
forall a b. (a -> b) -> a -> b
$ ClientM a
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
forall a.
ClientM a
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
unClientM ClientM a
cm
    in (Either ClientError a -> IO b) -> IO b
forall b. (Either ClientError a -> IO b) -> IO b
f Either ClientError a -> IO b
k

-- | A 'runClientM' variant for streaming client.
--
-- It allows using this module's 'ClientM' in a direct style.
-- The 'NFData' constraint however prevents using this function with genuine
-- streaming response types ('SourceT', 'Conduit', pipes 'Proxy' or 'Machine').
-- For those you have to use 'withClientM'.
--
-- /Note:/ we 'force' the result, so the likelihood of accidentally leaking a
-- connection is smaller. Use with care.
--
runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM :: ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
cm ClientEnv
env = ClientM a
-> ClientEnv
-> (Either ClientError a -> IO (Either ClientError a))
-> IO (Either ClientError a)
forall a b.
ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
withClientM ClientM a
cm ClientEnv
env (Either ClientError a -> IO (Either ClientError a)
forall a. a -> IO a
evaluate (Either ClientError a -> IO (Either ClientError a))
-> (Either ClientError a -> Either ClientError a)
-> Either ClientError a
-> IO (Either ClientError a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either ClientError a -> Either ClientError a
forall a. NFData a => a -> a
force)

performRequest :: Maybe [Status] -> Request -> ClientM Response
performRequest :: Maybe [Status] -> Request -> ClientM Response
performRequest Maybe [Status]
acceptStatus Request
req = do
    -- TODO: should use Client.withResponse here too
  ClientEnv Manager
m BaseUrl
burl Maybe (TVar CookieJar)
cookieJar' BaseUrl -> Request -> Request
createClientRequest <- ClientM ClientEnv
forall r (m :: * -> *). MonadReader r m => m r
ask
  let clientRequest :: Request
clientRequest = BaseUrl -> Request -> Request
createClientRequest BaseUrl
burl Request
req
  Request
request <- case Maybe (TVar CookieJar)
cookieJar' of
    Maybe (TVar CookieJar)
Nothing -> Request -> ClientM Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
clientRequest
    Just TVar CookieJar
cj -> IO Request -> ClientM Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> ClientM Request) -> IO Request -> ClientM Request
forall a b. (a -> b) -> a -> b
$ do
      UTCTime
now <- IO UTCTime
getCurrentTime
      STM Request -> IO Request
forall a. STM a -> IO a
atomically (STM Request -> IO Request) -> STM Request -> IO Request
forall a b. (a -> b) -> a -> b
$ do
        CookieJar
oldCookieJar <- TVar CookieJar -> STM CookieJar
forall a. TVar a -> STM a
readTVar TVar CookieJar
cj
        let (Request
newRequest, CookieJar
newCookieJar) =
              Request -> CookieJar -> UTCTime -> (Request, CookieJar)
Client.insertCookiesIntoRequest
                Request
clientRequest
                CookieJar
oldCookieJar
                UTCTime
now
        TVar CookieJar -> CookieJar -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar CookieJar
cj CookieJar
newCookieJar
        Request -> STM Request
forall (f :: * -> *) a. Applicative f => a -> f a
pure Request
newRequest

  Either ClientError (Response ByteString)
eResponse <- IO (Either ClientError (Response ByteString))
-> ClientM (Either ClientError (Response ByteString))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either ClientError (Response ByteString))
 -> ClientM (Either ClientError (Response ByteString)))
-> IO (Either ClientError (Response ByteString))
-> ClientM (Either ClientError (Response ByteString))
forall a b. (a -> b) -> a -> b
$ IO (Response ByteString)
-> IO (Either ClientError (Response ByteString))
forall a. IO a -> IO (Either ClientError a)
catchConnectionError (IO (Response ByteString)
 -> IO (Either ClientError (Response ByteString)))
-> IO (Response ByteString)
-> IO (Either ClientError (Response ByteString))
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
request Manager
m
  case Either ClientError (Response ByteString)
eResponse of
    Left ClientError
err -> ClientError -> ClientM Response
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ClientError
err
    Right Response ByteString
response -> do
      Maybe (TVar CookieJar)
-> (TVar CookieJar -> ClientM ()) -> ClientM ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe (TVar CookieJar)
cookieJar' ((TVar CookieJar -> ClientM ()) -> ClientM ())
-> (TVar CookieJar -> ClientM ()) -> ClientM ()
forall a b. (a -> b) -> a -> b
$ \TVar CookieJar
cj -> IO () -> ClientM ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ClientM ()) -> IO () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ do
        UTCTime
now' <- IO UTCTime
getCurrentTime
        STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CookieJar -> (CookieJar -> CookieJar) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CookieJar
cj ((CookieJar, Response ByteString) -> CookieJar
forall a b. (a, b) -> a
fst ((CookieJar, Response ByteString) -> CookieJar)
-> (CookieJar -> (CookieJar, Response ByteString))
-> CookieJar
-> CookieJar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response ByteString
-> Request
-> UTCTime
-> CookieJar
-> (CookieJar, Response ByteString)
forall a.
Response a
-> Request -> UTCTime -> CookieJar -> (CookieJar, Response a)
Client.updateCookieJar Response ByteString
response Request
request UTCTime
now')
      let status :: Status
status = Response ByteString -> Status
forall body. Response body -> Status
Client.responseStatus Response ByteString
response
          ourResponse :: Response
ourResponse = (ByteString -> ByteString) -> Response ByteString -> Response
forall a b. (a -> b) -> Response a -> ResponseF b
clientResponseToResponse ByteString -> ByteString
forall a. a -> a
id Response ByteString
response
          goodStatus :: Bool
goodStatus = case Maybe [Status]
acceptStatus of
            Maybe [Status]
Nothing -> Status -> Bool
statusIsSuccessful Status
status
            Just [Status]
good -> Status
status Status -> [Status] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
good
      Bool -> ClientM () -> ClientM ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
goodStatus (ClientM () -> ClientM ()) -> ClientM () -> ClientM ()
forall a b. (a -> b) -> a -> b
$ do
        ClientError -> ClientM ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ClientError -> ClientM ()) -> ClientError -> ClientM ()
forall a b. (a -> b) -> a -> b
$ BaseUrl -> Request -> Response -> ClientError
mkFailureResponse BaseUrl
burl Request
req Response
ourResponse
      Response -> ClientM Response
forall (m :: * -> *) a. Monad m => a -> m a
return Response
ourResponse

-- | TODO: support UVerb ('acceptStatus' argument, like in 'performRequest' above).
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest Request
req StreamingResponse -> IO a
k = do
  Manager
m <- (ClientEnv -> Manager) -> ClientM Manager
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ClientEnv -> Manager
manager
  BaseUrl
burl <- (ClientEnv -> BaseUrl) -> ClientM BaseUrl
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ClientEnv -> BaseUrl
baseUrl
  BaseUrl -> Request -> Request
createClientRequest <- (ClientEnv -> BaseUrl -> Request -> Request)
-> ClientM (BaseUrl -> Request -> Request)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks ClientEnv -> BaseUrl -> Request -> Request
makeClientRequest
  let request :: Request
request = BaseUrl -> Request -> Request
createClientRequest BaseUrl
burl Request
req
  ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
forall a.
ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
ClientM (ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
 -> ClientM a)
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
forall a b. (a -> b) -> a -> b
$ ExceptT ClientError (Codensity IO) a
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (ExceptT ClientError (Codensity IO) a
 -> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a)
-> ExceptT ClientError (Codensity IO) a
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
forall a b. (a -> b) -> a -> b
$ Codensity IO a -> ExceptT ClientError (Codensity IO) a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Codensity IO a -> ExceptT ClientError (Codensity IO) a)
-> Codensity IO a -> ExceptT ClientError (Codensity IO) a
forall a b. (a -> b) -> a -> b
$ (forall b. (a -> IO b) -> IO b) -> Codensity IO a
forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity ((forall b. (a -> IO b) -> IO b) -> Codensity IO a)
-> (forall b. (a -> IO b) -> IO b) -> Codensity IO a
forall a b. (a -> b) -> a -> b
$ \a -> IO b
k1 ->
      Request -> Manager -> (Response BodyReader -> IO b) -> IO b
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
Client.withResponse Request
request Manager
m ((Response BodyReader -> IO b) -> IO b)
-> (Response BodyReader -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \Response BodyReader
res -> do
          let status :: Status
status = Response BodyReader -> Status
forall body. Response body -> Status
Client.responseStatus Response BodyReader
res

          -- we throw FailureResponse in IO :(
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
statusIsSuccessful Status
status) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              ByteString
b <- [ByteString] -> ByteString
BSL.fromChunks ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BodyReader -> IO [ByteString]
Client.brConsume (Response BodyReader -> BodyReader
forall body. Response body -> body
Client.responseBody Response BodyReader
res)
              ClientError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ClientError -> IO ()) -> ClientError -> IO ()
forall a b. (a -> b) -> a -> b
$ BaseUrl -> Request -> Response -> ClientError
mkFailureResponse BaseUrl
burl Request
req ((BodyReader -> ByteString) -> Response BodyReader -> Response
forall a b. (a -> b) -> Response a -> ResponseF b
clientResponseToResponse (ByteString -> BodyReader -> ByteString
forall a b. a -> b -> a
const ByteString
b) Response BodyReader
res)

          a
x <- StreamingResponse -> IO a
k ((BodyReader -> SourceT IO ByteString)
-> Response BodyReader -> StreamingResponse
forall a b. (a -> b) -> Response a -> ResponseF b
clientResponseToResponse ((ByteString -> Bool) -> BodyReader -> SourceT IO ByteString
forall (m :: * -> *) a.
Functor m =>
(a -> Bool) -> m a -> SourceT m a
S.fromAction ByteString -> Bool
BS.null) Response BodyReader
res)
          a -> IO b
k1 a
x