summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMichaelSnoyman <>2013-02-20 06:27:35 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2013-02-20 06:27:35 (GMT)
commit88a30da3965d32bf581e3cc2e7c632cece8d8c58 (patch)
tree28930794fb544232f16366c439074ee6c42e6107
parent25d3397b55b55d39e7c8f9359cf52041d45688c4 (diff)
version 1.8.91.8.9
-rw-r--r--Network/HTTP/Conduit.hs1
-rw-r--r--Network/HTTP/Conduit/ConnInfo.hs21
-rw-r--r--Network/HTTP/Conduit/Manager.hs64
-rw-r--r--Network/HTTP/Conduit/Request.hs1
-rw-r--r--Network/HTTP/Conduit/Types.hs5
-rw-r--r--http-conduit.cabal2
-rw-r--r--test/main.hs14
7 files changed, 72 insertions, 36 deletions
diff --git a/Network/HTTP/Conduit.hs b/Network/HTTP/Conduit.hs
index 00a9112..3f0b711 100644
--- a/Network/HTTP/Conduit.hs
+++ b/Network/HTTP/Conduit.hs
@@ -91,6 +91,7 @@ module Network.HTTP.Conduit
, requestBody
, proxy
, socksProxy
+ , hostAddress
, rawBody
, decompress
, redirectCount
diff --git a/Network/HTTP/Conduit/ConnInfo.hs b/Network/HTTP/Conduit/ConnInfo.hs
index a9e6b4c..cec0671 100644
--- a/Network/HTTP/Conduit/ConnInfo.hs
+++ b/Network/HTTP/Conduit/ConnInfo.hs
@@ -156,15 +156,28 @@ sslClientConn _desc host onCerts clientCerts h = do
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)
diff --git a/Network/HTTP/Conduit/Manager.hs b/Network/HTTP/Conduit/Manager.hs
index c0ffcae..d7e09bc 100644
--- a/Network/HTTP/Conduit/Manager.hs
+++ b/Network/HTTP/Conduit/Manager.hs
@@ -7,6 +7,7 @@ module Network.HTTP.Conduit.Manager
( Manager
, ManagerSettings (..)
, ConnKey (..)
+ , ConnHost (..)
, newManager
, closeManager
, getConn
@@ -47,8 +48,7 @@ import Control.Concurrent (forkIO, threadDelay)
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.ConnInfo
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 @@ data NonEmptyList a =
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 (One x _) = f x
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 @@ getConn :: MonadResource m
-> 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 @@ checkCerts man host' certs = do
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
diff --git a/Network/HTTP/Conduit/Request.hs b/Network/HTTP/Conduit/Request.hs
index 4c4ddb0..6f4e7e5 100644
--- a/Network/HTTP/Conduit/Request.hs
+++ b/Network/HTTP/Conduit/Request.hs
@@ -171,6 +171,7 @@ instance Default (Request m) where
, method = "GET"
, proxy = Nothing
, socksProxy = Nothing
+ , hostAddress = Nothing
, rawBody = False
, decompress = browserDecompress
, redirectCount = 10
diff --git a/Network/HTTP/Conduit/Types.hs b/Network/HTTP/Conduit/Types.hs
index 60b805f..97ce589 100644
--- a/Network/HTTP/Conduit/Types.hs
+++ b/Network/HTTP/Conduit/Types.hs
@@ -24,6 +24,7 @@ import qualified Data.ByteString as S
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 @@ data Request m = Request
-- ^ 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.
diff --git a/http-conduit.cabal b/http-conduit.cabal
index d6eebce..6d32c5f 100644
--- a/http-conduit.cabal
+++ b/http-conduit.cabal
@@ -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>
diff --git a/test/main.hs b/test/main.hs
index 8f9153a..0a3605f 100644
--- a/test/main.hs
+++ b/test/main.hs
@@ -18,6 +18,7 @@ import qualified Control.Exception as E (catch)
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 @@ import Data.Monoid (mconcat)
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
@@ -220,6 +224,14 @@ main = withSocketsDo $ do
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
port <- getPort