{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Network.HTTP.Client.Manager
    ( ManagerSettings (..)
    , newManager
    , closeManager
    , withManager
    , getConn
    , defaultManagerSettings
    , rawConnectionModifySocket
    , rawConnectionModifySocketSize
    , proxyFromRequest
    , noProxy
    , useProxy
    , proxyEnvironment
    , proxyEnvironmentNamed
    , defaultProxy
    , dropProxyAuthSecure
    , useProxySecureWithoutConnect
    ) where

import qualified Data.ByteString.Char8 as S8

import Data.Text (Text)

import Control.Monad (unless)
import Control.Exception (throwIO, fromException, IOException, Exception (..), handle)

import qualified Network.Socket as NS

import Network.HTTP.Types (status200)
import Network.HTTP.Client.Types
import Network.HTTP.Client.Connection
import Network.HTTP.Client.Headers (parseStatusHeaders)
import Network.HTTP.Proxy
import Data.KeyedPool
import Data.Maybe (isJust)

-- | A value for the @managerRawConnection@ setting, but also allows you to
-- modify the underlying @Socket@ to set additional settings. For a motivating
-- use case, see: <https://github.com/snoyberg/http-client/issues/71>.
--
-- Since 0.3.8
rawConnectionModifySocket :: (NS.Socket -> IO ())
                          -> IO (Maybe NS.HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocket :: (Socket -> IO ())
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocket = (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> String -> Int -> IO Connection)
 -> IO (Maybe HostAddress -> String -> Int -> IO Connection))
-> ((Socket -> IO ())
    -> Maybe HostAddress -> String -> Int -> IO Connection)
-> (Socket -> IO ())
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO ())
-> Maybe HostAddress -> String -> Int -> IO Connection
openSocketConnection

-- | Same as @rawConnectionModifySocket@, but also takes in a chunk size.
--
-- @since 0.5.2
rawConnectionModifySocketSize :: (NS.Socket -> IO ())
                              -> IO (Int -> Maybe NS.HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocketSize :: (Socket -> IO ())
-> IO (Int -> Maybe HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocketSize = (Int -> Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Int -> Maybe HostAddress -> String -> Int -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Int -> Maybe HostAddress -> String -> Int -> IO Connection)
 -> IO (Int -> Maybe HostAddress -> String -> Int -> IO Connection))
-> ((Socket -> IO ())
    -> Int -> Maybe HostAddress -> String -> Int -> IO Connection)
-> (Socket -> IO ())
-> IO (Int -> Maybe HostAddress -> String -> Int -> IO Connection)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO ())
-> Int -> Maybe HostAddress -> String -> Int -> IO Connection
openSocketConnectionSize


-- | Default value for @ManagerSettings@.
--
-- Note that this value does /not/ have support for SSL/TLS. If you need to
-- make any https connections, please use the http-client-tls package, which
-- provides a @tlsManagerSettings@ value.
--
-- Since 0.1.0
defaultManagerSettings :: ManagerSettings
defaultManagerSettings :: ManagerSettings
defaultManagerSettings = ManagerSettings
    { managerConnCount :: Int
managerConnCount = Int
10
    , managerRawConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerRawConnection = (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> String -> Int -> IO Connection)
 -> IO (Maybe HostAddress -> String -> Int -> IO Connection))
-> (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a b. (a -> b) -> a -> b
$ (Socket -> IO ())
-> Maybe HostAddress -> String -> Int -> IO Connection
openSocketConnection (IO () -> Socket -> IO ()
forall a b. a -> b -> a
const (IO () -> Socket -> IO ()) -> IO () -> Socket -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())
    , managerTlsConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerTlsConnection = (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe HostAddress -> String -> Int -> IO Connection)
 -> IO (Maybe HostAddress -> String -> Int -> IO Connection))
-> (Maybe HostAddress -> String -> Int -> IO Connection)
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
forall a b. (a -> b) -> a -> b
$ \Maybe HostAddress
_ String
_ Int
_ -> HttpExceptionContent -> IO Connection
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
TlsNotSupported
    , managerTlsProxyConnection :: IO
  (ByteString
   -> (Connection -> IO ())
   -> String
   -> Maybe HostAddress
   -> String
   -> Int
   -> IO Connection)
