http-conduit 1.8.8 → 1.8.9
raw patch · 7 files changed
+72/−36 lines, 7 files
Files
- Network/HTTP/Conduit.hs +1/−0
- Network/HTTP/Conduit/ConnInfo.hs +17/−4
- Network/HTTP/Conduit/Manager.hs +34/−30
- Network/HTTP/Conduit/Request.hs +1/−0
- Network/HTTP/Conduit/Types.hs +5/−0
- http-conduit.cabal +1/−1
- test/main.hs +13/−1
Network/HTTP/Conduit.hs view
@@ -91,6 +91,7 @@ , requestBody , proxy , socksProxy+ , hostAddress , rawBody , decompress , redirectCount
Network/HTTP/Conduit/ConnInfo.hs view
@@ -156,15 +156,28 @@ then recvD istate else return x -getSocket :: String -> Int -> Maybe SocksConf -> IO NS.Socket-getSocket host' port' (Just socksConf) = do+getSocket :: Maybe NS.HostAddress -> String -> Int -> Maybe SocksConf -> IO NS.Socket+getSocket _ host' port' (Just socksConf) = do socksConnectWith socksConf host' (PortNumber $ fromIntegral port')-getSocket host' port' Nothing = do+getSocket hostAddress' host' port' Nothing = do let hints = NS.defaultHints { NS.addrFlags = [NS.AI_ADDRCONFIG] , NS.addrSocketType = NS.Stream }- addrs <- NS.getAddrInfo (Just hints) (Just host') (Just $ show port')+ addrs <- case hostAddress' of+ Nothing ->+ NS.getAddrInfo (Just hints) (Just host') (Just $ show port')+ Just ha ->+ return+ [NS.AddrInfo+ { NS.addrFlags = []+ , NS.addrFamily = NS.AF_INET+ , NS.addrSocketType = NS.Stream+ , NS.addrProtocol = 6 -- tcp+ , NS.addrAddress = NS.SockAddrInet (toEnum port') ha+ , NS.addrCanonName = Nothing+ }]+ firstSuccessful addrs $ \addr -> bracketOnError (NS.socket (NS.addrFamily addr) (NS.addrSocketType addr)
Network/HTTP/Conduit/Manager.hs view
@@ -7,6 +7,7 @@ ( Manager , ManagerSettings (..) , ConnKey (..)+ , ConnHost (..) , newManager , closeManager , getConn@@ -47,8 +48,7 @@ import Data.Time (UTCTime (..), Day (..), DiffTime, getCurrentTime, addUTCTime) import Control.DeepSeq (deepseq) -import Network (connectTo, PortID (PortNumber), HostName)-import Network.Socket (socketToHandle)+import qualified Network.Socket as NS import Data.Certificate.X509 (X509, encodeCertificate) import Data.CertificateStore (CertificateStore) import System.Certificate.X509 (getSystemCertificateStore)@@ -60,7 +60,7 @@ import Network.HTTP.Conduit.Types import Network.HTTP.Conduit.Util (hGetSome) import Network.HTTP.Conduit.Parser (parserHeadersFromByteString)-import Network.Socks5 (SocksConf, socksConnectWith)+import Network.Socks5 (SocksConf) import Data.Default import Data.Maybe (mapMaybe) import System.IO (Handle)@@ -110,9 +110,15 @@ One !a !UTCTime | Cons !a !Int !UTCTime !(NonEmptyList a) +-- | Hostname or resolved host address.+data ConnHost =+ HostName !Text |+ HostAddress !NS.HostAddress+ deriving (Eq, Show, Ord)+ -- | @ConnKey@ consists of a hostname, a port and a @Bool@ -- specifying whether to use SSL.-data ConnKey = ConnKey !Text !Int !Bool+data ConnKey = ConnKey !ConnHost !Int !Bool deriving (Eq, Show, Ord) takeSocket :: Manager -> ConnKey -> IO (Maybe ConnInfo)@@ -294,53 +300,47 @@ nonEmptyMapM_ f (Cons x _ _ l) = f x >> nonEmptyMapM_ f l getSocketConn- :: MonadResource m- => Manager+ :: Maybe NS.HostAddress -> String -> Int -> Maybe SocksConf -- ^ optional socks proxy- -> m (ConnRelease m, ConnInfo, ManagedConn)-getSocketConn man host' port' socksProxy' =- getManagedConn man (ConnKey (T.pack host') port' False) $- getSocket host' port' socksProxy' >>= socketConn desc+ -> IO ConnInfo+getSocketConn hostAddress' host' port' socksProxy' =+ getSocket hostAddress' host' port' socksProxy' >>= socketConn desc where desc = socketDesc host' port' "unsecured" socketDesc :: String -> Int -> String -> String socketDesc h p t = unwords [h, show p, t] -getSslConn :: MonadResource m- => ([X509] -> IO CertificateUsage)+getSslConn :: ([X509] -> IO CertificateUsage) -> [(X509, Maybe PrivateKey)]- -> Manager+ -> Maybe NS.HostAddress -> String -- ^ host -> Int -- ^ port -> Maybe SocksConf -- ^ optional socks proxy- -> m (ConnRelease m, ConnInfo, ManagedConn)-getSslConn checkCert clientCerts man host' port' socksProxy' =- getManagedConn man (ConnKey (T.pack host') port' True) $- (connectionTo host' (PortNumber $ fromIntegral port') socksProxy' >>= sslClientConn desc host' checkCert clientCerts)+ -> IO ConnInfo+getSslConn checkCert clientCerts hostAddress' host' port' socksProxy' =+ connectionTo hostAddress' host' port' socksProxy' >>= sslClientConn desc host' checkCert clientCerts where desc = socketDesc host' port' "secured" getSslProxyConn- :: MonadResource m- => ([X509] -> IO CertificateUsage)+ :: ([X509] -> IO CertificateUsage) -> [(X509, Maybe PrivateKey)] -> S8.ByteString -- ^ Target host -> Int -- ^ Target port- -> Manager+ -> Maybe NS.HostAddress -> String -- ^ Proxy host -> Int -- ^ Proxy port -> Maybe SocksConf -- ^ optional SOCKS proxy- -> m (ConnRelease m, ConnInfo, ManagedConn)-getSslProxyConn checkCert clientCerts thost tport man phost pport socksProxy' =- getManagedConn man (ConnKey (T.pack phost) pport True) $- doConnect >>= sslClientConn desc phost checkCert clientCerts+ -> IO ConnInfo+getSslProxyConn checkCert clientCerts thost tport phostAddr phost pport socksProxy' =+ doConnect >>= sslClientConn desc phost checkCert clientCerts where desc = socketDesc phost pport "secured-proxy" doConnect = do- h <- connectionTo phost (PortNumber $ fromIntegral pport) socksProxy'+ h <- connectionTo phostAddr phost pport socksProxy' L.hPutStr h $ Blaze.toLazyByteString connectRequest hFlush h r <- hGetSome h 2048@@ -423,10 +423,15 @@ -> Manager -> m (ConnRelease m, ConnInfo, ManagedConn) getConn req m =- go m connhost connport (socksProxy req)+ getManagedConn m (ConnKey connKeyHost connport (secure req)) $+ go connaddr connhost connport (socksProxy req) where h = host req (useProxy, connhost, connport) = getConnDest req+ (connaddr, connKeyHost) =+ case (hostAddress req, useProxy, socksProxy req) of+ (Just ha, False, Nothing) -> (Just ha, HostAddress ha)+ _ -> (Nothing, HostName $ T.pack connhost) go = case (secure req, useProxy) of (False, _) -> getSocketConn@@ -471,7 +476,6 @@ Nothing -> Map.singleton encoded expire Just m -> Map.insert encoded expire m -connectionTo :: HostName -> PortID -> Maybe SocksConf -> IO Handle-connectionTo host' port' Nothing = connectTo host' port'-connectionTo host' port' (Just socksConf) =- socksConnectWith socksConf host' port' >>= flip socketToHandle ReadWriteMode+connectionTo :: Maybe NS.HostAddress -> NS.HostName -> Int -> Maybe SocksConf -> IO Handle+connectionTo hostAddress' host' port' socksConf' =+ getSocket hostAddress' host' port' socksConf' >>= flip NS.socketToHandle ReadWriteMode
Network/HTTP/Conduit/Request.hs view
@@ -171,6 +171,7 @@ , method = "GET" , proxy = Nothing , socksProxy = Nothing+ , hostAddress = Nothing , rawBody = False , decompress = browserDecompress , redirectCount = 10
Network/HTTP/Conduit/Types.hs view
@@ -24,6 +24,7 @@ import qualified Data.ByteString.Lazy as L import qualified Network.HTTP.Types as W+import qualified Network.Socket as NS import Network.Socks5 (SocksConf) import Control.Exception (Exception, SomeException, IOException)@@ -95,6 +96,10 @@ -- ^ Optional HTTP proxy. , socksProxy :: Maybe SocksConf -- ^ Optional SOCKS proxy.+ , hostAddress :: Maybe NS.HostAddress+ -- ^ Optional resolved host address.+ --+ -- Since 1.8.9 , rawBody :: Bool -- ^ If @True@, a chunked and\/or gzipped body will not be -- decoded. Use with caution.
http-conduit.cabal view
@@ -1,5 +1,5 @@ name: http-conduit-version: 1.8.8+version: 1.8.9 license: BSD3 license-file: LICENSE author: Michael Snoyman <michael@snoyman.com>
test/main.hs view
@@ -18,6 +18,7 @@ import Network.HTTP.Conduit.ConnInfo import Network (withSocketsDo) import Network.Socket (sClose)+import qualified Network.BSD import CookieTest (cookieTest) import Data.Conduit.Network (runTCPServer, serverSettings, HostPreference (..), appSink, appSource, bindPort, serverAfterBind, ServerSettings) import qualified Data.Conduit.Network@@ -40,7 +41,10 @@ app :: Application app req = case pathInfo req of- [] -> return $ responseLBS status200 [] "homepage"+ [] ->+ if maybe False ("example.com:" `S.isPrefixOf`) $ lookup "host" $ Wai.requestHeaders req+ then return $ responseLBS status200 [] "homepage for example.com"+ else return $ responseLBS status200 [] "homepage" ["cookies"] -> return $ responseLBS status200 [tastyCookie] "cookies" ["cookie_redir1"] -> return $ responseLBS status303 [tastyCookie, (hLocation, "/checkcookie")] "" ["checkcookie"] -> return $ case lookup hCookie $ Wai.requestHeaders req of@@ -219,6 +223,14 @@ res1 <- httpLbs req manager res2 <- httpLbs req manager liftIO $ res1 @?= res2++ describe "hostAddress" $ do+ it "overrides host" $ withApp app $ \port -> do+ entry <- Network.BSD.getHostByName "127.0.0.1"+ req' <- parseUrl $ "http://example.com:" ++ show port+ let req = req' { hostAddress = Just $ Network.BSD.hostAddress entry }+ res <- withManager $ httpLbs req+ responseBody res @?= "homepage for example.com" withCApp :: Data.Conduit.Network.Application IO -> (Int -> IO ()) -> IO () withCApp app' f = do