{-# 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
data ClientEnv
= ClientEnv
{ ClientEnv -> BaseUrl
baseUrl :: BaseUrl
, ClientEnv -> Connection
connection :: Client.Connection
}
mkClientEnv :: BaseUrl -> Client.Connection -> ClientEnv
mkClientEnv :: BaseUrl -> Connection -> ClientEnv
mkClientEnv = BaseUrl -> Connection -> ClientEnv
ClientEnv
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)
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)
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)
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
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
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
}
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))
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
RequestBuilder ()
Client.setTransferEncoding
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