diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,11 @@ # Changelog for http-client +## 0.7.11 + +* Allow making requests to raw IPv6 hosts [#477](https://github.com/snoyberg/http-client/pull/477) +* Catch "resource vanished" exception on initial response read [#480](https://github.com/snoyberg/http-client/pull/480) +* Search for reachable IP addresses asynchronously (RFC 6555, 8305) after calling `getAddrInfo` to reduce latency [#472](https://github.com/snoyberg/http-client/pull/472). + ## 0.7.10 * Consume trailers and last CRLF of chunked body. The trailers are not exposed, diff --git a/Network/HTTP/Client.hs b/Network/HTTP/Client.hs --- a/Network/HTTP/Client.hs +++ b/Network/HTTP/Client.hs @@ -203,12 +203,13 @@ , equivCookieJar , Proxy (..) , withConnection + , strippedHostName -- * Cookies , module Network.HTTP.Client.Cookies ) where import Network.HTTP.Client.Body -import Network.HTTP.Client.Connection (makeConnection, socketConnection) +import Network.HTTP.Client.Connection (makeConnection, socketConnection, strippedHostName) import Network.HTTP.Client.Cookies import Network.HTTP.Client.Core import Network.HTTP.Client.Manager @@ -223,7 +224,7 @@ import Network.HTTP.Types (statusCode) import GHC.Generics (Generic) import Data.Typeable (Typeable) -import Control.Exception (bracket, handle, throwIO) +import Control.Exception (bracket, catch, handle, throwIO) -- | A datatype holding information on redirected requests and the final response. -- @@ -270,6 +271,7 @@ Just req'' -> do writeIORef reqRef req'' body <- brReadSome (responseBody res) 1024 + `catch` handleClosedRead modifyIORef historyRef (. ((req, res { responseBody = body }):)) return (res, req'', True) (_, res) <- httpRedirect' (redirectCount reqOrig) go reqOrig diff --git a/Network/HTTP/Client/Connection.hs b/Network/HTTP/Client/Connection.hs --- a/Network/HTTP/Client/Connection.hs +++ b/Network/HTTP/Client/Connection.hs @@ -11,20 +11,26 @@ , makeConnection , socketConnection , withSocket + , strippedHostName ) where import Data.ByteString (ByteString, empty) import Data.IORef import Control.Monad +import Control.Concurrent +import Control.Concurrent.Async import Network.HTTP.Client.Types import Network.Socket (Socket, HostAddress) import qualified Network.Socket as NS import Network.Socket.ByteString (sendAll, recv) import qualified Control.Exception as E import qualified Data.ByteString as S -import Data.Word (Word8) +import Data.Foldable (for_) import Data.Function (fix) +import Data.Maybe (listToMaybe) +import Data.Word (Word8) + connectionReadLine :: Connection -> IO ByteString connectionReadLine conn = do bs <- connectionRead conn @@ -149,6 +155,24 @@ withSocket tweakSocket hostAddress' host' port' $ \ sock -> socketConnection sock chunksize +-- | strippedHostName takes a URI host name, as extracted +-- by 'Network.URI.regName', and strips square brackets +-- around IPv6 addresses. +-- +-- The result is suitable for passing to services such as +-- name resolution ('Network.Socket.getAddr'). +-- +-- @since +strippedHostName :: String -> String +strippedHostName hostName = + case hostName of + '[':'v':_ -> hostName -- IPvFuture, no obvious way to deal with this + '[':rest -> + case break (== ']') rest of + (ipv6, "]") -> ipv6 + _ -> hostName -- invalid host name + _ -> hostName + withSocket :: (Socket -> IO ()) -> Maybe HostAddress -> String -- ^ host @@ -159,7 +183,7 @@ let hints = NS.defaultHints { NS.addrSocketType = NS.Stream } addrs <- case hostAddress' of Nothing -> - NS.getAddrInfo (Just hints) (Just host') (Just $ show port') + NS.getAddrInfo (Just hints) (Just $ strippedHostName host') (Just $ show port') Just ha -> return [NS.AddrInfo @@ -184,10 +208,30 @@ NS.connect sock (NS.addrAddress addr) return sock) +-- Pick up an IP using an approximation of the happy-eyeballs algorithm: +-- https://datatracker.ietf.org/doc/html/rfc8305 +-- firstSuccessful :: [NS.AddrInfo] -> (NS.AddrInfo -> IO a) -> IO a -firstSuccessful [] _ = error "getAddrInfo returned empty list" -firstSuccessful (a:as) cb = - cb a `E.catch` \(e :: E.IOException) -> - case as of - [] -> E.throwIO e - _ -> firstSuccessful as cb +firstSuccessful [] _ = error "getAddrInfo returned empty list" +firstSuccessful addresses cb = do + result <- newEmptyMVar + either E.throwIO pure =<< + withAsync (tryAddresses result) + (\_ -> takeMVar result) + where + -- https://datatracker.ietf.org/doc/html/rfc8305#section-5 + connectionAttemptDelay = 250 * 1000 + + tryAddresses result = do + z <- forConcurrently (zip addresses [0..]) $ \(addr, n) -> do + when (n > 0) $ threadDelay $ n * connectionAttemptDelay + tryAddress addr + + case listToMaybe (reverse z) of + Just e@(Left _) -> tryPutMVar result e + _ -> error $ "tryAddresses invariant violated: " <> show addresses + where + tryAddress addr = do + r :: Either E.IOException a <- E.try $! cb addr + for_ r $ \_ -> tryPutMVar result r + pure r diff --git a/Network/HTTP/Client/Core.hs b/Network/HTTP/Client/Core.hs --- a/Network/HTTP/Client/Core.hs +++ b/Network/HTTP/Client/Core.hs @@ -12,6 +12,7 @@ , httpRedirect , httpRedirect' , withConnection + , handleClosedRead ) where import Network.HTTP.Types @@ -30,6 +31,7 @@ import Control.Monad (void) import System.Timeout (timeout) import Data.KeyedPool +import GHC.IO.Exception (IOException(..), IOErrorType(..)) -- | Perform a @Request@ using a connection acquired from the given @Manager@, -- and then provide the @Response@ to the given function. This function is @@ -235,6 +237,17 @@ (res, mbReq) <- http0 req' return (res, fromMaybe req0 mbReq, isJust mbReq) +handleClosedRead :: SomeException -> IO L.ByteString +handleClosedRead se + | Just ConnectionClosed <- fmap unHttpExceptionContentWrapper (fromException se) + = return L.empty + | Just (HttpExceptionRequest _ ConnectionClosed) <- fromException se + = return L.empty + | Just (IOError _ ResourceVanished _ _ _ _) <- fromException se + = return L.empty + | otherwise + = throwIO se + -- | Redirect loop. -- -- This extended version of 'httpRaw' also returns the Request potentially modified by @managerModifyRequest@. @@ -258,15 +271,7 @@ -- The connection may already be closed, e.g. -- when using withResponseHistory. See -- https://github.com/snoyberg/http-client/issues/169 - `Control.Exception.catch` \se -> - case () of - () - | Just ConnectionClosed <- - fmap unHttpExceptionContentWrapper - (fromException se) -> return L.empty - | Just (HttpExceptionRequest _ ConnectionClosed) <- - fromException se -> return L.empty - _ -> throwIO se + `Control.Exception.catch` handleClosedRead responseClose res -- And now perform the actual redirect diff --git a/Network/HTTP/Client/Types.hs b/Network/HTTP/Client/Types.hs --- a/Network/HTTP/Client/Types.hs +++ b/Network/HTTP/Client/Types.hs @@ -342,7 +342,7 @@ -- | Define a HTTP proxy, consisting of a hostname and port number. data Proxy = Proxy - { proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy. + { proxyHost :: S.ByteString -- ^ The host name of the HTTP proxy in URI format. IPv6 addresses in square brackets. , proxyPort :: Int -- ^ The port number of the HTTP proxy. } deriving (Show, Read, Eq, Ord, T.Typeable) @@ -493,6 +493,9 @@ , host :: S.ByteString -- ^ Requested host name, used for both the IP address to connect to and -- the @host@ request header. + -- + -- This is in URI format, with raw IPv6 addresses enclosed in square brackets. + -- Use 'strippedHostName' when making network connections. -- -- Since 0.1.0 , port :: Int diff --git a/http-client.cabal b/http-client.cabal --- a/http-client.cabal +++ b/http-client.cabal @@ -1,5 +1,5 @@ name: http-client -version: 0.7.10 +version: 0.7.11 synopsis: An HTTP client engine description: Hackage documentation generation is not reliable. For up to date documentation, please see: . homepage: https://github.com/snoyberg/http-client @@ -59,6 +59,7 @@ , ghc-prim , stm >= 2.3 , iproute >= 1.7.5 + , async if flag(network-uri) build-depends: network >= 2.6, network-uri >= 2.6 else @@ -87,6 +88,7 @@ hs-source-dirs: test default-language: Haskell2010 other-modules: Network.HTTP.ClientSpec + build-tool-depends: hspec-discover:hspec-discover build-depends: base , http-client , hspec @@ -121,6 +123,8 @@ Network.HTTP.Client.RequestSpec Network.HTTP.Client.RequestBodySpec Network.HTTP.Client.CookieSpec + Network.HTTP.Client.ConnectionSpec + build-tool-depends: hspec-discover:hspec-discover build-depends: base , http-client , hspec diff --git a/test-nonet/Network/HTTP/Client/ConnectionSpec.hs b/test-nonet/Network/HTTP/Client/ConnectionSpec.hs new file mode 100644 --- /dev/null +++ b/test-nonet/Network/HTTP/Client/ConnectionSpec.hs @@ -0,0 +1,23 @@ +module Network.HTTP.Client.ConnectionSpec where + +import Network.HTTP.Client (strippedHostName) +import Test.Hspec + +spec :: Spec +spec = do + describe "strippedHostName" $ do + it "passes along a normal domain name" $ do + strippedHostName "example.com" `shouldBe` "example.com" + it "passes along an IPv4 address" $ do + strippedHostName "127.0.0.1" `shouldBe` "127.0.0.1" + it "strips brackets of an IPv4 address" $ do + strippedHostName "[::1]" `shouldBe` "::1" + strippedHostName "[::127.0.0.1]" `shouldBe` "::127.0.0.1" + + describe "pathological cases" $ do + -- just need to handle these gracefully, it's unclear + -- what the result should be + it "doesn't touch future ip address formats" $ do + strippedHostName "[v2.huh]" `shouldBe` "[v2.huh]" + it "doesn't strip trailing stuff" $ do + strippedHostName "[::1]foo" `shouldBe` "[::1]foo" diff --git a/test/Network/HTTP/ClientSpec.hs b/test/Network/HTTP/ClientSpec.hs --- a/test/Network/HTTP/ClientSpec.hs +++ b/test/Network/HTTP/ClientSpec.hs @@ -6,6 +6,7 @@ import Network.HTTP.Client.Internal import Network.HTTP.Types (status200, found302, status405) import Network.HTTP.Types.Status +import qualified Network.Socket as NS import Test.Hspec import Control.Applicative ((<$>)) import Data.ByteString.Lazy.Char8 () -- orphan instance @@ -106,3 +107,23 @@ man <- newManager settings response <- httpLbs "http://httpbin.org/redirect-to?url=foo" man responseStatus response `shouldBe` found302 + + -- skipped because CI doesn't have working IPv6 + xdescribe "raw IPV6 address as hostname" $ do + it "works" $ do + -- We rely on example.com serving a web page over IPv6. + -- The request (currently) actually ends up as 404 due to + -- virtual hosting, but we just care that the networking + -- side works. + (addr:_) <- NS.getAddrInfo + (Just NS.defaultHints { NS.addrFamily = NS.AF_INET6 }) + (Just "example.com") + (Just "http") + -- ipv6Port will be of the form [::1]:80, which is good enough + -- for our purposes; ideally we'd easily get just the ::1. + let ipv6Port = show $ NS.addrAddress addr + ipv6Port `shouldStartWith` "[" + req <- parseUrlThrow $ "http://" ++ ipv6Port + man <- newManager defaultManagerSettings + _ <- httpLbs (setRequestIgnoreStatus req) man + return ()