{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
--
-- = Simpler API
--
-- The API below is rather low-level. The "Network.HTTP.Simple" module provides
-- a higher-level API with built-in support for things like JSON request and
-- response bodies. For most users, this will be an easier place to start. You
-- can read the tutorial at:
--
-- <https://haskell-lang.org/library/http-client>
--
-- = Lower-level API
--
-- This module contains everything you need to initiate HTTP connections.  If
-- you want a simple interface based on URLs, you can use 'simpleHttp'. If you
-- want raw power, 'http' is the underlying workhorse of this package. Some
-- examples:
--
-- > -- Just download an HTML document and print it.
-- > import Network.HTTP.Conduit
-- > import qualified Data.ByteString.Lazy as L
-- >
-- > main = simpleHttp "http://www.haskell.org/" >>= L.putStr
--
-- This example uses interleaved IO to write the response body to a file in
-- constant memory space.
--
-- > import Data.Conduit.Binary (sinkFile) -- Exported from the package conduit-extra
-- > import Network.HTTP.Conduit
-- > import Conduit (runConduit, (.|))
-- > import Control.Monad.Trans.Resource (runResourceT)
-- >
-- > main :: IO ()
-- > main = do
-- >      request <- parseRequest "http://google.com/"
-- >      manager <- newManager tlsManagerSettings
-- >      runResourceT $ do
-- >          response <- http request manager
-- >          runConduit $ responseBody response .| sinkFile "google.html"
--
-- The following headers are automatically set by this module, and should not
-- be added to 'requestHeaders':
--
-- * Cookie
--
-- * Content-Length
--
-- * Transfer-Encoding
--
-- Note: In previous versions, the Host header would be set by this module in
-- all cases. Starting from 1.6.1, if a Host header is present in
-- @requestHeaders@, it will be used in place of the header this module would
-- have generated. This can be useful for calling a server which utilizes
-- virtual hosting.
--
-- Use `cookieJar` If you want to supply cookies with your request:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > import Network.HTTP.Conduit
-- > import Network
-- > import Data.Time.Clock
-- > import Data.Time.Calendar
-- > import qualified Control.Exception as E
-- > import Network.HTTP.Types.Status (statusCode)
-- >
-- > past :: UTCTime
-- > past = UTCTime (ModifiedJulianDay 56200) (secondsToDiffTime 0)
-- >
-- > future :: UTCTime
-- > future = UTCTime (ModifiedJulianDay 562000) (secondsToDiffTime 0)
-- >
-- > cookie :: Cookie
-- > cookie = Cookie { cookie_name = "password_hash"
-- >                 , cookie_value = "abf472c35f8297fbcabf2911230001234fd2"
-- >                 , cookie_expiry_time = future
-- >                 , cookie_domain = "example.com"
-- >                 , cookie_path = "/"
-- >                 , cookie_creation_time = past
-- >                 , cookie_last_access_time = past
-- >                 , cookie_persistent = False
-- >                 , cookie_host_only = False
-- >                 , cookie_secure_only = False
-- >                 , cookie_http_only = False
-- >                 }
-- >
-- > main = do
-- >      request' <- parseRequest "http://example.com/secret-page"
-- >      manager <- newManager tlsManagerSettings
-- >      let request = request' { cookieJar = Just $ createCookieJar [cookie] }
-- >      fmap Just (httpLbs request manager) `E.catch`
-- >              (\ex -> case ex of
-- >                  HttpExceptionRequest _ (StatusCodeException res _) ->
-- >                      if statusCode (responseStatus res) == 403
-- >                        then (putStrLn "login failed" >> return Nothing)
-- >                        else return Nothing
-- >                  _ -> E.throw ex)
--
-- Cookies are implemented according to RFC 6265.
--
-- Note that by default, the functions in this package will throw exceptions
-- for non-2xx status codes. If you would like to avoid this, you should use
-- 'checkStatus', e.g.:
--
-- > import Data.Conduit.Binary (sinkFile)
-- > import Network.HTTP.Conduit
-- > import qualified Data.Conduit as C
-- > import Network
-- >
-- > main :: IO ()
-- > main = do
-- >      request' <- parseRequest "http://www.yesodweb.com/does-not-exist"
-- >      let request = request' { checkStatus = \_ _ _ -> Nothing }
-- >      manager <- newManager tlsManagerSettings
-- >      res <- httpLbs request manager
-- >      print res
--
-- By default, when connecting to websites using HTTPS, functions in this
-- package will throw an exception if the TLS certificate doesn't validate. To
-- continue the HTTPS transaction even if the TLS cerficate validation fails,
-- you should use 'mkManagerSetttings' as follows:
--
-- > import Network.Connection (TLSSettings (..))
-- > import Network.HTTP.Conduit
-- >
-- > main :: IO ()
-- > main = do
-- >     request <- parseRequest "https://github.com/"
-- >     let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing
-- >     manager <- newManager settings
-- >     res <- httpLbs request manager
-- >     print res
--
-- For more information, please be sure to read the documentation in the
-- "Network.HTTP.Client" module.

module Network.HTTP.Conduit
    ( -- * Perform a request
      simpleHttp
    , httpLbs
    , http
      -- * Datatypes
    , Proxy (..)
    , RequestBody (..)
      -- ** Request
    , 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
      -- *** Request body
    , requestBodySource
    , requestBodySourceChunked
    , requestBodySourceIO
    , requestBodySourceChunkedIO
      -- * Response
    , Response
    , responseStatus
    , responseVersion
    , responseHeaders
    , responseBody
    , responseCookieJar
      -- * Manager
    , Manager
    , newManager
    , closeManager
      -- ** Settings
    , ManagerSettings
    , tlsManagerSettings
    , mkManagerSettings
    , managerConnCount
    , managerResponseTimeout
    , managerTlsConnection
      -- ** Response timeout
    , HC.ResponseTimeout
    , HC.responseTimeoutMicro
    , HC.responseTimeoutNone
    , HC.responseTimeoutDefault
      -- * Cookies
    , Cookie(..)
    , CookieJar
    , createCookieJar
    , destroyCookieJar
      -- * Utility functions
    , parseUrl
    , parseUrlThrow
    , parseRequest
    , parseRequest_
    , defaultRequest
    , applyBasicAuth
    , addProxy
    , lbsResponse
    , getRedirectedRequest
      -- * Decompression predicates
    , alwaysDecompress
    , browserDecompress
      -- * Request bodies
      -- | "Network.HTTP.Client.MultipartFormData" provides an API for building
      -- form-data request bodies.
    , urlEncodedBody
      -- * Exceptions
    , 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, responseClose)
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 (addProxy, alwaysDecompress,
                                               browserDecompress)
import           Network.HTTP.Client.Internal (getRedirectedRequest)
import           Network.HTTP.Client.TLS      (mkManagerSettings,
                                               tlsManagerSettings)
import           Network.HTTP.Client.Internal (Cookie (..), CookieJar (..),
                                               HttpException (..), Proxy (..),
                                               Request (..), RequestBody (..),
                                               Response (..))

-- | Download the specified 'Request', returning the results as a 'Response'.
--
-- This is a simplified version of 'http' for the common case where you simply
-- want the response data as a simple datatype. If you want more power, such as
-- interleaved actions on the response body during download, you'll need to use
-- 'http' directly. This function is defined as:
--
-- @httpLbs = 'lbsResponse' <=< 'http'@
--
-- Even though the 'Response' contains a lazy bytestring, this
-- function does /not/ utilize lazy I/O, and therefore the entire
-- response body will live in memory. If you want constant memory
-- usage, you'll need to use @conduit@ packages's
-- 'C.Source' returned by 'http'.
--
-- This function will 'throwIO' an 'HttpException' for any
-- response with a non-2xx status code (besides 3xx redirects up
-- to a limit of 10 redirects). This behavior can be modified by
-- changing the 'checkStatus' field of your request.
--
-- Note: Unlike previous versions, this function will perform redirects, as
-- specified by the 'redirectCount' setting.
httpLbs :: MonadIO m => Request -> Manager -> m (Response L.ByteString)
httpLbs :: Request -> Manager -> m (Response ByteString)
httpLbs Request
r Manager
m = IO (Response ByteString) -> m (Response ByteString)
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

-- | Download the specified URL, following any redirects, and
-- return the response body.
--
-- This function will 'throwIO' an 'HttpException' for any
-- response with a non-2xx status code (besides 3xx redirects up
-- to a limit of 10 redirects). It uses 'parseUrlThrow' to parse the
-- input. This function essentially wraps 'httpLbs'.
--
-- Note: Even though this function returns a lazy bytestring, it
-- does /not/ utilize lazy I/O, and therefore the entire response
-- body will live in memory. If you want constant memory usage,
-- you'll need to use the @conduit@ package and 'http' directly.
--
-- Note: This function creates a new 'Manager'. It should be avoided
-- in production code.
simpleHttp :: MonadIO m => String -> m L.ByteString
simpleHttp :: String -> m ByteString
simpleHttp String
url = IO ByteString -> m ByteString
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
    Manager
man <- ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings
    Request
req <- IO Request -> IO Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> IO Request) -> IO Request -> IO Request
forall a b. (a -> b) -> a -> b
$ String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url
    Response ByteString -> ByteString