managerTlsProxyConnection = (ByteString
 -> (Connection -> IO ())
 -> String
 -> Maybe HostAddress
 -> String
 -> Int
 -> IO Connection)
-> IO
     (ByteString
      -> (Connection -> IO ())
      -> String
      -> Maybe HostAddress
      -> String
      -> Int
      -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString
  -> (Connection -> IO ())
  -> String
  -> Maybe HostAddress
  -> String
  -> Int
  -> IO Connection)
 -> IO
      (ByteString
       -> (Connection -> IO ())
       -> String
       -> Maybe HostAddress
       -> String
       -> Int
       -> IO Connection))
-> (ByteString
    -> (Connection -> IO ())
    -> String
    -> Maybe HostAddress
    -> String
    -> Int
    -> IO Connection)
-> IO
     (ByteString
      -> (Connection -> IO ())
      -> String
      -> Maybe HostAddress
      -> String
      -> Int
      -> IO Connection)
forall a b. (a -> b) -> a -> b
$ \ByteString
_ Connection -> IO ()
_ String
_ Maybe HostAddress
_ String
_ Int
_ -> HttpExceptionContent -> IO Connection
forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
TlsNotSupported
    , managerResponseTimeout :: ResponseTimeout
managerResponseTimeout = ResponseTimeout
ResponseTimeoutDefault
    , managerRetryableException :: SomeException -> Bool
managerRetryableException = \SomeException
e ->
        case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
            Just (IOException
_ :: IOException) -> Bool
True
            Maybe IOException
_ ->
                case (HttpExceptionContentWrapper -> HttpExceptionContent)
-> Maybe HttpExceptionContentWrapper -> Maybe HttpExceptionContent
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HttpExceptionContentWrapper -> HttpExceptionContent
unHttpExceptionContentWrapper (Maybe HttpExceptionContentWrapper -> Maybe HttpExceptionContent)
-> Maybe HttpExceptionContentWrapper -> Maybe HttpExceptionContent
forall a b. (a -> b) -> a -> b
$ SomeException -> Maybe HttpExceptionContentWrapper
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
                    -- Note: Some servers will timeout connections by accepting
                    -- the incoming packets for the new request, but closing
                    -- the connection as soon as we try to read. To make sure
                    -- we open a new connection under these circumstances, we
                    -- check for the NoResponseDataReceived exception.
                    Just HttpExceptionContent
NoResponseDataReceived -> Bool
True
                    Just HttpExceptionContent
IncompleteHeaders -> Bool
True
                    Maybe HttpExceptionContent
_ -> Bool
False
    , managerWrapException :: forall a. Request -> IO a -> IO a
managerWrapException = \Request
_req ->
        let wrapper :: SomeException -> IO a
wrapper SomeException
se =
                case SomeException -> Maybe IOException
forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
                    Just (IOException
_ :: IOException) -> HttpExceptionContent -> IO a
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO a) -> HttpExceptionContent -> IO a
forall a b. (a -> b) -> a -> b
$ SomeException -> HttpExceptionContent
InternalException SomeException
se
                    Maybe IOException
