-- |
-- Module      :  Network.HTTP.Req.Conduit
-- Copyright   :  © 2016–2017 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.

{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes        #-}
{-# LANGUAGE TypeFamilies      #-}

#if __GLASGOW_HASKELL__ <  710
{-# LANGUAGE ConstraintKinds #-}
#endif

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 Data.Conduit (Source, ($$+), ($$++), await, yield)
import Data.IORef
import Data.Int (Int64)
import Network.HTTP.Req
import qualified Data.ByteString     as B
import qualified Data.Conduit        as C
import qualified Network.HTTP.Client as L

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

-- | This body option streams contents of request body from the given
-- 'C.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 (C.Source IO ByteString)

instance HttpBody ReqBodySource where
  getRequestBody (ReqBodySource size src) =
    L.RequestBodyStream size (srcToPopperIO 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, you'll need to deal with 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 'C.Producer'.
--
-- @since 1.0.0

responseBodySource :: MonadIO m
  => L.Response L.BodyReader -- ^ Response with body reader
  -> C.Producer m ByteString -- ^ Response body as a 'C.Producer'
responseBodySource = bodyReaderSource . L.responseBody

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

-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.

srcToPopperIO :: Source IO ByteString -> L.GivesPopper ()
srcToPopperIO src f = do
  (rsrc0, ()) <- src $$+ return ()
  irsrc <- newIORef rsrc0
  let popper :: IO ByteString
      popper = do
        rsrc <- readIORef irsrc
        (rsrc', mres) <- rsrc $$++ await
        writeIORef irsrc rsrc'
        case mres of
          Nothing -> return B.empty
          Just bs
              | B.null bs -> popper
              | otherwise -> return bs
  f popper

-- | This is taken from "Network.HTTP.Client.Conduit" without modifications.

bodyReaderSource :: MonadIO m => L.BodyReader -> C.Producer m ByteString
bodyReaderSource br = go
  where
    go = do
      bs <- liftIO (L.brRead br)
      unless (B.null bs) $ do
        yield bs
        go