forall body. Response body -> body
responseBody (Response ByteString -> ByteString)
-> IO (Response ByteString) -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
A.<$> Request -> Manager -> IO (Response ByteString)
forall (m :: * -> *).
MonadIO m =>
Request -> Manager -> m (Response ByteString)
httpLbs (Request -> Request
setConnectionClose Request
req) Manager
man

setConnectionClose :: Request -> Request
setConnectionClose :: Request -> Request
setConnectionClose Request
req = Request
req{requestHeaders :: RequestHeaders
requestHeaders = (HeaderName
"Connection", ByteString
"close") (HeaderName, ByteString) -> RequestHeaders -> RequestHeaders
forall a. a -> [a] -> [a]
: Request -> RequestHeaders
requestHeaders Request
req}

lbsResponse :: Monad m
            => Response (ConduitM () S.ByteString m ())
            -> m (Response L.ByteString)
lbsResponse :: Response (ConduitM () ByteString m ()) -> m (Response ByteString)
lbsResponse Response (ConduitM () ByteString m ())
res = do
    [ByteString]
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 ()
-> ConduitM ByteString Void m [ByteString]
-> ConduitT () Void m [ByteString]
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| ConduitM ByteString Void m [ByteString]
forall (m :: * -> *) a o. Monad m => ConduitT a o m [a]
CL.consume
    Response ByteString -> m (Response ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return Response (ConduitM () ByteString m ())
res
        { responseBody :: ByteString
responseBody = [ByteString] -> ByteString
L.fromChunks [ByteString]
bss
        }

http :: MonadResource m
     => Request
     -> Manager
     -> m (Response (ConduitM i S.ByteString m ()))
http :: Request -> Manager -> m (Response (ConduitM i ByteString m ()))
http Request
req Manager
man = do
    (ReleaseKey
key, Response BodyReader
res) <- IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> m (ReleaseKey, Response BodyReader)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Request -> Manager -> IO (Response BodyReader)
Client.responseOpen Request
req Manager
man) Response BodyReader -> IO ()
forall a. Response a -> IO ()
Client.responseClose
    Response (ConduitM i ByteString m ())
