{-# 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)
rawConnectionModifySocket :: (NS.Socket -> IO ())
-> IO (Maybe NS.HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocket :: (Socket -> IO ())
-> IO (Maybe HostAddress -> String -> Int -> IO Connection)
rawConnectionModifySocket = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO ())
-> Maybe HostAddress -> String -> Int -> IO Connection
openSocketConnection
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 = forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Socket -> IO ())
-> Int -> Maybe HostAddress -> String -> Int -> IO Connection
openSocketConnectionSize
defaultManagerSettings :: ManagerSettings
defaultManagerSettings :: ManagerSettings
defaultManagerSettings = ManagerSettings
{ managerConnCount :: Int
managerConnCount = Int
10
, managerRawConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerRawConnection = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Socket -> IO ())
-> Maybe HostAddress -> String -> Int -> IO Connection
openSocketConnection (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return ())
, managerTlsConnection :: IO (Maybe HostAddress -> String -> Int -> IO Connection)
managerTlsConnection = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Maybe HostAddress
_ String
_ Int
_ -> forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
TlsNotSupported
, managerTlsProxyConnection :: IO
(ByteString
-> (Connection -> IO ())
-> String
-> Maybe HostAddress
-> String
-> Int
-> IO Connection)
managerTlsProxyConnection = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ByteString
_ Connection -> IO ()
_ String
_ Maybe HostAddress
_ String
_ Int
_ -> forall a. HttpExceptionContent -> IO a
throwHttp HttpExceptionContent
TlsNotSupported
, managerResponseTimeout :: ResponseTimeout
managerResponseTimeout = ResponseTimeout
ResponseTimeoutDefault
, managerRetryableException :: SomeException -> Bool
managerRetryableException = \SomeException
e ->
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just (IOException
_ :: IOException) -> Bool
True
Maybe IOException
_ ->
case forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap HttpExceptionContentWrapper -> HttpExceptionContent
unHttpExceptionContentWrapper forall a b. (a -> b) -> a -> b
$ forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
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 forall e. Exception e => SomeException -> Maybe e
fromException SomeException
se of
Just (IOException
_ :: IOException) -> forall a. HttpExceptionContent -> IO a
throwHttp forall a b. (a -> b) -> a -> b
$ SomeException -> HttpExceptionContent
InternalException SomeException
se
Maybe IOException
Nothing -> forall e a. Exception e => e -> IO a
throwIO SomeException
se
in forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall {a}. SomeException -> IO a
wrapper
, managerIdleConnectionCount :: Int
managerIdleConnectionCount = Int
512
, managerModifyRequest :: Request -> IO Request
managerModifyRequest = forall (m :: * -> *) a. Monad m => a -> m a
return
, managerModifyResponse :: Response BodyReader -> IO (Response BodyReader)
managerModifyResponse = forall (m :: * -> *) a. Monad m => a -> m a
return
, managerProxyInsecure :: ProxyOverride
managerProxyInsecure = ProxyOverride
defaultProxy
, managerProxySecure :: ProxyOverride
managerProxySecure = ProxyOverride
defaultProxy
, managerMaxHeaderLength :: Maybe MaxHeaderLength
managerMaxHeaderLength = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> MaxHeaderLength
MaxHeaderLength Int
4096
}
newManager :: ManagerSettings -> IO Manager
newManager :: ManagerSettings -> IO Manager
newManager ManagerSettings
ms = do
forall a. IO a -> IO a
NS.withSocketsDo forall a b. (a -> b) -> a -> b
$ 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 <- 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)
(forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return ()))
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
}
forall (m :: * -> *) a. Monad m => a -> m a
return Manager
manager
closeManager :: Manager -> IO ()
closeManager :: Manager -> IO ()
closeManager Manager
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# DEPRECATED closeManager "Manager will be closed for you automatically when no longer in use" #-}
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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Manager -> IO a
f
{-# DEPRECATED withManager "Use newManager instead" #-}
dropProxyAuthSecure :: Request -> Request
dropProxyAuthSecure :: Request -> Request
dropProxyAuthSecure Request
req
| Request -> Bool
secure Request
req Bool -> Bool -> Bool
&& Bool
useProxy' = Request
req
{ requestHeaders :: RequestHeaders
requestHeaders = forall a. (a -> Bool) -> [a] -> [a]
filter (\(HeaderName
k, ByteString
_) -> HeaderName
k forall a. Eq a => a -> a -> Bool
/= HeaderName
"Proxy-Authorization")
(Request -> RequestHeaders
requestHeaders Request
req)
}
| Bool
otherwise = Request
req
where
useProxy' :: Bool
useProxy' = 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
| ByteString -> Bool
S8.null ByteString
h = forall a. HttpExceptionContent -> IO a
throwHttp forall a b. (a -> b) -> a -> b
$ ByteString -> HttpExceptionContent
InvalidDestinationHost ByteString
h
| Bool
otherwise = 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 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)
(forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
"Proxy-Authorization" (Request -> RequestHeaders
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 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
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \ConnKey
ck -> forall a. IO a -> IO a
wrapConnectExc 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 = 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 forall a b. (a -> b) -> a -> b
$ 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 forall a b. (a -> b) -> a -> b
$ 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
_ RequestHeaders
_ <- Maybe MaxHeaderLength
-> Connection -> Maybe Int -> Maybe (IO ()) -> IO StatusHeaders
parseStatusHeaders (ManagerSettings -> Maybe MaxHeaderLength
managerMaxHeaderLength ManagerSettings
ms) Connection
conn forall a. Maybe a
Nothing forall a. Maybe a
Nothing
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Status
status forall a. Eq a => a -> a -> Bool
== Status
status200) forall a b. (a -> b) -> a -> b
$
forall a. HttpExceptionContent -> IO a
throwHttp 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)
forall a. Maybe a
Nothing
(ByteString -> String
S8.unpack ByteString
connhost)
Int
connport
where
wrapConnectExc :: IO a -> IO a
wrapConnectExc = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a b. (a -> b) -> a -> b
$ \IOException
e ->
forall a. HttpExceptionContent -> IO a
throwHttp forall a b. (a -> b) -> a -> b
$ SomeException -> HttpExceptionContent
ConnectionFailure (forall e. Exception e => e -> SomeException
toException (IOException
e :: IOException))
proxyFromRequest :: ProxyOverride
proxyFromRequest :: ProxyOverride
proxyFromRequest = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a. a -> a
id
noProxy :: ProxyOverride
noProxy :: ProxyOverride
noProxy = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Request
req -> Request
req { proxy :: Maybe Proxy
proxy = forall a. Maybe a
Nothing }
useProxy :: Proxy -> ProxyOverride
useProxy :: Proxy -> ProxyOverride
useProxy Proxy
p = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Request
req -> Request
req { proxy :: Maybe Proxy
proxy = forall a. a -> Maybe a
Just Proxy
p }
useProxySecureWithoutConnect :: Proxy -> ProxyOverride
useProxySecureWithoutConnect :: Proxy -> ProxyOverride
useProxySecureWithoutConnect Proxy
p = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$
forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ \Request
req -> Request
req { proxy :: Maybe Proxy
proxy = forall a. a -> Maybe a
Just Proxy
p,
proxySecureMode :: ProxySecureMode
proxySecureMode = ProxySecureMode
ProxySecureWithoutConnect }
proxyEnvironment :: Maybe Proxy
-> ProxyOverride
proxyEnvironment :: Maybe Proxy -> ProxyOverride
proxyEnvironment Maybe Proxy
mp = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$ \Bool
secure' ->
Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper forall a. Maybe a
Nothing (Bool -> ProxyProtocol
httpProtocol Bool
secure') forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnvHelper
EHNoProxy Proxy -> EnvHelper
EHUseProxy Maybe Proxy
mp
proxyEnvironmentNamed
:: Text
-> Maybe Proxy
-> ProxyOverride
proxyEnvironmentNamed :: Text -> Maybe Proxy -> ProxyOverride
proxyEnvironmentNamed Text
name Maybe Proxy
mp = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$ \Bool
secure' ->
Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper (forall a. a -> Maybe a
Just Text
name) (Bool -> ProxyProtocol
httpProtocol Bool
secure') forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe EnvHelper
EHNoProxy Proxy -> EnvHelper
EHUseProxy Maybe Proxy
mp
defaultProxy :: ProxyOverride
defaultProxy :: ProxyOverride
defaultProxy = (Bool -> IO (Request -> Request)) -> ProxyOverride
ProxyOverride forall a b. (a -> b) -> a -> b
$ \Bool
secure' ->
Maybe Text -> ProxyProtocol -> EnvHelper -> IO (Request -> Request)
systemProxyHelper forall a. Maybe a
Nothing (Bool -> ProxyProtocol
httpProtocol Bool
secure') EnvHelper
EHFromRequest