-- |
-- Module      :  Network.HTTP.Req.Conduit
-- Copyright   :  © 2016–present Mark Karpov, Michael Snoyman
-- License     :  BSD 3 clause
--
-- Maintainer  :  Mark Karpov <markkarpov92@gmail.com>
-- Stability   :  experimental
-- Portability :  portable
--
-- The module extends functionality available in "Network.HTTP.Req" with
-- Conduit helpers for streaming big request bodies.
--
-- The package re-uses some pieces of code from the @http-conduit@ package,
-- but not to the extent that depending on that package becomes reasonable.
module Network.HTTP.Req.Conduit
  ( -- * Streaming request bodies
    ReqBodySource (..),

    -- * Streaming response bodies
    -- $streaming-response
    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

----------------------------------------------------------------------------
-- Request bodies

-- | This body option streams contents of request body from the given
-- source. The 'Int64' value is size of the data in bytes.
--
-- Using of this body option does not set the @Content-Type@ header.
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)

----------------------------------------------------------------------------
-- Response interpretations

-- $streaming-response
--
-- The easiest way to stream response of an HTTP request is to use the
-- 'reqBr' function in conjunction with 'responseBodySource':
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > module Main (main) where
-- >
-- > import Data.Conduit ((.|), runConduitRes)
-- > import Data.Default.Class
-- > import Network.HTTP.Req
-- > import Network.HTTP.Req.Conduit
-- > import qualified Data.Conduit.Binary as CB
-- >
-- > main :: IO ()
-- > main = runReq def $ do
-- >   let size = 100000 :: Int
-- >   reqBr GET (https "httpbin.org" /: "bytes" /~ size) NoReqBody mempty $ \r ->
-- >     runConduitRes $
-- >       responseBodySource r .| CB.sinkFile "my-file.bin"
--
-- This solution benefits from the fact that Req still handles all the
-- details like handling of exceptions and retrying for us. However this
-- approach is only viable when the entire pipeline can be run in 'IO' monad
-- (in the function that is the last argument of 'reqBr').
--
-- If you need to use a more complex monad, use the lower-level function
-- 'req'':
--
-- > {-# LANGUAGE FlexibleInstances #-}
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > module Main (main) where
-- >
-- > import Control.Exception (throwIO)
-- > import Control.Monad.IO.Class (MonadIO (..))
-- > import Control.Monad.Trans.Resource (ResourceT)
-- > import Data.Conduit
-- > import Network.HTTP.Req
-- > import Network.HTTP.Req.Conduit
-- > import qualified Data.Conduit.Binary as CB
-- > import qualified Network.HTTP.Client as L
-- >
-- > instance MonadHttp (ConduitM i o (ResourceT IO)) where
-- >   handleHttpException = liftIO . throwIO
-- >
-- > main :: IO ()
-- > main = runConduitRes $ do
-- >   let size = 100000 :: Int
-- >   req' GET (https "httpbin.org" /: "bytes" /~ size) NoReqBody mempty
-- >     (\request manager ->
-- >       bracketP (L.responseOpen request manager) L.responseClose
-- >         responseBodySource)
-- >     .| CB.sinkFile "my-file.bin"
--
-- 'req'' does not open\/close connections, handle exceptions, and does not
-- perform retrying though, so you're on your own.

-- | Turn @'L.Response' 'L.BodyReader'@ into a producer.
--
-- @since 1.0.0
responseBodySource ::
  MonadIO m =>
  -- | Response with body reader
  L.Response L.BodyReader ->
  -- | Response body as a 'C.Producer'
  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

----------------------------------------------------------------------------
-- Helpers

-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.
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

-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.
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