1{-# LANGUAGE OverloadedStrings #-} 2{-# LANGUAGE RankNTypes #-} 3{-# LANGUAGE ScopedTypeVariables #-} 4module Network.HTTP.Client.Manager 5 ( ManagerSettings (..) 6 , newManager 7 , closeManager 8 , withManager 9 , getConn 10 , defaultManagerSettings 11 , rawConnectionModifySocket 12 , rawConnectionModifySocketSize 13 , proxyFromRequest 14 , noProxy 15 , useProxy 16 , proxyEnvironment 17 , proxyEnvironmentNamed 18 , defaultProxy 19 , dropProxyAuthSecure 20 , useProxySecureWithoutConnect 21 ) where 22 23import qualified Data.ByteString.Char8 as S8 24 25import Data.Text (Text) 26 27import Control.Monad (unless) 28import Control.Exception (throwIO, fromException, IOException, Exception (..), handle) 29 30import qualified Network.Socket as NS 31 32import Network.HTTP.Types (status200) 33import Network.HTTP.Client.Types 34import Network.HTTP.Client.Connection 35import Network.HTTP.Client.Headers (parseStatusHeaders) 36import Network.HTTP.Proxy 37import Data.KeyedPool 38import Data.Maybe (isJust) 39 40-- | A value for the @managerRawConnection@ setting, but also allows you to 41-- modify the underlying @Socket@ to set additional settings. For a motivating 42-- use case, see: <https://github.com/snoyberg/http-client/issues/71>. 43-- 44-- Since 0.3.8 45rawConnectionModifySocket :: (NS.Socket -> IO ()) 46 -> IO (Maybe NS.HostAddress -> String -> Int -> IO Connection) 47rawConnectionModifySocket = return . openSocketConnection 48 49-- | Same as @rawConnectionModifySocket@, but also takes in a chunk size. 50-- 51-- @since 0.5.2 52rawConnectionModifySocketSize :: (NS.Socket -> IO ()) 53 -> IO (Int -> Maybe NS.HostAddress -> String -> Int -> IO Connection) 54rawConnectionModifySocketSize = return . openSocketConnectionSize 55 56 57-- | Default value for @ManagerSettings@. 58-- 59-- Note that this value does /not/ have support for SSL/TLS. If you need to 60-- make any https connections, please use the http-client-tls package, which 61-- provides a @tlsManagerSettings@ value. 62-- 63-- Since 0.1.0 64defaultManagerSettings :: ManagerSettings 65defaultManagerSettings = ManagerSettings 66 { managerConnCount = 10 67 , managerRawConnection = return $ openSocketConnection (const $ return ()) 68 , managerTlsConnection = return $ \_ _ _ -> throwHttp TlsNotSupported 69 , managerTlsProxyConnection = return $ \_ _ _ _ _ _ -> throwHttp TlsNotSupported 70 , managerResponseTimeout = ResponseTimeoutDefault 71 , managerRetryableException = \e -> 72 case fromException e of 73 Just (_ :: IOException) -> True 74 _ -> 75 case fmap unHttpExceptionContentWrapper $ fromException e of 76 -- Note: Some servers will timeout connections by accepting 77 -- the incoming packets for the new request, but closing 78 -- the connection as soon as we try to read. To make sure 79 -- we open a new connection under these circumstances, we 80 -- check for the NoResponseDataReceived exception. 81 Just NoResponseDataReceived -> True 82 Just IncompleteHeaders -> True 83 _ -> False 84 , managerWrapException = \_req -> 85 let wrapper se = 86 case fromException se of 87 Just (_ :: IOException) -> throwHttp $ InternalException se 88 Nothing -> throwIO se 89 in handle wrapper 90 , managerIdleConnectionCount = 512 91 , managerModifyRequest = return 92 , managerModifyResponse = return 93 , managerProxyInsecure = defaultProxy 94 , managerProxySecure = defaultProxy 95 } 96 97-- | Create a 'Manager'. The @Manager@ will be shut down automatically via 98-- garbage collection. 99-- 100-- Creating a new 'Manager' is a relatively expensive operation, you are 101-- advised to share a single 'Manager' between requests instead. 102-- 103-- The first argument to this function is often 'defaultManagerSettings', 104-- though add-on libraries may provide a recommended replacement. 105-- 106-- Since 0.1.0 107newManager :: ManagerSettings -> IO Manager 108newManager ms = do 109 NS.withSocketsDo $ return () 110 111 httpProxy <- runProxyOverride (managerProxyInsecure ms) False 112 httpsProxy <- runProxyOverride (managerProxySecure ms) True 113 114 createConnection <- mkCreateConnection ms 115 116 keyedPool <- createKeyedPool 117 createConnection 118 connectionClose 119 (managerConnCount ms) 120 (managerIdleConnectionCount ms) 121 (const (return ())) -- could allow something in ManagerSettings to handle exceptions more nicely 122 123 let manager = Manager 124 { mConns = keyedPool 125 , mResponseTimeout = managerResponseTimeout ms 126 , mRetryableException = managerRetryableException ms 127 , mWrapException = managerWrapException ms 128 , mModifyRequest = managerModifyRequest ms 129 , mModifyResponse = managerModifyResponse ms 130 , mSetProxy = \req -> 131 if secure req 132 then httpsProxy req 133 else httpProxy req 134 } 135 return manager 136 137 {- FIXME why isn't this being used anymore? 138 flushStaleCerts now = 139 Map.fromList . mapMaybe flushStaleCerts' . Map.toList 140 where 141 flushStaleCerts' (host', inner) = 142 case mapMaybe flushStaleCerts'' $ Map.toList inner of 143 [] -> Nothing 144 pairs -> 145 let x = take 10 pairs 146 in x `seqPairs` Just (host', Map.fromList x) 147 flushStaleCerts'' (certs, expires) 148 | expires > now = Just (certs, expires) 149 | otherwise = Nothing 150 151 seqPairs :: [(L.ByteString, UTCTime)] -> b -> b 152 seqPairs [] b = b 153 seqPairs (p:ps) b = p `seqPair` ps `seqPairs` b 154 155 seqPair :: (L.ByteString, UTCTime) -> b -> b 156 seqPair (lbs, utc) b = lbs `seqLBS` utc `seqUTC` b 157 158 seqLBS :: L.ByteString -> b -> b 159 seqLBS lbs b = L.length lbs `seq` b 160 161 seqUTC :: UTCTime -> b -> b 162 seqUTC (UTCTime day dt) b = day `seqDay` dt `seqDT` b 163 164 seqDay :: Day -> b -> b 165 seqDay (ModifiedJulianDay i) b = i `deepseq` b 166 167 seqDT :: DiffTime -> b -> b 168 seqDT = seq 169 -} 170 171-- | Close all connections in a 'Manager'. 172-- 173-- Note that this doesn't affect currently in-flight connections, 174-- meaning you can safely use it without hurting any queries you may 175-- have concurrently running. 176-- 177-- Since 0.1.0 178closeManager :: Manager -> IO () 179closeManager _ = return () 180{-# DEPRECATED closeManager "Manager will be closed for you automatically when no longer in use" #-} 181 182-- | Create, use and close a 'Manager'. 183-- 184-- Since 0.2.1 185withManager :: ManagerSettings -> (Manager -> IO a) -> IO a 186withManager settings f = newManager settings >>= f 187{-# DEPRECATED withManager "Use newManager instead" #-} 188 189-- | Drop the Proxy-Authorization header from the request if we're using a 190-- secure proxy. 191dropProxyAuthSecure :: Request -> Request 192dropProxyAuthSecure req 193 | secure req && useProxy' = req 194 { requestHeaders = filter (\(k, _) -> k /= "Proxy-Authorization") 195 (requestHeaders req) 196 } 197 | otherwise = req 198 where 199 useProxy' = isJust (proxy req) 200 201getConn :: Request 202 -> Manager 203 -> IO (Managed Connection) 204getConn req m 205 -- Stop Mac OS X from getting high: 206 -- https://github.com/snoyberg/http-client/issues/40#issuecomment-39117909 207 | S8.null h = throwHttp $ InvalidDestinationHost h 208 | otherwise = takeKeyedPool (mConns m) connkey 209 where 210 h = host req 211 connkey = connKey req 212 213connKey :: Request -> ConnKey 214connKey req@Request { proxy = Nothing, secure = False } = 215 CKRaw (hostAddress req) (host req) (port req) 216connKey req@Request { proxy = Nothing, secure = True } = 217 CKSecure (hostAddress req) (host req) (port req) 218connKey Request { proxy = Just p, secure = False } = 219 CKRaw Nothing (proxyHost p) (proxyPort p) 220connKey req@Request { proxy = Just p, secure = True, 221 proxySecureMode = ProxySecureWithConnect } = 222 CKProxy 223 (proxyHost p) 224 (proxyPort p) 225 (lookup "Proxy-Authorization" (requestHeaders req)) 226 (host req) 227 (port req) 228connKey Request { proxy = Just p, secure = True, 229 proxySecureMode = ProxySecureWithoutConnect } = 230 CKRaw Nothing (proxyHost p) (proxyPort p) 231 232mkCreateConnection :: ManagerSettings -> IO (ConnKey -> IO Connection) 233mkCreateConnection ms = do 234 rawConnection <- managerRawConnection ms 235 tlsConnection <- managerTlsConnection ms 236 tlsProxyConnection <- managerTlsProxyConnection ms 237 238 return $ \ck -> wrapConnectExc $ case ck of 239 CKRaw connaddr connhost connport -> 240 rawConnection connaddr (S8.unpack connhost) connport 241 CKSecure connaddr connhost connport -> 242 tlsConnection connaddr (S8.unpack connhost) connport 243 CKProxy connhost connport mProxyAuthHeader ultHost ultPort -> 244 let proxyAuthorizationHeader = maybe 245 "" 246 (\h' -> S8.concat ["Proxy-Authorization: ", h', "\r\n"]) 247 mProxyAuthHeader 248 hostHeader = S8.concat ["Host: ", ultHost, ":", (S8.pack $ show ultPort), "\r\n"] 249 connstr = S8.concat 250 [ "CONNECT " 251 , ultHost 252 , ":" 253 , S8.pack $ show ultPort 254 , " HTTP/1.1\r\n" 255 , proxyAuthorizationHeader 256 , hostHeader 257 , "\r\n" 258 ] 259 parse conn = do 260 StatusHeaders status _ _ <- parseStatusHeaders conn Nothing Nothing 261 unless (status == status200) $ 262 throwHttp $ ProxyConnectException ultHost ultPort status 263 in tlsProxyConnection 264 connstr 265 parse 266 (S8.unpack ultHost) 267 Nothing -- we never have a HostAddress we can use 268 (S8.unpack connhost) 269 connport 270 where 271 wrapConnectExc = handle $ \e -> 272 throwHttp $ ConnectionFailure (toException (e :: IOException)) 273 274-- | Get the proxy settings from the @Request@ itself. 275-- 276-- Since 0.4.7 277proxyFromRequest :: ProxyOverride 278proxyFromRequest = ProxyOverride $ const $ return id 279 280-- | Never connect using a proxy, regardless of the proxy value in the @Request@. 281-- 282-- Since 0.4.7 283noProxy :: ProxyOverride 284noProxy = ProxyOverride $ const $ return $ \req -> req { proxy = Nothing } 285 286-- | Use the given proxy settings, regardless of the proxy value in the @Request@. 287-- 288-- Since 0.4.7 289useProxy :: Proxy -> ProxyOverride 290useProxy p = ProxyOverride $ const $ return $ \req -> req { proxy = Just p } 291 292-- | Send secure requests to the proxy in plain text rather than using CONNECT, 293-- regardless of the value in the @Request@. 294-- 295-- @since 0.7.2 296useProxySecureWithoutConnect :: Proxy -> ProxyOverride 297useProxySecureWithoutConnect p = ProxyOverride $ 298 const $ return $ \req -> req { proxy = Just p, 299 proxySecureMode = ProxySecureWithoutConnect } 300 301-- | Get the proxy settings from the default environment variable (@http_proxy@ 302-- for insecure, @https_proxy@ for secure). If no variable is set, then fall 303-- back to the given value. @Nothing@ is equivalent to 'noProxy', @Just@ is 304-- equivalent to 'useProxy'. 305-- 306-- Since 0.4.7 307proxyEnvironment :: Maybe Proxy -- ^ fallback if no environment set 308 -> ProxyOverride 309proxyEnvironment mp = ProxyOverride $ \secure' -> 310 systemProxyHelper Nothing (httpProtocol secure') $ maybe EHNoProxy EHUseProxy mp 311 312-- | Same as 'proxyEnvironment', but instead of default environment variable 313-- names, allows you to set your own name. 314-- 315-- Since 0.4.7 316proxyEnvironmentNamed 317 :: Text -- ^ environment variable name 318 -> Maybe Proxy -- ^ fallback if no environment set 319 -> ProxyOverride 320proxyEnvironmentNamed name mp = ProxyOverride $ \secure' -> 321 systemProxyHelper (Just name) (httpProtocol secure') $ maybe EHNoProxy EHUseProxy mp 322 323-- | 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@. 324-- 325-- Since 0.4.7 326defaultProxy :: ProxyOverride 327defaultProxy = ProxyOverride $ \secure' -> 328 systemProxyHelper Nothing (httpProtocol secure') EHFromRequest 329