{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeFamilies               #-}
module Servant.HttpStreams.Internal where

import           Prelude ()
import           Prelude.Compat

import           Control.DeepSeq
                 (NFData, force)
import           Control.Exception
                 (IOException, SomeException (..), catch, evaluate, throwIO)
import           Control.Monad
                 (unless)
import           Control.Monad.Base
                 (MonadBase (..))
import           Control.Monad.Codensity
                 (Codensity (..))
import           Control.Monad.Error.Class
                 (MonadError (..))
import           Control.Monad.IO.Class
                 (MonadIO (..))
import           Control.Monad.Reader
                 (MonadReader, ReaderT, ask, runReaderT)
import           Control.Monad.Trans.Class
                 (lift)
import           Control.Monad.Trans.Except
                 (ExceptT, runExceptT)
import           Data.Bifunctor
                 (bimap, first)
import           Data.ByteString.Builder
                 (toLazyByteString)
import qualified Data.ByteString.Builder    as B
import qualified Data.ByteString.Lazy       as BSL
import qualified Data.CaseInsensitive       as CI
import           Data.Foldable
                 (for_, toList)
import           Data.Functor.Alt
                 (Alt (..))
import           Data.Maybe
                 (maybeToList)
import           Data.Proxy
                 (Proxy (..))
import           Data.Sequence
                 (fromList)
import           Data.String
                 (fromString)
import           GHC.Generics
import           Network.HTTP.Media
                 (renderHeader)
import           Network.HTTP.Types
                 (Status (..), hContentType, http11, renderQuery, statusIsSuccessful)
import           Servant.Client.Core

import qualified Network.Http.Client        as Client
import qualified Network.Http.Types         as Client
import qualified Servant.Types.SourceT      as S
import qualified System.IO.Streams          as Streams

-- | The environment in which a request is run.
--
-- 'ClientEnv' carries an open connection. See 'withClientEnvIO'.
--
data ClientEnv
    = ClientEnv
    { ClientEnv -> BaseUrl
baseUrl    :: BaseUrl
    , ClientEnv -> Connection
connection :: Client.Connection
    }

-- | 'ClientEnv' smart constructor.
mkClientEnv :: BaseUrl -> Client.Connection -> ClientEnv
mkClientEnv :: BaseUrl -> Connection -> ClientEnv
mkClientEnv = BaseUrl -> Connection -> ClientEnv
ClientEnv

-- | Open a connection to 'BaseUrl'.
withClientEnvIO :: BaseUrl -> (ClientEnv -> IO r) -> IO r
withClientEnvIO :: forall r. BaseUrl -> (ClientEnv -> IO r) -> IO r
withClientEnvIO BaseUrl
burl ClientEnv -> IO r
k = forall γ. IO Connection -> (Connection -> IO γ) -> IO γ
Client.withConnection IO Connection
open forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
    ClientEnv -> IO r
k (BaseUrl -> Connection -> ClientEnv
mkClientEnv BaseUrl
burl Connection
conn)
  where
    open :: IO Connection
open = ByteString -> Port -> IO Connection
Client.openConnection (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ BaseUrl -> String
baseUrlHost BaseUrl
burl) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ BaseUrl -> Int
baseUrlPort BaseUrl
burl)

