{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
-- | A new, experimental API to replace "Network.HTTP.Conduit".
--
-- For most users, "Network.HTTP.Simple" is probably a better choice. For more
-- information, see:
--
-- <https://haskell-lang.org/library/http-client>
--
-- For more information on using this module, please be sure to read the
-- documentation in the "Network.HTTP.Client" module.
module Network.HTTP.Client.Conduit
    ( -- * Conduit-specific interface
      withResponse
    , responseOpen
    , responseClose
    , acquireResponse
    , httpSource
      -- * Manager helpers
    , defaultManagerSettings
    , newManager
    , newManagerSettings
      -- * General HTTP client interface
    , module Network.HTTP.Client
    , httpLbs
    , httpNoBody
      -- * Lower-level conduit functions
    , requestBodySource
    , requestBodySourceChunked
    , bodyReaderSource
    ) where

import           Control.Monad                (unless)
import           Control.Monad.IO.Unlift      (MonadIO, liftIO, MonadUnliftIO, withRunInIO)
import           Control.Monad.Reader         (MonadReader (..), runReaderT)
import           Control.Monad.Trans.Resource (MonadResource)
import           Data.Acquire                 (Acquire, mkAcquire, with)
import           Data.ByteString              (ByteString)
import qualified Data.ByteString              as S
import qualified Data.ByteString.Lazy         as L
import           Data.Conduit                 (ConduitM, ($$+), ($$++),
                                               await, yield, bracketP)
import           Data.Int                     (Int64)
import           Data.IORef                   (newIORef, readIORef, writeIORef)
import           Network.HTTP.Client          hiding (closeManager,
                                               defaultManagerSettings, httpLbs,
                                               newManager, responseClose,
                                               responseOpen,
                                               withResponse, BodyReader, brRead, brConsume, httpNoBody)
import qualified Network.HTTP.Client          as H
import           Network.HTTP.Client.TLS      (tlsManagerSettings)

-- | Conduit powered version of 'H.withResponse'. Differences are:
--
-- * Response body is represented as a @Producer@.
--
-- * Generalized to any instance of @MonadUnliftIO@, not just @IO@.
--
-- * The @Manager@ is contained by a @MonadReader@ context.
--
-- Since 2.1.0
withResponse :: (MonadUnliftIO m, MonadIO n, MonadReader env m, HasHttpManager env)
             => Request
             -> (Response (ConduitM i ByteString n ()) -> m a)
             -> m a
withResponse :: forall (m :: * -> *) (n :: * -> *) env i a.
(MonadUnliftIO m, MonadIO n, MonadReader env m,
 HasHttpManager env) =>
Request -> (Response (ConduitM i ByteString n ()) -> m a) -> m a
withResponse Request
req Response (ConduitM i ByteString n ()) -> m a
f = do
    env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. m a -> IO a) -> IO b) -> m b
withRunInIO forall a b. (a -> b) -> a -> b
$ \forall a. m a -> IO a
run -> forall (m :: * -> *) a b.
MonadUnliftIO m =>
Acquire a -> (a -> m b) -> m b
with (forall (n :: * -> *) env (m :: * -> *) i.
(MonadIO n, MonadReader env m, HasHttpManager env) =>
Request -> m (Acquire (Response (ConduitM i ByteString n ())))
acquireResponse Request
req env
env) (forall a. m a -> IO a
run forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response (ConduitM i ByteString n ()) -> m a
f)

-- | An @Acquire@ for getting a @Response@.
--
-- Since 2.1.0
acquireResponse :: (MonadIO n, MonadReader env m, HasHttpManager env)
                => Request
                -> m (Acquire (Response (ConduitM i ByteString n ())))
acquireResponse :: forall (n :: * -> *) env (m :: * -> *) i.
(MonadIO n, MonadReader env m, HasHttpManager env) =>
Request -> m (Acquire (Response (ConduitM i ByteString n ())))
acquireResponse Request
req = do
    env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let man :: Manager