Nothing -> SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
se
         in (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO a
forall {a}. SomeException -> IO a
wrapper
    , managerIdleConnectionCount :: Int
managerIdleConnectionCount = Int
512
    , managerModifyRequest :: Request -> IO Request
managerModifyRequest = Request -> IO Request
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    , managerModifyResponse :: Response BodyReader -> IO (Response BodyReader)
managerModifyResponse = Response BodyReader -> IO (Response BodyReader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    , managerProxyInsecure :: ProxyOverride
managerProxyInsecure = ProxyOverride
defaultProxy
    , managerProxySecure :: ProxyOverride
managerProxySecure = ProxyOverride
defaultProxy
    , managerMaxHeaderLength :: Maybe MaxHeaderLength
managerMaxHeaderLength = MaxHeaderLength -> Maybe MaxHeaderLength
forall a. a -> Maybe a
Just (MaxHeaderLength -> Maybe MaxHeaderLength)
-> MaxHeaderLength -> Maybe MaxHeaderLength
forall a b. (a -> b) -> a -> b
$ Int -> MaxHeaderLength
MaxHeaderLength Int
4096
    }

-- | Create a 'Manager'. The @Manager@ will be shut down automatically via
-- garbage collection.
--
-- Creating a new 'Manager' is a relatively expensive operation, you are
-- advised to share a single 'Manager' between requests instead.
--
-- The first argument to this function is often 'defaultManagerSettings',
-- though add-on libraries may provide a recommended replacement.
--
-- Since 0.1.0
newManager :: ManagerSettings -> IO Manager
newManager :: ManagerSettings -> IO Manager
newManager ManagerSettings
ms = do
    IO () -> IO ()
forall a. IO a -> IO a
NS.withSocketsDo (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    Request -> Request
httpProxy <- ProxyOverride -> Bool -> IO (Request -> Request)
runProxyOverride (ManagerSettings -> ProxyOverride
managerProxyInsecure ManagerSettings
ms) Bool
False
    Request -> Request
httpsProxy <- ProxyOverride -> Bool -> IO (Request -> Request)
runProxyOverride (ManagerSettings -> ProxyOverride
managerProxySecure ManagerSettings
ms) Bool
True

    ConnKey -> IO Connection
createConnection <- ManagerSettings -> IO (ConnKey -> IO Connection)
mkCreateConnection ManagerSettings
ms

    KeyedPool ConnKey Connection
keyedPool <- (ConnKey -> IO Connection)
-> (Connection -> IO ())
-> Int
-> Int
-> (SomeException -> IO ())
-> IO (KeyedPool ConnKey Connection)
forall key resource.
Ord key =>
(key -> IO resource)
-> (resource -> IO ())
-> Int
-> Int
-> (SomeException -> IO ())
-> IO (KeyedPool key resource)
createKeyedPool
        ConnKey -> IO Connection
createConnection
        Connection -> IO ()
connectionClose
        (ManagerSettings -> Int
managerConnCount ManagerSettings
ms)
        (ManagerSettings -> Int
managerIdleConnectionCount ManagerSettings
ms)
        (IO () -> SomeException -> IO ()
forall a b. a -> b -> a
const (() -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ())) -- could allow something in ManagerSettings to handle exceptions more nicely

    let manager :: Manager
manager = Manager
            { mConns :: KeyedPool ConnKey Connection
mConns = KeyedPool ConnKey Connection
keyedPool
            , mResponseTimeout :: ResponseTimeout
mResponseTimeout = ManagerSettings -> ResponseTimeout
managerResponseTimeout ManagerSettings
ms
            , mRetryableException :: SomeException -> Bool
mRetryableException = ManagerSettings -> SomeException -> Bool
managerRetryableException ManagerSettings
ms
            , mWrapException :: forall a. Request -> IO a -> IO a
mWrapException = ManagerSettings -> forall a. Request -> IO a -> IO a
managerWrapException ManagerSettings
ms
            , mModifyRequest :: Request -> IO Request
mModifyRequest = ManagerSettings -> Request -> IO Request
managerModifyRequest ManagerSettings
ms
            , mModifyResponse :: Response BodyReader -> IO (Response BodyReader)
mModifyResponse = ManagerSettings -> Response BodyReader -> IO (Response BodyReader)
managerModifyResponse ManagerSettings
ms
            , mSetProxy :: Request -> Request
mSetProxy = \Request
req ->
                if Request -> Bool
secure Request
req
                    then Request -> Request
httpsProxy Request
req
                    else Request -> Request
httpProxy Request
req
            , mMaxHeaderLength :: Maybe MaxHeaderLength
mMaxHeaderLength = ManagerSettings -> Maybe MaxHeaderLength
managerMaxHeaderLength ManagerSettings
ms
            }
    Manager -> IO Manager
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
manager

    {- FIXME why isn't this being used anymore?
    flushStaleCerts now =
        Map.fromList . mapMaybe flushStaleCerts' . Map.toList
      where
        flushStaleCerts' (host', inner) =
            case mapMaybe flushStaleCerts'' $ Map.toList inner of
                [] -> Nothing
                pairs ->
                    let x = take 10 pairs
                     in x `seqPairs` Just (host', Map.fromList x)
        flushStaleCerts'' (certs, expires)
            | expires > now = Just (certs, expires)
            | otherwise     = Nothing

        seqPairs :: [(L.ByteString, UTCTime)] -> b -> b
        seqPairs [] b = b
        seqPairs (p:ps) b = p `seqPair` ps `seqPairs` b

        seqPair :: (L.ByteString, UTCTime) -> b -> b
        seqPair (lbs, utc) b = lbs `seqLBS` utc `seqUTC` b

        seqLBS :: L.ByteString -> b -> b
        seqLBS lbs b = L.length lbs `seq` b

        seqUTC :: UTCTime -> b -> b
        seqUTC (UTCTime day dt) b = day `seqDay` dt `seqDT` b

        seqDay :: Day -> b -> b
        seqDay (ModifiedJulianDay i) b = i `deepseq` b

        seqDT :: DiffTime -> b -> b
        seqDT = seq
    -}

-- | Close all connections in a 'Manager'.
--
-- Note that this doesn't affect currently in-flight connections,
-- meaning you can safely use it without hurting any queries you may
-- have concurrently running.
--
-- Since 0.1.0
closeManager :: Manager -> IO ()
closeManager :: Manager -> IO ()
closeManager Manager
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# DEPRECATED closeManager "Manager will be closed for you automatically when no longer in use" #-}

-- | Create, use and close a 'Manager'.
--
-- Since 0.2.1
withManager :: ManagerSettings -> (Manager -> IO a) -> IO a
withManager :: forall a. ManagerSettings -> (Manager -> IO a) -> IO a
withManager ManagerSettings
settings Manager -> IO a
f = ManagerSettings -> IO Manager
newManager ManagerSettings
settings IO Manager -> (Manager -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> IO a
f
{-# DEPRECATED withManager "Use newManager instead" #-}

-- | Drop the Proxy-Authorization header from the request if we're using a
-- secure proxy.
dropProxyAuthSecure :: Request -> Request
dropProxyAuthSecure :: Request -> Request
dropProxyAuthSecure Request
req
    | Request -> Bool
secure Request
req Bool -> Bool -> Bool
&& Bool
useProxy' = Request
req
        { requestHeaders = filter (\(HeaderName
k, ByteString
_) -> HeaderName
k HeaderName -> HeaderName -> Bool
forall a. Eq a => a -> a -> Bool
/= HeaderName
"Proxy-Authorization")
                                  (requestHeaders req)
        }
    | Bool
otherwise = Request
req
  where
    useProxy' :: Bool
useProxy' = Maybe Proxy -> Bool
forall a. Maybe a -> Bool
isJust (Request -> Maybe Proxy
proxy Request
req)

getConn :: Request
        -> Manager
        -> IO (Managed Connection)
getConn :: Request -> Manager -> IO (Managed Connection)
getConn Request
req Manager
m
    -- Stop Mac OS X from getting high:
    -- https://github.com/snoyberg/http-client/issues/40#issuecomment-39117909
    | ByteString -> Bool
S8.null ByteString
h = HttpExceptionContent -> IO (Managed Connection)
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO (Managed Connection))
-> HttpExceptionContent -> IO (Managed Connection)
forall a b. (a -> b) -> a -> b
$ ByteString -> HttpExceptionContent
InvalidDestinationHost ByteString
h
    | Bool
otherwise = KeyedPool ConnKey Connection -> ConnKey -> IO (Managed Connection)
forall key resource.
Ord key =>
KeyedPool key resource -> key -> IO (Managed resource)
takeKeyedPool (Manager -> KeyedPool ConnKey Connection
mConns Manager
m) ConnKey
connkey
  where
    h :: ByteString
h = Request -> ByteString
host Request
req
    connkey :: ConnKey
connkey = Request -> ConnKey
connKey Request
req

connKey :: Request -> ConnKey
connKey :: Request -> ConnKey
connKey req :: Request
req@Request { proxy :: Request -> Maybe Proxy
proxy = Maybe Proxy
Nothing, secure :: Request -> Bool
secure = Bool
False } =
  Maybe HostAddress -> ByteString -> Int -> ConnKey
CKRaw (Request -> Maybe HostAddress
hostAddress Request
req) (Request -> ByteString
host Request
req) (Request -> Int
port Request
req)
connKey req :: Request
req@Request { proxy :: Request -> Maybe Proxy
proxy = Maybe Proxy
Nothing, secure :: Request -> Bool
secure = Bool
True  } =
  Maybe HostAddress -> ByteString -> Int -> ConnKey
CKSecure (Request -> Maybe HostAddress
hostAddress Request
req) (Request -> ByteString
host Request
req) (Request -> Int
port Request
req)
connKey Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
p, secure :: Request -> Bool
secure = Bool
False } =
  Maybe HostAddress -> ByteString -> Int -> ConnKey
CKRaw Maybe HostAddress
forall a. Maybe a
Nothing (Proxy -> ByteString
proxyHost Proxy
p) (Proxy -> Int
proxyPort Proxy
p)
connKey req :: Request
req@Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
p, secure :: Request -> Bool
secure = Bool
True,
                      proxySecureMode :: Request -> ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithConnect  } =
  ByteString
-> Int -> Maybe ByteString -> ByteString -> Int -> ConnKey
CKProxy
    (Proxy -> ByteString
proxyHost Proxy
p)
    (Proxy -> Int
proxyPort Proxy
p)
    (HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Proxy-Authorization" (Request -> [Header]
requestHeaders Request
req))
    (Request -> ByteString
host Request
req)
    (Request -> Int
port Request
req)
connKey Request { proxy :: Request -> Maybe Proxy
proxy = Just Proxy
p, secure :: Request -> Bool
secure = Bool
True,
                  proxySecureMode :: Request -> ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithoutConnect  } =
  Maybe HostAddress -> ByteString -> Int -> ConnKey