-- | 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 :: forall api.
HasClient ClientM api =>
Proxy api -> Client ClientM api
client Proxy api
api = Proxy api
api forall (m :: * -> *) api.
HasClient m api =>
Proxy api -> Proxy m -> Client m api
`clientIn` (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 :: forall api (m :: * -> *) (n :: * -> *).
HasClient ClientM api =>
Proxy api -> (forall a. m a -> n a) -> Client m api -> Client n api
hoistClient = 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 (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
    { forall a.
ClientM a
-> ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
unClientM :: ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a }
  deriving ( 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
<$ :: forall a b. a -> ClientM b -> ClientM a
$c<$ :: forall a b. a -> ClientM b -> ClientM a
fmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
$cfmap :: forall a b. (a -> b) -> ClientM a -> ClientM b
Functor, Functor ClientM
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
<* :: forall a b. ClientM a -> ClientM b -> ClientM a
$c<* :: forall a b. ClientM a -> ClientM b -> ClientM a
*> :: forall a b. ClientM a -> ClientM b -> ClientM b
$c*> :: forall a b. ClientM a -> ClientM b -> ClientM b
liftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
$cliftA2 :: forall a b c. (a -> b -> c) -> ClientM a -> ClientM b -> ClientM c
<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
$c<*> :: forall a b. ClientM (a -> b) -> ClientM a -> ClientM b
pure :: forall a. a -> ClientM a
$cpure :: forall a. a -> ClientM a
Applicative, Applicative ClientM
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 :: forall a. a -> ClientM a
$creturn :: forall a. a -> ClientM a
>> :: forall a b. ClientM a -> ClientM b -> ClientM b
$c>> :: forall a b. ClientM a -> ClientM b -> ClientM b
>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
$c>>= :: forall a b. ClientM a -> (a -> ClientM b) -> ClientM b
Monad, Monad ClientM
forall a. IO a -> ClientM a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> ClientM a
$cliftIO :: forall a. IO a -> ClientM a
MonadIO, 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 :: forall a. IO a -> ClientM a
liftBase = forall a.
ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
ClientM forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <!> :: forall a. ClientM a -> ClientM a -> ClientM a
<!> ClientM a
b = ClientM a
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 :: forall a. ClientError -> ClientM a
throwClientError = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

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

runClientM :: NFData a => ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM :: forall a.
NFData a =>
ClientM a -> ClientEnv -> IO (Either ClientError a)
runClientM ClientM a
cm ClientEnv
env = forall a b.
ClientM a -> ClientEnv -> (Either ClientError a -> IO b) -> IO b
withClientM ClientM a
cm ClientEnv
env (forall a. a -> IO a
evaluate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NFData a => a -> a
force)

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

performRequest :: Maybe [Status] -> Request -> ClientM Response
performRequest :: Maybe [Status] -> Request -> ClientM Response
performRequest Maybe [Status]
acceptStatus Request
req = do
    ClientEnv BaseUrl
burl Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let (Request
req', OutputStream Builder -> IO ()
body) = BaseUrl -> Request -> (Request, OutputStream Builder -> IO ())
requestToClientRequest BaseUrl
burl Request
req
    Either ClientError Response
x <- forall a.
ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
ClientM forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity forall a b. (a -> b) -> a -> b
$ \Either ClientError Response -> IO b
k -> do
        forall α.
Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
Client.sendRequest Connection
conn Request
req' OutputStream Builder -> IO ()
body
        forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
Client.receiveResponse Connection
conn forall a b. (a -> b) -> a -> b
$ \Response
res' InputStream ByteString
body' -> do
            let status :: Status
status = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Response -> Int
Client.getStatusCode Response
res'
            ByteString
lbs <- [ByteString] -> ByteString
BSL.fromChunks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. InputStream a -> IO [a]
Streams.toList InputStream ByteString
body'
            let res'' :: Response
res'' = forall body. Response -> body -> ResponseF body
clientResponseToResponse Response
res' ByteString
lbs
                goodStatus :: Bool
goodStatus = case Maybe [Status]
acceptStatus of
                  Maybe [Status]
Nothing -> Status -> Bool
statusIsSuccessful Status
status
                  Just [Status]
good -> Status
status forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Status]
good
            if Bool
goodStatus
            then Either ClientError Response -> IO b
k (forall a b. b -> Either a b
Right Response
res'')
            else Either ClientError Response -> IO b
k (forall a b. a -> Either a b
Left (BaseUrl -> Request -> Response -> ClientError
mkFailureResponse BaseUrl
burl Request
req Response
res''))

    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall (f :: * -> *) a. Applicative f => a -> f a
pure Either ClientError Response
x

performWithStreamingRequest :: Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest :: forall a. Request -> (StreamingResponse -> IO a) -> ClientM a
performWithStreamingRequest Request
req StreamingResponse -> IO a
k = do
    ClientEnv BaseUrl
burl Connection
conn <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let (Request
req', OutputStream Builder -> IO ()
body) = BaseUrl -> Request -> (Request, OutputStream Builder -> IO ())
requestToClientRequest BaseUrl
burl Request
req
    forall a.
ReaderT ClientEnv (ExceptT ClientError (Codensity IO)) a
-> ClientM a
ClientM forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall k (m :: k -> *) a.
(forall (b :: k). (a -> m b) -> m b) -> Codensity m a
Codensity forall a b. (a -> b) -> a -> b
$ \a -> IO b
k1 -> do
        forall α.
Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
Client.sendRequest Connection
conn Request
req' OutputStream Builder -> IO ()
body
        forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
Client.receiveResponseRaw Connection
conn forall a b. (a -> b) -> a -> b
$ \Response
res' InputStream ByteString
body' -> do
            -- check status code
            let status :: Status
status = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ Response -> Int
Client.getStatusCode Response
res'
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status -> Bool
statusIsSuccessful Status
status) forall a b. (a -> b) -> a -> b
$ do
                ByteString
lbs <- [ByteString] -> ByteString
BSL.fromChunks forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. InputStream a -> IO [a]
Streams.toList InputStream ByteString
body'
                forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ BaseUrl -> Request -> Response -> ClientError
mkFailureResponse BaseUrl
burl Request
req (forall body. Response -> body -> ResponseF body
clientResponseToResponse Response
res' ByteString
lbs)

            a
x <- StreamingResponse -> IO a
k (forall body. Response -> body -> ResponseF body
clientResponseToResponse Response
res' (forall b. InputStream b -> SourceT IO b
fromInputStream InputStream ByteString
body'))
            a -> IO b
k1 a
x

mkFailureResponse :: BaseUrl -> Request -> ResponseF BSL.ByteString -> ClientError
mkFailureResponse :: BaseUrl -> Request -> Response -> ClientError
mkFailureResponse BaseUrl
burl Request
request =
    RequestF () (BaseUrl, ByteString) -> Response -> ClientError
FailureResponse (forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (forall a b. a -> b -> a
const ()) Builder -> (BaseUrl, ByteString)
f Request
request)
  where
    f :: Builder -> (BaseUrl, ByteString)
f Builder
b = (BaseUrl
burl, ByteString -> ByteString
BSL.toStrict forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString Builder
b)

clientResponseToResponse :: Client.Response -> body -> ResponseF body
clientResponseToResponse :: forall body. Response -> body -> ResponseF body
clientResponseToResponse Response
r body
body = Response
    { responseStatusCode :: Status
responseStatusCode  = Int -> ByteString -> Status
Status (Response -> Int
Client.getStatusCode Response
r) (Response -> ByteString
Client.getStatusMessage Response
r)
    , responseBody :: body
responseBody        = body
body
    , responseHeaders :: Seq Header
responseHeaders     = forall a. [a] -> Seq a
fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall s. FoldCase s => s -> CI s
CI.mk) forall a b. (a -> b) -> a -> b
$ Headers -> [(ByteString, ByteString)]
Client.retrieveHeaders forall a b. (a -> b) -> a -> b
$ forall τ. HttpType τ => τ -> Headers
Client.getHeaders Response
r
    , responseHttpVersion :: HttpVersion
responseHttpVersion = HttpVersion
http11 -- guess
    }

requestToClientRequest :: BaseUrl -> Request -> (Client.Request, Streams.OutputStream B.Builder -> IO ())
requestToClientRequest :: BaseUrl -> Request -> (Request, OutputStream Builder -> IO ())
requestToClientRequest BaseUrl
burl Request
r = (Request
request, OutputStream Builder -> IO ()
body)
  where
    request :: Request
request = forall α. RequestBuilder α -> Request
Client.buildRequest1 forall a b. (a -> b) -> a -> b
$ do
        Method -> ByteString -> RequestBuilder ()
Client.http (ByteString -> Method
Client.Method forall a b. (a -> b) -> a -> b
$ forall body path. RequestF body path -> ByteString
requestMethod Request
r)
            forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString (BaseUrl -> String
baseUrlPath BaseUrl
burl)
            forall a. Semigroup a => a -> a -> a
<> ByteString -> ByteString
BSL.toStrict (Builder -> ByteString
toLazyByteString (forall body path. RequestF body path -> path
requestPath Request
r))
            forall a. Semigroup a => a -> a -> a
<> Bool -> Query -> ByteString
renderQuery Bool
True (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall body path. RequestF body path -> Seq QueryItem
requestQueryString Request
r))
        -- We are connected, but we still need to know what we try to query
        ByteString -> Port -> RequestBuilder ()