man = forall a. HasHttpManager a => a -> Manager
getHttpManager env
env
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ do
        Response BodyReader
res <- forall a. IO a -> (a -> IO ()) -> Acquire a
mkAcquire (Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req Manager
man) forall a. Response a -> IO ()
H.responseClose
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource Response BodyReader
res

-- | TLS-powered manager settings.
--
-- Since 2.1.0
defaultManagerSettings :: ManagerSettings
defaultManagerSettings :: ManagerSettings
defaultManagerSettings = ManagerSettings
tlsManagerSettings

-- | Get a new manager using 'defaultManagerSettings'.
--
-- Since 2.1.0
newManager :: MonadIO m => m Manager
newManager :: forall (m :: * -> *). MonadIO m => m Manager
newManager = forall (m :: * -> *). MonadIO m => ManagerSettings -> m Manager
newManagerSettings ManagerSettings
defaultManagerSettings

-- | Get a new manager using the given settings.
--
-- Since 2.1.0
newManagerSettings :: MonadIO m => ManagerSettings -> m Manager
newManagerSettings :: forall (m :: * -> *). MonadIO m => ManagerSettings -> m Manager
newManagerSettings = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. ManagerSettings -> IO Manager
H.newManager

-- | Conduit-powered version of 'H.responseOpen'.
--
-- See 'withResponse' for the differences with 'H.responseOpen'.
--
-- Since 2.1.0
responseOpen :: (MonadIO m, MonadIO n, MonadReader env m, HasHttpManager env)
             => Request
             -> m (Response (ConduitM i ByteString n ()))
responseOpen :: forall (m :: * -> *) (n :: * -> *) env i.
(MonadIO m, MonadIO n, MonadReader env m, HasHttpManager env) =>
Request -> m (Response (ConduitM i ByteString n ()))
responseOpen Request
req = do
    env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Request -> Manager -> IO (Response BodyReader)
H.responseOpen Request
req (forall a. HasHttpManager a => a -> Manager
getHttpManager env
env)

-- | Generalized version of 'H.responseClose'.
--
-- Since 2.1.0
responseClose :: MonadIO m => Response body -> m ()
responseClose :: forall (m :: * -> *) body. MonadIO m => Response body -> m ()
responseClose = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Response a -> IO ()
H.responseClose

bodyReaderSource :: MonadIO m
                 => H.BodyReader
                 -> ConduitM i ByteString m ()
bodyReaderSource :: forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
bodyReaderSource BodyReader
br =
    forall {i}. ConduitT i ByteString m ()
loop
  where
    loop :: ConduitT i ByteString m ()
loop = do
        ByteString
bs <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ BodyReader -> BodyReader
H.brRead BodyReader
br
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
S.null ByteString
bs) forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield ByteString
bs
            ConduitT i ByteString m ()
loop

requestBodySource :: Int64 -> ConduitM () ByteString IO () -> RequestBody
requestBodySource :: Int64 -> ConduitM () ByteString IO () -> RequestBody
requestBodySource Int64
size = Int64 -> GivesPopper () -> RequestBody
RequestBodyStream Int64
size forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM () ByteString IO () -> GivesPopper ()
srcToPopperIO

requestBodySourceChunked :: ConduitM () ByteString IO () -> RequestBody
requestBodySourceChunked :: ConduitM () ByteString IO () -> RequestBody
requestBodySourceChunked = GivesPopper () -> RequestBody
RequestBodyStreamChunked forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM () ByteString IO () -> GivesPopper ()
srcToPopperIO