CKRaw Maybe HostAddress
forall a. Maybe a
Nothing (Proxy -> ByteString
proxyHost Proxy
p) (Proxy -> Int
proxyPort Proxy
p)

mkCreateConnection :: ManagerSettings -> IO (ConnKey -> IO Connection)
mkCreateConnection :: ManagerSettings -> IO (ConnKey -> IO Connection)
mkCreateConnection ManagerSettings
ms = do
    Maybe HostAddress -> String -> Int -> IO Connection
rawConnection <- ManagerSettings
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerRawConnection ManagerSettings
ms
    Maybe HostAddress -> String -> Int -> IO Connection
tlsConnection <- ManagerSettings
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerTlsConnection ManagerSettings
ms
    ByteString
-> (Connection -> IO ())
-> String
-> Maybe HostAddress
-> String
-> Int
-> IO Connection
tlsProxyConnection <- ManagerSettings
-> IO
     (ByteString
      -> (Connection -> IO ())
      -> String
      -> Maybe HostAddress
      -> String
      -> Int
      -> IO Connection)
managerTlsProxyConnection ManagerSettings
ms

    (ConnKey -> IO Connection) -> IO (ConnKey -> IO Connection)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ConnKey -> IO Connection) -> IO (ConnKey -> IO Connection))
-> (ConnKey -> IO Connection) -> IO (ConnKey -> IO Connection)
forall a b. (a -> b) -> a -> b
$ \ConnKey
ck -> IO Connection -> IO Connection
forall a. IO a -> IO a
wrapConnectExc (IO Connection -> IO Connection) -> IO Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ case ConnKey
ck of
        CKRaw Maybe HostAddress