Client.setHostname (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ BaseUrl -> String
baseUrlHost BaseUrl
burl) (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ BaseUrl -> Int
baseUrlPort BaseUrl
burl)
        forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall a. Maybe a -> [a]
maybeToList Maybe Header
acceptHdr forall a. [a] -> [a] -> [a]
++ forall a. Maybe a -> [a]
maybeToList Maybe Header
contentTypeHdr forall a. [a] -> [a] -> [a]
++ [Header]
headers) forall a b. (a -> b) -> a -> b
$ \(HeaderName
hn, ByteString
hv) ->
            ByteString -> ByteString -> RequestBuilder ()
Client.setHeader (forall s. CI s -> s
CI.original HeaderName
hn) ByteString
hv

        -- body is always chunked
        RequestBuilder ()
Client.setTransferEncoding

    -- Content-Type and Accept are specified by requestBody and requestAccept
    headers :: [Header]
headers = forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
h, ByteString
_) -> HeaderName
h forall a. Eq a => a -> a -> Bool
/= HeaderName
"Accept" Bool -> Bool -> Bool
&& HeaderName
h forall a. Eq a => a -> a -> Bool
/= HeaderName
"Content-Type") forall a b. (a -> b) -> a -> b
$
        forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall body path. RequestF body path -> Seq Header
