diff --git a/CHANGES b/CHANGES --- a/CHANGES +++ b/CHANGES @@ -1,3 +1,10 @@ +Version 4000.3.16: release 2021-03-20 + * Support GHC-9.0 (Oleg Genrus) + * Various dependency bumps (multiple people) + * Try all addresses returned by getAddrInfo (Fraser Tweedale) + +Version ? + * If the URI contains "user:pass@" part, use it for Basic Authorization * Add a test harness. * Don't leak a socket when getHostAddr throws an exception. diff --git a/HTTP.cabal b/HTTP.cabal --- a/HTTP.cabal +++ b/HTTP.cabal @@ -1,5 +1,5 @@ Name: HTTP -Version: 4000.3.15 +Version: 4000.3.16 Cabal-Version: >= 1.10 Build-type: Simple License: BSD3 @@ -56,7 +56,7 @@ Extra-Source-Files: CHANGES -tested-with: GHC==8.10.1, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 +tested-with: GHC==9.0.1, GHC==8.10.4, GHC==8.8.3, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2, GHC==7.2.2, GHC==7.0.4 Source-Repository head type: git @@ -109,9 +109,9 @@ -- note the test harness constraints should be kept in sync with these -- where dependencies are shared - Build-depends: base >= 4.3.0.0 && < 4.15, parsec >= 2.0 && < 3.2 - Build-depends: array >= 0.3.0.2 && < 0.6, bytestring >= 0.9.1.5 && < 0.11 - Build-depends: time >= 1.1.2.3 && < 1.11 + Build-depends: base >= 4.3.0.0 && < 4.16, parsec >= 2.0 && < 3.2 + Build-depends: array >= 0.3.0.2 && < 0.6, bytestring >= 0.9.1.5 && < 0.12 + Build-depends: time >= 1.1.2.3 && < 1.12 default-language: Haskell98 default-extensions: FlexibleInstances @@ -131,7 +131,7 @@ ghc-options: -Werror if os(windows) - Build-depends: Win32 >= 2.2.0.0 && < 2.10 + Build-depends: Win32 >= 2.2.0.0 && < 2.11 Test-Suite test type: exitcode-stdio-1.0 @@ -152,10 +152,10 @@ HUnit >= 1.2.0.1 && < 1.7, httpd-shed >= 0.4 && < 0.5, mtl >= 1.1.1.0 && < 2.3, - bytestring >= 0.9.1.5 && < 0.11, + bytestring >= 0.9.1.5 && < 0.12, deepseq >= 1.3.0.0 && < 1.5, pureMD5 >= 0.2.4 && < 2.2, - base >= 4.3.0.0 && < 4.15, + base >= 4.3.0.0 && < 4.16, split >= 0.1.3 && < 0.3, test-framework >= 0.2.0 && < 0.9, test-framework-hunit >= 0.3.0 && <0.4 @@ -171,7 +171,7 @@ case-insensitive >= 0.4.0.1 && < 1.3, http-types >= 0.8.0 && < 1.0, wai >= 2.1.0 && < 3.3, - warp >= 2.1.0 && < 3.3 + warp >= 2.1.0 && < 3.4 if flag(conduit10) build-depends: diff --git a/Network/HTTP.hs b/Network/HTTP.hs --- a/Network/HTTP.hs +++ b/Network/HTTP.hs @@ -205,7 +205,7 @@ getResponseBody (Left err) = fail (show err) getResponseBody (Right r) = return (rspBody r) --- | @getResponseBody response@ takes the response of a HTTP requesting action and +-- | @getResponseCode response@ takes the response of a HTTP requesting action and -- tries to extricate the status code of the 'Response' @response@. If the request action -- returned an error, an IO exception is raised. getResponseCode :: Result (Response ty) -> IO ResponseCode diff --git a/Network/TCP.hs b/Network/TCP.hs --- a/Network/TCP.hs +++ b/Network/TCP.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeSynonymInstances #-} ----------------------------------------------------------------------------- -- | @@ -61,7 +62,7 @@ import Data.Char ( toLower ) import Data.Word ( Word8 ) import Control.Concurrent -import Control.Exception ( onException ) +import Control.Exception ( IOException, bracketOnError, try ) import Control.Monad ( liftM, when ) import System.IO ( Handle, hFlush, IOMode(..), hClose ) import System.IO.Error ( isEOFError ) @@ -89,7 +90,7 @@ map toLower host1 == map toLower host2 && port1 == port2 data Conn a - = MkConn { connSock :: ! Socket + = MkConn { connSock :: !Socket , connHandle :: Handle , connBuffer :: BufferOp a , connInput :: Maybe a @@ -236,15 +237,37 @@ -- like this as it just does a once-only installation of a shutdown handler to run at program exit, -- rather than actually shutting down after the action addrinfos <- withSocketsDo $ getAddrInfo (Just $ defaultHints { addrFamily = AF_UNSPEC, addrSocketType = Stream }) (Just fixedUri) (Just . show $ port) + + let + connectAddrInfo a = bracketOnError + (socket (addrFamily a) Stream defaultProtocol) -- acquire + Network.Socket.close -- release + ( \s -> do + setSocketOption s KeepAlive 1 + connect s (addrAddress a) + socketConnection_ fixedUri port s stashInput ) + + -- try multiple addresses; return Just connected socket or Nothing + tryAddrInfos [] = return Nothing + tryAddrInfos (h:t) = + let next = \(_ :: IOException) -> tryAddrInfos t + in try (connectAddrInfo h) >>= either next (return . Just) + case addrinfos of [] -> fail "openTCPConnection: getAddrInfo returned no address information" - (a:_) -> do - s <- socket (addrFamily a) Stream defaultProtocol - onException (do - setSocketOption s KeepAlive 1 - connect s (addrAddress a) - socketConnection_ fixedUri port s stashInput - ) (Network.Socket.close s) + + -- single AddrInfo; call connectAddrInfo directly so that specific + -- exception is thrown in event of failure + [ai] -> connectAddrInfo ai `catchIO` (\e -> fail $ + "openTCPConnection: failed to connect to " + ++ show (addrAddress ai) ++ ": " ++ show e) + + -- multiple AddrInfos; try each until we get a connection, or run out + ais -> + let + err = fail $ "openTCPConnection: failed to connect; tried addresses: " + ++ show (fmap addrAddress ais) + in tryAddrInfos ais >>= maybe err return -- | @socketConnection@, like @openConnection@ but using a pre-existing 'Socket'. socketConnection :: BufferType ty