connaddr ByteString
connhost Int
connport ->
            Maybe HostAddress -> String -> Int -> IO Connection
rawConnection Maybe HostAddress
connaddr (ByteString -> String
S8.unpack ByteString
connhost) Int
connport
        CKSecure Maybe HostAddress
connaddr ByteString
connhost Int
connport ->
            Maybe HostAddress -> String -> Int -> IO Connection
tlsConnection Maybe HostAddress
connaddr (ByteString -> String
S8.unpack ByteString
connhost) Int
connport
        CKProxy ByteString
connhost Int
connport Maybe ByteString
mProxyAuthHeader ByteString
ultHost Int
ultPort ->
            let proxyAuthorizationHeader :: ByteString
proxyAuthorizationHeader = ByteString
-> (ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                    ByteString
""
                    (\ByteString
h' -> [ByteString] -> ByteString
S8.concat [ByteString
"Proxy-Authorization: ", ByteString
h', ByteString
"\r\n"])
                    Maybe ByteString
mProxyAuthHeader
                hostHeader :: ByteString
hostHeader = [ByteString] -> ByteString
S8.concat [ByteString
"Host: ", ByteString
ultHost, ByteString
":", (String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
ultPort), ByteString
"\r\n"]
                connstr :: ByteString
connstr = [ByteString] -> ByteString
S8.concat
                    [ ByteString
"CONNECT "
                    , ByteString
ultHost
                    , ByteString
":"
                    , String -> ByteString
S8.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
ultPort
                    , ByteString
" HTTP/1.1\r\n"
                    , ByteString
proxyAuthorizationHeader
                    , ByteString
hostHeader
                    , ByteString
"\r\n"
                    ]
                parse :: Connection -> IO ()
parse Connection
conn = do
                    StatusHeaders Status
status HttpVersion
_ [Header]
_ [Header]
_ <- Maybe MaxHeaderLength
-> Connection
-> Maybe Int
-> ([Header] -> IO ())
-> Maybe (IO ())
-> IO StatusHeaders
parseStatusHeaders (ManagerSettings -> Maybe MaxHeaderLength
managerMaxHeaderLength ManagerSettings
ms) Connection
conn Maybe Int
forall a. Maybe a
Nothing (\[Header]
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()) Maybe (IO ())
forall a. Maybe a
Nothing
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status
status Status -> Status -> Bool
forall a. Eq a => a -> a -> Bool
== Status
status200) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        HttpExceptionContent -> IO ()
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO ()) -> HttpExceptionContent -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Int -> Status -> HttpExceptionContent
ProxyConnectException ByteString
ultHost Int
ultPort Status
status
                in ByteString