-> m (Response (ConduitM i ByteString m ()))
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
res { responseBody :: ConduitM i ByteString m ()
responseBody = do
                   BodyReader -> ConduitM i ByteString m ()
forall (m :: * -> *) i.
MonadIO m =>
BodyReader -> ConduitM i ByteString m ()
HCC.bodyReaderSource (BodyReader -> ConduitM i ByteString m ())
-> BodyReader -> ConduitM i ByteString m ()
forall a b. (a -> b) -> a -> b
$ Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody Response BodyReader
res
                   ReleaseKey -> ConduitM i ByteString m ()
forall (m :: * -> *). MonadIO m => ReleaseKey -> m ()
release ReleaseKey
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
    (SealedConduitT () ByteString (ResourceT IO) ()
rsrc0, ()) <- ConduitM () ByteString (ResourceT IO) ()
src ConduitM () ByteString (ResourceT IO) ()
-> Sink ByteString (ResourceT IO) ()
-> ResourceT
     IO (SealedConduitT () ByteString (ResourceT IO) (), ())
forall (m :: * -> *) a b.
Monad m =>
Source m a -> Sink a m b -> m (SealedConduitT () a m (), b)
$$+ () -> Sink ByteString (ResourceT IO) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IORef (SealedConduitT () ByteString (ResourceT IO) ())
irsrc <- IO (IORef (SealedConduitT () ByteString (ResourceT IO) ()))
-> ResourceT
     IO (IORef (SealedConduitT () ByteString (ResourceT IO) ()))
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (SealedConduitT () ByteString (ResourceT IO) ()))
 -> ResourceT
      IO (IORef (SealedConduitT () ByteString (ResourceT IO) ())))
