{-# 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 :: forall a.
Request -> Manager -> (Response (ByteString IO ()) -> IO a) -> IO a
withHTTP Request
r Manager
m Response (ByteString IO ()) -> IO a
k = 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 = (forall {m :: * -> *}. Monad m => m ByteString -> ByteStream m ()
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyReader -> BodyReader
brRead forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 <- forall a. a -> IO (IORef a)
newIORef ByteString IO ()
p0
let readAction :: IO B.ByteString
readAction :: BodyReader
readAction = do
ByteString IO ()
p <- forall a. IORef a -> IO a
readIORef IORef (ByteString IO ())
ioref
case ByteString IO ()
p of
Empty () -> do
forall a. IORef a -> a -> IO ()
writeIORef IORef (ByteString IO ())
ioref (forall (m :: * -> *) a. Monad m => a -> m a
return ())
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
forall a. IORef a -> a -> IO ()
writeIORef IORef (ByteString IO ())
ioref ByteString IO ()
p'
BodyReader
readAction
Chunk ByteString
bs ByteString IO ()
p' -> do
forall a. IORef a -> a -> IO ()
writeIORef IORef (ByteString IO ())
ioref ByteString IO ()
p'
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 <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
io
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs
ByteStream m ()
go
simpleHTTP :: MonadResource m => String -> ByteString m ()
simpleHTTP :: forall (m :: * -> *). MonadResource m => String -> ByteString m ()
simpleHTTP String
url = do
Manager
man <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings)
Request
req <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url)
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)
forall a. Response a -> IO ()
responseClose
( forall {m :: * -> *}. Monad m => m ByteString -> ByteStream m ()
from forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall body. Response body -> body
responseBody)
http :: MonadResource m
=> Request
-> Manager
-> m (Response (ByteString m ()))
http :: forall (m :: * -> *).
MonadResource m =>
Request -> Manager -> m (Response (ByteString m ()))
http Request
req Manager
man = do
(ReleaseKey
key, Response BodyReader
res) <- forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man) forall a. Response a -> IO ()
responseClose
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
res {responseBody :: ByteString m ()
responseBody = forall {m :: * -> *}. Monad m => m ByteString -> ByteStream m ()
from (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (forall body. Response body -> body
responseBody Response BodyReader
res))}