-> (Connection -> IO ())
-> String
-> Maybe HostAddress
-> String
-> Int
-> IO Connection
tlsProxyConnection
                        ByteString
connstr
                        Connection -> IO ()
parse
                        (ByteString -> String
S8.unpack ByteString
ultHost)
                        Maybe HostAddress
forall a. Maybe a
Nothing -- we never have a HostAddress we can use
                        (ByteString -> String
S8.unpack ByteString
connhost)
                        Int
connport
  where
    wrapConnectExc :: IO a -> IO a
wrapConnectExc = (IOException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle ((IOException -> IO a) -> IO a -> IO a)
-> (IOException -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ \IOException
e ->
        HttpExceptionContent -> IO a
forall a. HttpExceptionContent -> IO a
throwHttp (HttpExceptionContent -> IO a) -> HttpExceptionContent -> IO a
forall a b. (a -> b) -> a -> b
$ SomeException -> HttpExceptionContent
ConnectionFailure (IOException -> SomeException
forall e. Exception e => e -> SomeException
toException (IOException
e :: IOException))

-- | Get the proxy settings from the @Request@ itself.
--
-- Since 0.4.7
proxyFromRequest :: ProxyOverride
proxyFromRequest :: ProxyOverride
proxyFromRequest = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$ IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. a -> b -> a
const (IO (Request -> Request) -> Bool -> IO (Request -> Request))
-> IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ (Request -> Request) -> IO (Request -> Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Request -> Request
forall a. a -> a
id

-- | Never connect using a proxy, regardless of the proxy value in the @Request@.
--
-- Since 0.4.7
noProxy :: ProxyOverride
noProxy :: ProxyOverride
noProxy = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$ IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. a -> b -> a
const (IO (Request -> Request) -> Bool -> IO (Request -> Request))
-> IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ (Request -> Request) -> IO (Request -> Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Request -> Request) -> IO (Request -> Request))
-> (Request -> Request) -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ \Request
req -> Request
req { proxy = Nothing }

-- | Use the given proxy settings, regardless of the proxy value in the @Request@.
--
-- Since 0.4.7
useProxy :: Proxy -> ProxyOverride
useProxy :: Proxy -> ProxyOverride
useProxy Proxy
p = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$ IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. a -> b -> a
const (IO (Request -> Request) -> Bool -> IO (Request -> Request))
-> IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ (Request -> Request) -> IO (Request -> Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Request -> Request) -> IO (Request -> Request))
-> (Request -> Request) -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ \Request
req -> Request
req { proxy = Just p }

-- | Send secure requests to the proxy in plain text rather than using CONNECT,
-- regardless of the value in the @Request@.
--
-- @since 0.7.2
useProxySecureWithoutConnect :: Proxy -> ProxyOverride
useProxySecureWithoutConnect :: Proxy -> ProxyOverride
useProxySecureWithoutConnect Proxy
p = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$
  IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. a -> b -> a
const (IO (Request -> Request) -> Bool -> IO (Request -> Request))
-> IO (Request -> Request) -> Bool -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ (Request -> Request) -> IO (Request -> Request)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Request -> Request) -> IO (Request -> Request))
-> (Request -> Request) -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ \Request
req -> Request
req { proxy = Just p,
                                 proxySecureMode = ProxySecureWithoutConnect }