srcToPopperIO :: ConduitM () ByteString IO () -> GivesPopper ()
srcToPopperIO :: ConduitM () ByteString IO () -> GivesPopper ()
srcToPopperIO ConduitM () ByteString IO ()
src NeedsPopper ()
f = do
    (SealedConduitT () ByteString IO ()
rsrc0, ()) <- ConduitM () ByteString IO ()
src forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m ()
-> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
$$+ forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IORef (SealedConduitT () ByteString IO ())
irsrc <- forall a. a -> IO (IORef a)
newIORef SealedConduitT () ByteString IO ()
rsrc0
    let popper :: IO ByteString
        popper :: BodyReader
popper = do
            SealedConduitT () ByteString IO ()
rsrc <- forall a. IORef a -> IO a
readIORef IORef (SealedConduitT () ByteString IO ())
irsrc
            (SealedConduitT () ByteString IO ()
rsrc', Maybe ByteString
mres) <- SealedConduitT () ByteString IO ()
rsrc forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
$$++ forall (m :: * -> *) i o. Monad m => ConduitT i o m (Maybe i)
await
            forall a. IORef a -> a -> IO ()
writeIORef IORef (SealedConduitT () ByteString IO ())
irsrc SealedConduitT () ByteString IO ()
rsrc'
            case Maybe ByteString
mres of
                Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
S.empty
                Just ByteString
bs
                    | ByteString -> Bool
S.null ByteString
bs -> BodyReader
popper
                    | Bool
otherwise -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
    NeedsPopper ()
f BodyReader
popper

-- | Same as 'H.httpLbs', except it uses the @Manager@ in the reader environment.
--
-- Since 2.1.1
httpLbs :: (MonadIO m, HasHttpManager env, MonadReader env m)
        => Request
        -> m (Response L.ByteString)
httpLbs :: forall (m :: * -> *) env.
(MonadIO m, HasHttpManager env, MonadReader env m) =>
Request -> m (Response ByteString)
httpLbs Request
req = do
    env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let man :: Manager
man = forall a. HasHttpManager a => a -> Manager
getHttpManager env
env
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
H.httpLbs Request
req Manager
man

-- | Same as 'H.httpNoBody', except it uses the @Manager@ in the reader environment.
--
-- This can be more convenient that using 'withManager' as it avoids the need
-- to specify the base monad for the response body.
--
-- Since 2.1.2
httpNoBody :: (MonadIO m, HasHttpManager env, MonadReader env m)
           => Request
           -> m (Response ())
httpNoBody :: forall (m :: * -> *) env.
(MonadIO m, HasHttpManager env, MonadReader env m) =>
Request -> m (Response ())
httpNoBody Request
req = do
    env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
    let man :: Manager
man = forall a. HasHttpManager a => a -> Manager
getHttpManager env
env
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ())
H.httpNoBody Request
req Manager
man

-- | Same as 'Network.HTTP.Simple.httpSource', but uses 'Manager'
--   from Reader environment instead of the global one.
--
--   Since 2.3.6
httpSource
  :: (MonadResource m, MonadIO n, MonadReader env m, HasHttpManager env)
  => Request
  -> (Response (ConduitM () ByteString n ()) -> ConduitM () r m ())
  -> ConduitM () r m ()
httpSource :: forall (m :: * -> *) (n :: * -> *) env r.
(MonadResource m, MonadIO n, MonadReader env m,
 HasHttpManager env) =>
Request
-> (Response (ConduitM () ByteString n ()) -> ConduitM () r m ())
-> ConduitM () r m ()
httpSource Request
request Response (ConduitM () ByteString n ()) -> ConduitM () r m ()
withRes = do
  env
env <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall (m :: * -> *) a i o r.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ConduitT i o m r) -> ConduitT i o m r
bracketP
    (forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (forall (m :: * -> *) (n :: * -> *) env i.
(MonadIO m, MonadIO n, MonadReader env m, HasHttpManager env) =>
Request -> m (Response (ConduitM i ByteString n ()))
responseOpen Request
request) env
env)
    forall (m :: * -> *) body. MonadIO m => Response body -> m ()
responseClose
    Response (ConduitM () ByteString n ()) -> ConduitM () r m ()
withRes