module Network.HTTP.Req.Conduit
(
ReqBodySource (..),
responseBodySource,
)
where
import Control.Monad
import Control.Monad.IO.Class (MonadIO (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Conduit (ConduitT, await, yield, ($$+), ($$++))
import Data.IORef
import Data.Int (Int64)
import qualified Network.HTTP.Client as L
import Network.HTTP.Req
data ReqBodySource = ReqBodySource Int64 (ConduitT () ByteString IO ())
instance HttpBody ReqBodySource where
getRequestBody :: ReqBodySource -> RequestBody
getRequestBody (ReqBodySource Int64
size ConduitT () ByteString IO ()
src) =
Int64 -> GivesPopper () -> RequestBody
L.RequestBodyStream Int64
size (ConduitT () ByteString IO () -> GivesPopper ()
srcToPopperIO ConduitT () ByteString IO ()
src)
responseBodySource ::
MonadIO m =>
L.Response L.BodyReader ->
ConduitT i ByteString m ()
responseBodySource :: Response BodyReader -> ConduitT i ByteString m ()
responseBodySource = BodyReader -> ConduitT i ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitT i ByteString m ()
bodyReaderSource (BodyReader -> ConduitT i ByteString m ())
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> ConduitT i ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> BodyReader
forall body. Response body -> body
L.responseBody
srcToPopperIO :: ConduitT () ByteString IO () -> L.GivesPopper ()
srcToPopperIO :: ConduitT () ByteString IO () -> GivesPopper ()
srcToPopperIO ConduitT () ByteString IO ()
src NeedsPopper ()
f = do
(SealedConduitT () ByteString IO ()
rsrc0, ()) <- ConduitT () ByteString IO ()
src ConduitT () ByteString IO ()
-> Sink ByteString IO ()
-> IO (SealedConduitT () ByteString IO (), ())
forall (m :: * -> *) a b.
Monad m =>
Source m a -> Sink a m b -> m (SealedConduitT () a m (), b)
$$+ () -> Sink ByteString IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
IORef (SealedConduitT () ByteString IO ())
irsrc <- SealedConduitT () ByteString IO ()
-> IO (IORef (SealedConduitT () ByteString IO ()))
forall a. a -> IO (IORef a)
newIORef SealedConduitT () ByteString IO ()
rsrc0
let popper :: IO ByteString
popper :: BodyReader
popper = do
SealedConduitT () ByteString IO ()
rsrc <- IORef (SealedConduitT () ByteString IO ())
-> IO (SealedConduitT () ByteString IO ())
forall a. IORef a -> IO a
readIORef IORef (SealedConduitT () ByteString IO ())
irsrc
(SealedConduitT () ByteString IO ()
rsrc', Maybe ByteString
mres) <- SealedConduitT () ByteString IO ()
rsrc SealedConduitT () ByteString IO ()
-> Sink ByteString IO (Maybe ByteString)
-> IO (SealedConduitT () ByteString IO (), Maybe ByteString)
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> Sink a m b -> m (SealedConduitT () a m (), b)
$$++ Sink ByteString IO (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await
IORef (SealedConduitT () ByteString IO ())
-> SealedConduitT () ByteString IO () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SealedConduitT () ByteString IO ())
irsrc SealedConduitT () ByteString IO ()
rsrc'
case Maybe ByteString
mres of
Maybe ByteString
Nothing -> ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
Just ByteString
bs
| ByteString -> Bool
B.null ByteString
bs -> BodyReader
popper
| Bool
otherwise -> ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
NeedsPopper ()
f BodyReader
popper
bodyReaderSource :: MonadIO m => L.BodyReader -> ConduitT i ByteString m ()
bodyReaderSource :: BodyReader -> ConduitT i ByteString m ()
bodyReaderSource BodyReader
br = ConduitT i ByteString m ()
forall i. ConduitT i ByteString m ()
go
where
go :: ConduitT i ByteString m ()
go = do
ByteString
bs <- BodyReader -> ConduitT i ByteString m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BodyReader -> BodyReader
L.brRead BodyReader
br)
Bool -> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ConduitT i ByteString m () -> ConduitT i ByteString m ())
-> ConduitT i ByteString m () -> ConduitT i ByteString m ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> ConduitT i ByteString m ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
ConduitT i ByteString m ()
go