{-# LANGUAGE OverloadedStrings #-}
module Data.ByteString.Streaming.HTTP (
withHTTP
, http
, streamN
, stream
, simpleHTTP
, module Network.HTTP.Client
, module Network.HTTP.Client.TLS
, ResourceT (..)
, MonadResource (..)
, runResourceT
) where
import Control.Monad (unless)
import qualified Data.ByteString as B
import Data.Int (Int64)
import Data.IORef (newIORef, readIORef, writeIORef)
import Network.HTTP.Client
import Network.HTTP.Client.TLS
import Data.ByteString.Streaming
import Data.ByteString.Streaming.Internal
import Control.Monad.Trans
import Control.Monad.Trans.Resource
import qualified Data.ByteString.Streaming.Char8 as Q
withHTTP
:: Request
-> Manager
-> (Response (ByteString IO ()) -> IO a)
-> IO a
withHTTP :: Request -> Manager -> (Response (ByteString IO ()) -> IO a) -> IO a
withHTTP Request
r Manager
m Response (ByteString IO ()) -> IO a
k = Request -> Manager -> (Response BodyReader -> IO a) -> IO a
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
r Manager
m Response BodyReader -> IO a
k'
where
k' :: Response BodyReader -> IO a
k' Response BodyReader
resp = do
let p :: ByteString IO ()
p = (BodyReader -> ByteString IO ()
forall (m :: * -> *). Monad m => m ByteString -> ByteStream m ()
from (BodyReader -> ByteString IO ())
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> ByteString IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyReader -> BodyReader
brRead (BodyReader -> BodyReader)
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> BodyReader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody) Response BodyReader
resp
Response (ByteString IO ()) -> IO a
k (Response BodyReader
resp { responseBody :: ByteString IO ()
responseBody = ByteString IO ()
p})
{-# INLINABLE withHTTP #-}
streamN :: Int64 -> ByteString IO () -> RequestBody
streamN :: Int64 -> ByteString IO () -> RequestBody
streamN Int64
n ByteString IO ()
p = Int64 -> GivesPopper () -> RequestBody
RequestBodyStream Int64
n (ByteString IO () -> GivesPopper ()
to ByteString IO ()
p)
{-# INLINABLE streamN #-}
stream :: ByteString IO () -> RequestBody
stream :: ByteString IO () -> RequestBody
stream ByteString IO ()
p = GivesPopper () -> RequestBody
RequestBodyStreamChunked (ByteString IO () -> GivesPopper ()
to ByteString IO ()
p)
{-# INLINABLE stream #-}
to :: ByteString IO () -> (IO B.ByteString -> IO ()) -> IO ()
to :: ByteString IO () -> GivesPopper ()
to ByteString IO ()
p0 BodyReader -> IO ()
k = do
IORef (ByteString IO ())
ioref <- ByteString IO () -> IO (IORef (ByteString IO ()))
forall a. a -> IO (IORef a)
newIORef ByteString IO ()
p0
let readAction :: IO B.ByteString
readAction :: BodyReader
readAction = do
ByteString IO ()
p <- IORef (ByteString IO ()) -> IO (ByteString IO ())
forall a. IORef a -> IO a
readIORef IORef (ByteString IO ())
ioref
case ByteString IO ()
p of
Empty () -> do
IORef (ByteString IO ()) -> ByteString IO () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ByteString IO ())
ioref (() -> ByteString IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
Go IO (ByteString IO ())
m -> do
ByteString IO ()
p' <- IO (ByteString IO ())
m
IORef (ByteString IO ()) -> ByteString IO () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ByteString IO ())
ioref ByteString IO ()
p'
BodyReader
readAction
Chunk ByteString
bs ByteString IO ()
p' -> do
IORef (ByteString IO ()) -> ByteString IO () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (ByteString IO ())
ioref ByteString IO ()
p'
ByteString -> BodyReader
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
BodyReader -> IO ()
k BodyReader
readAction
from :: m ByteString -> ByteStream m ()
from m ByteString
io = ByteStream m ()
go
where
go :: ByteStream m ()
go = do
ByteString
bs <- m ByteString -> ByteStream m ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
io
Bool -> ByteStream m () -> ByteStream m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ByteStream m () -> ByteStream m ())
-> ByteStream m () -> ByteStream m ()
forall a b. (a -> b) -> a -> b
$ do
ByteString -> ByteStream m ()
forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs
ByteStream m ()
go
simpleHTTP :: MonadResource m => String -> ByteString m ()
simpleHTTP :: String -> ByteString m ()
simpleHTTP String
url = do
Manager
man <- IO Manager -> ByteStream m Manager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings)
Request
req <- IO Request -> ByteStream m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url)
IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> (Response BodyReader -> ByteString m ())
-> ByteString m ()
forall (m :: * -> *) a b.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b
bracketByteString
(Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man)
Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose
( m ByteString -> ByteString m ()
forall (m :: * -> *). Monad m => m ByteString -> ByteStream m ()
from (m ByteString -> ByteString m ())
-> (Response BodyReader -> m ByteString)
-> Response BodyReader
-> ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyReader -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BodyReader -> m ByteString)
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody)
http :: MonadResource m
=> Request
-> Manager
-> m (Response (ByteString m ()))
http :: Request -> Manager -> m (Response (ByteString m ()))
http Request
req Manager
man = do
(ReleaseKey
key, Response BodyReader
res) <- IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> m (ReleaseKey, Response BodyReader)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man) Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose
Response (ByteString m ()) -> m (Response (ByteString m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
res {responseBody :: ByteString m ()
responseBody = m ByteString -> ByteString m ()
forall (m :: * -> *). Monad m => m ByteString -> ByteStream m ()
from (BodyReader -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody Response BodyReader
res))}