content: -- | This module provides functionality for running the 'Hreq' monad as a Streaming HTTP client and necessary
  -- class instances.
  --
  {-# LANGUAGE AllowAmbiguousTypes #-}
  module Hreq.Conduit.Internal.HTTP
    ( Hreq (..)
    , ResBodyStream (..)
    , RunConduitClient
    , RunClient
    -- * Run Hreq client
    , runHreq
    , runHreqWithConfig
    , createDefConfig
    -- * Create Streaming Hreq Client
    , hreqWithConduit
    ) where
  import Control.Monad (unless)
  import Control.Monad.Catch (throwM)
  import Control.Monad.IO.Class (MonadIO (..))
  import Control.Monad.IO.Unlift (MonadUnliftIO (..), wrappedWithRunInIO)
  import Control.Monad.Reader (MonadReader, MonadTrans, ReaderT (..), ask)
  import Control.Retry (retrying)
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as B
  import qualified Data.ByteString.Lazy as LBS
  import Data.Conduit
  import Data.Either (isLeft)
  import Data.Proxy (Proxy (..))
  import qualified Network.HTTP.Client as HTTP
  import Network.HTTP.Types (statusCode)
  
  import Hreq.Client.Internal.Config (HttpConfig (..), StatusRange (..), createDefConfig)
  import Hreq.Client.Internal.HTTP (catchConnectionError, checkHttpResponse, httpResponsetoResponse,
                                    requestToHTTPRequest, runHttpClient)
  import Hreq.Core.Client (BaseUrl (..), ClientError (..), HasRequest (..), HasStreamingClient,
                           Request, RunClient (..), RunStreamingClient (..), hreqStream)
  
  
  newtype Hreq m a = Hreq { runHreq' :: ReaderT HttpConfig m a }
    deriving (Functor, Applicative, Monad, MonadReader HttpConfig, MonadTrans, MonadIO)
  
  type StreamConduit = forall m. MonadIO m => ConduitT () ByteString m ()
  
  newtype ResBodyStream = ResBodyStream StreamConduit
  
  type RunConduitClient m = RunStreamingClient m ResBodyStream
  
  instance MonadUnliftIO m => MonadUnliftIO (Hreq m) where
    withRunInIO = wrappedWithRunInIO Hreq runHreq'
  
  instance RunClient (Hreq IO) where
    runClient = runHttpClient
  
    throwHttpError = Hreq . throwM
  
    checkResponse = checkHttpResponse
  
  instance RunStreamingClient (Hreq IO) ResBodyStream where
    withStreamingClient = runStreamingHttp
  
  runHreq :: MonadIO m => BaseUrl -> Hreq m a -> m a
  runHreq baseUrl action = do
    config <- liftIO $ createDefConfig baseUrl
  
    runHreqWithConfig config action
  
  runHreqWithConfig :: HttpConfig -> Hreq m a -> m a
  runHreqWithConfig config action = runReaderT (runHreq' action) config
  
  runStreamingHttp
    :: forall m r. (MonadReader HttpConfig m, MonadIO m, RunClient m)
    => Request
    -> (ResBodyStream -> IO r)
    -> m r
  runStreamingHttp req f = do
      config <- ask
      let manager = httpManager config
      let baseUrl = httpBaseUrl config
      let statusRange = httpStatuses config
  
      let httpRequest = requestToHTTPRequest baseUrl req
  
      let action = liftIO $ catchConnectionError $ HTTP.withResponse httpRequest manager $ \res -> do
                      checkStreamResponse res statusRange
                      f (ResBodyStream $ bodyReaderSource (HTTP.responseBody res))
  
      eRes <- retrying (httpRetryPolicy config) (const (return . isLeft)) (const action)
      either throwHttpError pure eRes
      where
        -- | Throws a failure error on in-correct HTTP status code.
        checkStreamResponse :: HTTP.Response HTTP.BodyReader -> StatusRange -> IO ()
        checkStreamResponse res statusRange = do
          let status = HTTP.responseStatus res
              code = statusCode status
          if code >= statusLower statusRange && code <= statusUpper statusRange
            then do
              bs <- LBS.fromChunks <$> HTTP.brConsume (HTTP.responseBody res)
              throwM $ FailureResponse req (httpResponsetoResponse (const bs) res)
            else pure ()
  
  -- | Streaming HTTP response with Conduit.
  --
  -- The required constraints are represented by the 'Hreq.Core.Client.Internal.HasStreamingClient' constraint.
  --
  hreqWithConduit
    :: forall api ts v m. (HasStreamingClient api ResBodyStream ts v m )
    => HttpInput ts
    -> (StreamConduit -> IO ())
    -> m ()
  hreqWithConduit input f =
    hreqStream (Proxy @api) input $ \ (ResBodyStream conduit) -> f conduit
  
  bodyReaderSource :: MonadIO m => HTTP.BodyReader -> ConduitT i ByteString m ()
  bodyReaderSource br = go
    where
      go = do
        bs <- liftIO (HTTP.brRead br)
        unless (B.null bs) $ do
          yield bs
          go
  