-> IO (IORef (SealedConduitT () ByteString (ResourceT IO) ()))
-> ResourceT
     IO (IORef (SealedConduitT () ByteString (ResourceT IO) ()))
forall a b. (a -> b) -> a -> b
$ SealedConduitT () ByteString (ResourceT IO) ()
-> IO (IORef (SealedConduitT () ByteString (ResourceT IO) ()))
forall a. a -> IO (IORef a)
newIORef SealedConduitT () ByteString (ResourceT IO) ()
rsrc0
    InternalState
is <- ResourceT IO InternalState
forall (m :: * -> *). Monad m => ResourceT m InternalState
getInternalState
    let popper :: IO S.ByteString
        popper :: BodyReader
popper = do
            SealedConduitT () ByteString (ResourceT IO) ()
rsrc <- IORef (SealedConduitT () ByteString (ResourceT IO) ())
-> IO (SealedConduitT () ByteString (ResourceT IO) ())
forall a. IORef a -> IO a
readIORef IORef (SealedConduitT () ByteString (ResourceT IO) ())
irsrc
            (SealedConduitT () ByteString (ResourceT IO) ()
rsrc', Maybe ByteString
mres) <- ResourceT
  IO
  (SealedConduitT () ByteString (ResourceT IO) (), Maybe ByteString)
-> InternalState
-> IO
     (SealedConduitT () ByteString (ResourceT IO) (), Maybe ByteString)
forall (m :: * -> *) a. ResourceT m a -> InternalState -> m a
runInternalState (SealedConduitT () ByteString (ResourceT IO) ()
rsrc SealedConduitT () ByteString (ResourceT IO) ()
-> Sink ByteString (ResourceT IO) (Maybe ByteString)
-> ResourceT
     IO
     (SealedConduitT () ByteString (ResourceT IO) (), Maybe ByteString)
forall (m :: * -> *) a b.
Monad m =>
SealedConduitT () a m ()
-> Sink a m b -> m (SealedConduitT () a m (), b)
$$++ Sink ByteString (ResourceT IO) (Maybe ByteString)
forall (m :: * -> *) i. Monad m => Consumer i m (Maybe i)
await) InternalState
is
            IORef (SealedConduitT () ByteString (ResourceT IO) ())
-> SealedConduitT () ByteString (ResourceT IO) () -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (SealedConduitT () ByteString (ResourceT IO) ())
irsrc SealedConduitT () ByteString (ResourceT IO) ()
rsrc'
            case Maybe ByteString
mres of
                Maybe ByteString
Nothing -> ByteString -> BodyReader
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 (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
    IO () -> ResourceT IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ResourceT IO ()) -> IO () -> ResourceT IO ()
forall a b. (a -> b) -> a -> b
$ NeedsPopper ()
f BodyReader
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