req-conduit-1.0.2: Conduit helpers for the req HTTP client library
Copyright© 2016–present Mark Karpov Michael Snoyman
LicenseBSD 3 clause
MaintainerMark Karpov <markkarpov92@gmail.com>
Stabilityexperimental
Portabilityportable
Safe HaskellSafe-Inferred
LanguageGHC2021

Network.HTTP.Req.Conduit

Description

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.

Synopsis

Streaming request bodies

data ReqBodySource Source #

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.

Constructors

ReqBodySource Int64 (ConduitT () ByteString IO ()) 

Streaming response bodies

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.

responseBodySource Source #

Arguments

:: MonadIO m 
=> Response BodyReader

Response with body reader

-> ConduitT i ByteString m ()

Response body as a Producer

Turn Response BodyReader into a producer.

Since: 1.0.0