-- | Get the proxy settings from the default environment variable (@http_proxy@
-- for insecure, @https_proxy@ for secure). If no variable is set, then fall
-- back to the given value. @Nothing@ is equivalent to 'noProxy', @Just@ is
-- equivalent to 'useProxy'.
--
-- Since 0.4.7
proxyEnvironment :: Maybe Proxy -- ^ fallback if no environment set
                 -> ProxyOverride
proxyEnvironment :: Maybe Proxy -> ProxyOverride
proxyEnvironment Maybe Proxy
mp = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$ \Bool
secure' ->
    Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper Maybe Text
forall a. Maybe a
Nothing (Bool -> ProxyProtocol
httpProtocol Bool
secure') (EnvHelper -> IO (Request -> Request))
-> EnvHelper -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ EnvHelper -> (Proxy -> EnvHelper) -> Maybe Proxy -> EnvHelper
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnvHelper
EHNoProxy Proxy -> EnvHelper
EHUseProxy Maybe Proxy
mp

-- | Same as 'proxyEnvironment', but instead of default environment variable
-- names, allows you to set your own name.
--
-- Since 0.4.7
proxyEnvironmentNamed
    :: Text -- ^ environment variable name
    -> Maybe Proxy -- ^ fallback if no environment set
    -> ProxyOverride
proxyEnvironmentNamed :: Text -> Maybe Proxy -> ProxyOverride
proxyEnvironmentNamed Text
name Maybe Proxy
mp = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$ \Bool
secure' ->
    Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
name) (Bool -> ProxyProtocol
httpProtocol Bool
secure') (EnvHelper -> IO (Request -> Request))
-> EnvHelper -> IO (Request -> Request)
forall a b. (a -> b) -> a -> b
$ EnvHelper -> (Proxy -> EnvHelper) -> Maybe Proxy -> EnvHelper
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnvHelper
EHNoProxy Proxy -> EnvHelper
EHUseProxy Maybe Proxy
mp

-- | The default proxy settings for a manager. In particular: if the @http_proxy@ (or @https_proxy@) environment variable is set, use it. Otherwise, use the values in the @Request@.
--
-- Since 0.4.7
defaultProxy :: ProxyOverride
defaultProxy :: ProxyOverride
defaultProxy = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride ((Bool -> IO (Request -> Request)) -> ProxyOverride)
-> (Bool -> IO (Request -> Request)) -> ProxyOverride
forall a b. (a -> b) -> a -> b
$ \Bool
secure' ->
    Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper Maybe Text
forall a. Maybe a
Nothing (Bool -> ProxyProtocol
httpProtocol Bool
secure') EnvHelper
EHFromRequest