{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Conduit
(
simpleHttp
, httpLbs
, http
, Proxy (..)
, RequestBody (..)
, Request
, method
, secure
, host
, port
, path
, queryString
, requestHeaders
, requestBody
, proxy
, hostAddress
, rawBody
, decompress
, redirectCount
#if MIN_VERSION_http_client(0,6,2)
, shouldStripHeaderOnRedirect
#endif
, checkResponse
, responseTimeout
, cookieJar
, requestVersion
, HCC.setQueryString
, requestBodySource
, requestBodySourceChunked
, requestBodySourceIO
, requestBodySourceChunkedIO
, Response
, responseStatus
, responseVersion
, responseHeaders
, responseBody
, responseCookieJar
, responseEarlyHints
, Manager
, newManager
, closeManager
, ManagerSettings
, tlsManagerSettings
, mkManagerSettings
, managerConnCount
, managerResponseTimeout
, managerTlsConnection
, HC.ResponseTimeout
, HC.responseTimeoutMicro
, HC.responseTimeoutNone
, HC.responseTimeoutDefault
, Cookie(..)
, CookieJar
, createCookieJar
, destroyCookieJar
, parseUrl
, parseUrlThrow
, parseRequest
, parseRequest_
, defaultRequest
, applyBasicAuth
, addProxy
, lbsResponse
, getRedirectedRequest
, alwaysDecompress
, browserDecompress
, urlEncodedBody
, HttpException (..)
, HCC.HttpExceptionContent (..)
) where
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
import Data.Conduit
import qualified Data.Conduit.List as CL
import Data.IORef (readIORef, writeIORef, newIORef)
import Data.Int (Int64)
import Control.Applicative as A ((<$>))
import Control.Monad.IO.Unlift (MonadIO (liftIO))
import Control.Monad.Trans.Resource
import qualified Network.HTTP.Client as Client (httpLbs, responseOpen)
import qualified Network.HTTP.Client as HC
import qualified Network.HTTP.Client.Conduit as HCC
import Network.HTTP.Client.Internal (createCookieJar,
destroyCookieJar)
import Network.HTTP.Client.Internal (Manager, ManagerSettings,
closeManager, managerConnCount,
managerResponseTimeout,
managerTlsConnection, newManager)
import Network.HTTP.Client (parseUrl, parseUrlThrow, urlEncodedBody, applyBasicAuth,
defaultRequest, parseRequest, parseRequest_)
import Network.HTTP.Client.Internal (ResponseClose (..), addProxy, alwaysDecompress,
browserDecompress, getRedirectedRequest)
import Network.HTTP.Client.TLS (mkManagerSettings,
tlsManagerSettings)
import Network.HTTP.Client.Internal (Cookie (..), CookieJar (..),
HttpException (..), Proxy (..),
Request (..), RequestBody (..),
Response (..))
httpLbs :: MonadIO m => Request -> Manager -> m (Response L.ByteString)
httpLbs :: forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs Request
r Manager
m = IO (Response ByteString) -> m (Response ByteString)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response ByteString) -> m (Response ByteString))
-> IO (Response ByteString) -> m (Response ByteString)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response ByteString)
Client.httpLbs Request
r Manager
m
simpleHttp :: MonadIO m => String -> m L.ByteString
simpleHttp :: forall (m :: * -> *). MonadIO m => String -> m ByteString
simpleHttp String
url = IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
man <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
req <- liftIO $ parseUrlThrow url
responseBody A.<$> httpLbs (setConnectionClose req) man
setConnectionClose :: Request -> Request
setConnectionClose :: Request -> Request
setConnectionClose Request
req = Request
req{requestHeaders = ("Connection", "close") : requestHeaders req}
lbsResponse :: Monad m
=> Response (ConduitM () S.ByteString m ())
-> m (Response L.ByteString)
lbsResponse :: forall (m :: * -> *).
Monad m =>
Response (ConduitM () ByteString m ()) -> m (Response ByteString)
lbsResponse Response (ConduitM () ByteString m ())
res = do
bss <- ConduitT () Void m [ByteString] -> m [ByteString]
forall (m :: * -> *) r. Monad m => ConduitT () Void m r -> m r
runConduit (ConduitT () Void m [ByteString] -> m [ByteString])
-> ConduitT () Void m [ByteString] -> m [ByteString]
forall a b. (a -> b) -> a -> b
$ Response (ConduitM () ByteString m ())
-> ConduitM () ByteString m ()
forall body. Response body -> body
responseBody Response (ConduitM () ByteString m ())
res ConduitM () ByteString m ()
-> ConduitT ByteString Void m [ByteString]
-> ConduitT () Void m [ByteString]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitT a b m () -> ConduitT b c m r -> ConduitT a c m r
.| ConduitT ByteString Void m [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
return res
{ responseBody = L.fromChunks bss
}
http :: MonadResource m
=> Request
-> Manager
-> m (Response (ConduitM i S.ByteString m ()))
http :: forall (m :: * -> *) i.
MonadResource m =>
Request -> Manager -> m (Response (ConduitM i ByteString m ()))
http Request
req Manager
man = ((forall a. ResourceT IO a -> ResourceT IO a)
-> ResourceT IO (Response (ConduitM i ByteString m ())))
-> m (Response (ConduitM i ByteString m ()))
forall (m :: * -> *) b.
MonadResource m =>
((forall a. ResourceT IO a -> ResourceT IO a) -> ResourceT IO b)
-> m b
resourceMask (((forall a. ResourceT IO a -> ResourceT IO a)
-> ResourceT IO (Response (ConduitM i ByteString m ())))
-> m (Response (ConduitM i ByteString m ())))
-> ((forall a. ResourceT IO a -> ResourceT IO a)
-> ResourceT IO (Response (ConduitM i ByteString m ())))
-> m (Response (ConduitM i ByteString m ()))
forall a b. (a -> b) -> a -> b
$ \forall a. ResourceT IO a -> ResourceT IO a
_ -> do
res <- IO (Response BodyReader) -> ResourceT IO (Response BodyReader)
forall a. IO a -> ResourceT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Response BodyReader) -> ResourceT IO (Response BodyReader))
-> IO (Response BodyReader) -> ResourceT IO (Response BodyReader)
forall a b. (a -> b) -> a -> b
$ Request -> Manager -> IO (Response BodyReader)
Client.responseOpen Request
req Manager
man
let ResponseClose cleanup = responseClose' res
key <- register cleanup
pure res { responseClose' = ResponseClose $ release key
, responseBody = do
HCC.bodyReaderSource $ responseBody res
release key
}
requestBodySource :: Int64 -> ConduitM () S.ByteString (ResourceT IO) () -> RequestBody
requestBodySource :: Int64 -> ConduitM () ByteString (ResourceT IO) () -> RequestBody
requestBodySource Int64
size = Int64 -> GivesPopper () -> RequestBody
RequestBodyStream Int64
size (GivesPopper () -> RequestBody)
-> (ConduitM () ByteString (ResourceT IO) () -> GivesPopper ())
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM () ByteString (ResourceT IO) () -> GivesPopper ()
srcToPopper
requestBodySourceChunked :: ConduitM () S.ByteString (ResourceT IO) () -> RequestBody
requestBodySourceChunked :: ConduitM () ByteString (ResourceT IO) () -> RequestBody
requestBodySourceChunked = GivesPopper () -> RequestBody
RequestBodyStreamChunked (GivesPopper () -> RequestBody)
-> (ConduitM () ByteString (ResourceT IO) () -> GivesPopper ())
-> ConduitM () ByteString (ResourceT IO) ()
-> RequestBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConduitM () ByteString (ResourceT IO) () -> GivesPopper ()
srcToPopper
srcToPopper :: ConduitM () S.ByteString (ResourceT IO) () -> HCC.GivesPopper ()
srcToPopper :: ConduitM () ByteString (ResourceT IO) () -> GivesPopper ()
srcToPopper ConduitM () ByteString (ResourceT IO) ()
src NeedsPopper ()
f = ResourceT IO () -> IO ()
forall (m :: * -> *) a. MonadUnliftIO m => ResourceT m a -> m a
runResourceT (ResourceT IO () -> IO ()) -> ResourceT IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
(rsrc0, ()) <- ConduitM () ByteString (ResourceT IO) ()
src ConduitM () ByteString (ResourceT IO) ()
-> ConduitT ByteString Void (ResourceT IO) ()
-> ResourceT
IO (SealedConduitT () ByteString (ResourceT IO) (), ())
forall (m :: * -> *) a b.
Monad m =>
ConduitT () a m ()
-> ConduitT a Void m b -> m (SealedConduitT () a m (), b)
$$+ () -> ConduitT ByteString Void (ResourceT IO) ()
forall a. a -> ConduitT ByteString Void (ResourceT IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
irsrc <- liftIO $ newIORef rsrc0
is <- getInternalState
let popper :: IO S.ByteString
popper = do
rsrc <- IORef (SealedConduitT () ByteString (ResourceT IO) ())
-> IO (SealedConduitT () ByteString (ResourceT IO) ())
forall a. IORef a -> IO a
readIORef IORef (SealedConduitT () ByteString (ResourceT IO) ())
irsrc
(rsrc', mres) <- runInternalState (rsrc $$++ await) is
writeIORef irsrc rsrc'
case mres of
Maybe ByteString
Nothing -> ByteString -> BodyReader
forall a. a -> IO a
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 -> ByteString -> BodyReader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
liftIO $ f popper
requestBodySourceIO :: Int64 -> ConduitM () S.ByteString IO () -> RequestBody
requestBodySourceIO :: Int64 -> ConduitM () ByteString IO () -> RequestBody
requestBodySourceIO = Int64 -> ConduitM () ByteString IO () -> RequestBody
HCC.requestBodySource
requestBodySourceChunkedIO :: ConduitM () S.ByteString IO () -> RequestBody
requestBodySourceChunkedIO :: ConduitM () ByteString IO () -> RequestBody
requestBodySourceChunkedIO = ConduitM () ByteString IO () -> RequestBody
HCC.requestBodySourceChunked