Introduce global connection context #214

snoyberg · Sep 13, 2016 · 436ac32 · 436ac32
1 parent d72d582
commit 436ac32
Showing 1 changed file with 27 additions and 12 deletions.
diff --git a/http-client-tls/Network/HTTP/Client/TLS.hs b/http-client-tls/Network/HTTP/Client/TLS.hs
@@ -39,13 +39,20 @@ import Data.ByteArray.Encoding (convertToBase, Base (Base16))
 mkManagerSettings :: NC.TLSSettings
                   -> Maybe NC.SockSettings
                   -> ManagerSettings
-mkManagerSettings tls sock = defaultManagerSettings
-    { managerTlsConnection = getTlsConnection (Just tls) sock
-    , managerTlsProxyConnection = getTlsProxyConnection tls sock
+mkManagerSettings = mkManagerSettingsContext (Just globalContext)
+
+mkManagerSettingsContext
+    :: Maybe NC.ConnectionContext
+    -> NC.TLSSettings
+    -> Maybe NC.SockSettings
+    -> ManagerSettings
+mkManagerSettingsContext mcontext tls sock = defaultManagerSettings
+    { managerTlsConnection = getTlsConnection mcontext (Just tls) sock
+    , managerTlsProxyConnection = getTlsProxyConnection mcontext tls sock
     , managerRawConnection =
         case sock of
             Nothing -> managerRawConnection defaultManagerSettings
-            Just _ -> getTlsConnection Nothing sock
+            Just _ -> getTlsConnection mcontext Nothing sock
     , managerRetryableException = \e ->
         case () of
             ()
@@ -67,13 +74,18 @@ mkManagerSettings tls sock = defaultManagerSettings
 
 -- | Default TLS-enabled manager settings
 tlsManagerSettings :: ManagerSettings
-tlsManagerSettings = mkManagerSettings def Nothing
+tlsManagerSettings = mkManagerSettingsContext (Just globalContext) def Nothing
+
+globalContext :: NC.ConnectionContext
+globalContext = unsafePerformIO NC.initConnectionContext
+{-# NOINLINE globalContext #-}
 
-getTlsConnection :: Maybe NC.TLSSettings
+getTlsConnection :: Maybe NC.ConnectionContext
+                 -> Maybe NC.TLSSettings
                  -> Maybe NC.SockSettings
                  -> IO (Maybe HostAddress -> String -> Int -> IO Connection)
-getTlsConnection tls sock = do
-    context <- NC.initConnectionContext
+getTlsConnection mcontext tls sock = do
+    context <- maybe NC.initConnectionContext return mcontext
     return $ \_ha host port -> do
         conn <- NC.connectTo context NC.ConnectionParams
             { NC.connectionHostname = host
@@ -84,11 +96,12 @@ getTlsConnection tls sock = do
         convertConnection conn
 
 getTlsProxyConnection
-    :: NC.TLSSettings
+    :: Maybe NC.ConnectionContext
+    -> NC.TLSSettings
     -> Maybe NC.SockSettings
     -> IO (S.ByteString -> (Connection -> IO ()) -> String -> Maybe HostAddress -> String -> Int -> IO Connection)
-getTlsProxyConnection tls sock = do
-    context <- NC.initConnectionContext
+getTlsProxyConnection mcontext tls sock = do
+    context <- maybe NC.initConnectionContext return mcontext
     return $ \connstr checkConn serverName _ha host port -> do
         --error $ show (connstr, host, port)
         conn <- NC.connectTo context NC.ConnectionParams
@@ -121,7 +134,9 @@ convertConnection conn = makeConnection
 
 -- | Evil global manager, to make life easier for the common use case
 globalManager :: IORef Manager
-globalManager = unsafePerformIO (newManager tlsManagerSettings >>= newIORef)
+globalManager = unsafePerformIO $ do
+    man <- newManager $ mkManagerSettingsContext (Just globalContext) def Nothing
+    newIORef man
 {-# NOINLINE globalManager #-}
 
 -- | Get the current global 'Manager'