http-client 0.7.10 → 0.7.11
raw patch · 8 files changed
+129/−21 lines, 8 filesdep ~asyncdep ~base
Dependency ranges changed: async, base
Files
- ChangeLog.md +6/−0
- Network/HTTP/Client.hs +4/−2
- Network/HTTP/Client/Connection.hs +52/−8
- Network/HTTP/Client/Core.hs +14/−9
- Network/HTTP/Client/Types.hs +4/−1
- http-client.cabal +5/−1
- test-nonet/Network/HTTP/Client/ConnectionSpec.hs +23/−0
- test/Network/HTTP/ClientSpec.hs +21/−0
ChangeLog.md view
@@ -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,
Network/HTTP/Client.hs view
@@ -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
Network/HTTP/Client/Connection.hs view
@@ -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
Network/HTTP/Client/Core.hs view
@@ -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
Network/HTTP/Client/Types.hs view
@@ -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
http-client.cabal view
@@ -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: <http://www.stackage.org/package/http-client>. 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
+ test-nonet/Network/HTTP/Client/ConnectionSpec.hs view
@@ -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"
test/Network/HTTP/ClientSpec.hs view
@@ -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 ()