requestHeaders Request
r

    acceptHdr :: Maybe Header
acceptHdr
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MediaType]
hs   = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just (HeaderName
"Accept", forall h. RenderHeader h => h -> ByteString
renderHeader [MediaType]
hs)
      where
        hs :: [MediaType]
hs = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ forall body path. RequestF body path -> Seq MediaType
requestAccept Request
r

    convertBody :: RequestBody -> OutputStream Builder -> IO ()
convertBody RequestBody
bd OutputStream Builder
os = case RequestBody
bd of
        RequestBodyLBS ByteString
body' ->
            forall a. OutputStream a -> Maybe a -> IO ()
Streams.writeTo OutputStream Builder
os (forall a. a -> Maybe a
Just (ByteString -> Builder
B.lazyByteString ByteString
body'))
        RequestBodyBS ByteString
body' ->
            forall a. OutputStream a -> Maybe a -> IO ()
Streams.writeTo OutputStream Builder
os (forall a. a -> Maybe a
Just (ByteString -> Builder
B.byteString ByteString
body'))
        RequestBodySource SourceIO ByteString
sourceIO ->
            SourceIO ByteString -> OutputStream Builder -> IO ()
toOutputStream SourceIO ByteString
sourceIO OutputStream Builder
os

    (OutputStream Builder -> IO ()
body, Maybe Header
contentTypeHdr) = case forall body path. RequestF body path -> Maybe (body, MediaType)
requestBody Request
r of
        Maybe (RequestBody, MediaType)
Nothing           -> (OutputStream Builder -> IO ()
Client.emptyBody, forall a. Maybe a
Nothing)
        Just (RequestBody
body', MediaType
typ) -> (RequestBody -> OutputStream Builder -> IO ()
convertBody RequestBody
body', forall a. a -> Maybe a
Just (HeaderName
hContentType, forall h. RenderHeader h => h -> ByteString
renderHeader MediaType
typ))

catchConnectionError :: IO a -> IO (Either ClientError a)
catchConnectionError :: forall a. IO a -> IO (Either ClientError a)
catchConnectionError IO a
action =
  forall e a. Exception e => IO a -> (e -> IO a) -> IO a
catch (forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO a
action) forall a b. (a -> b) -> a -> b
$ \IOException
e ->
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> ClientError
ConnectionError forall a b. (a -> b) -> a -> b
$ forall e. Exception e => e -> SomeException
SomeException (IOException
e :: IOException)

fromInputStream :: Streams.InputStream b -> S.SourceT IO b
fromInputStream :: forall b. InputStream b -> SourceT IO b
fromInputStream InputStream b
is = forall (m :: * -> *) a.
(forall b. (StepT m a -> m b) -> m b) -> SourceT m a
S.SourceT forall a b. (a -> b) -> a -> b
$ \StepT IO b -> IO b
k -> StepT IO b -> IO b
k StepT IO b
loop where
    loop :: StepT IO b
loop = forall (m :: * -> *) a. m (StepT m a) -> StepT m a
S.Effect forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall (m :: * -> *) a. StepT m a
S.Stop (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (m :: * -> *) a. a -> StepT m a -> StepT m a
S.Yield StepT IO b
loop) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream b
is

toOutputStream :: S.SourceT IO BSL.ByteString -> Streams.OutputStream B.Builder -> IO ()
toOutputStream :: SourceIO ByteString -> OutputStream Builder -> IO ()
toOutputStream (S.SourceT forall b. (StepT IO ByteString -> IO b) -> IO b
k) OutputStream Builder
os = forall b. (StepT IO ByteString -> IO b) -> IO b
k StepT IO ByteString -> IO ()
loop where
    loop :: StepT IO ByteString -> IO ()
loop StepT IO ByteString
S.Stop        = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop (S.Error String
err) = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
    loop (S.Skip StepT IO ByteString
s)    = StepT IO ByteString -> IO ()
loop StepT IO ByteString
s
    loop (S.Effect IO (StepT IO ByteString)
mx) = IO (StepT IO ByteString)
mx forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= StepT IO ByteString -> IO ()
loop
    loop (S.Yield ByteString
x StepT IO ByteString
s) = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just (ByteString -> Builder
B.lazyByteString ByteString
x)) OutputStream Builder
os forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> StepT IO ByteString -> IO ()
loop StepT IO ByteString
s