diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,3 +1,8 @@ +## 0.5.3.1 + +* The closeConnection method for tls connections should not be called multiple + times [#225](https://github.com/snoyberg/http-client/issues/225) + ## 0.5.3 * Expose `makeConnection` and `socketConnection` as a stable API [#223](https://github.com/snoyberg/http-client/issues/223) 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 @@ -93,7 +93,12 @@ -- already closed connection. closedVar <- newIORef False - _ <- mkWeakIORef istack c + let close = do + closed <- atomicModifyIORef closedVar (\closed -> (True, closed)) + unless closed $ + c + + _ <- mkWeakIORef istack close return $! Connection { connectionRead = do closed <- readIORef closedVar @@ -113,11 +118,7 @@ when closed $ throwHttp ConnectionClosed w x - , connectionClose = do - closed <- readIORef closedVar - unless closed $ - c - writeIORef closedVar True + , connectionClose = close } -- | Create a new 'Connection' from a 'Socket'. 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.5.3 +version: 0.5.3.1 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 diff --git a/test-nonet/Network/HTTP/ClientSpec.hs b/test-nonet/Network/HTTP/ClientSpec.hs --- a/test-nonet/Network/HTTP/ClientSpec.hs +++ b/test-nonet/Network/HTTP/ClientSpec.hs @@ -2,13 +2,15 @@ {-# LANGUAGE ScopedTypeVariables #-} module Network.HTTP.ClientSpec where -import Control.Concurrent (forkIO, threadDelay) +import Control.Concurrent (threadDelay, yield) import Control.Concurrent.Async (withAsync) import qualified Control.Concurrent.Async as Async -import Control.Exception (bracket) -import Control.Monad (forever, replicateM_) +import Control.Exception (bracket, throwIO, ErrorCall(..)) +import qualified Control.Exception as E +import Control.Monad (forever, replicateM_, when, unless) import Network.HTTP.Client hiding (port) import qualified Network.HTTP.Client as NC +import qualified Network.HTTP.Client.Internal as Internal import Network.HTTP.Types (status413) import Network.Socket (sClose) import Test.Hspec @@ -16,10 +18,17 @@ import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as SL import Data.ByteString.Lazy.Char8 () -- orphan instance +import Data.IORef +import System.Mem (performGC) main :: IO () main = hspec spec +silentIOError :: IO () -> IO () +silentIOError a = a `E.catch` \e -> do + let _ = e :: IOError + return () + redirectServer :: (Int -> IO a) -> IO a redirectServer inner = bracket (N.bindRandomPortTCP "*4") @@ -28,13 +37,13 @@ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where - app ad = do - _ <- forkIO $ forever $ N.appRead ad - forever $ do + app ad = Async.race_ + (silentIOError $ forever (N.appRead ad)) + (silentIOError $ forever $ do N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\ncontent-length: 5\r\n\r\n" threadDelay 10000 N.appWrite ad "hello\r\n" - threadDelay 10000 + threadDelay 10000) redirectCloseServer :: (Int -> IO a) -> IO a redirectCloseServer inner = bracket @@ -46,8 +55,8 @@ where app ad = do Async.race_ - (forever (N.appRead ad)) - (N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\nConnection: close\r\n\r\nhello") + (silentIOError $ forever (N.appRead ad)) + (silentIOError $ N.appWrite ad "HTTP/1.1 301 Redirect\r\nLocation: /\r\nConnection: close\r\n\r\nhello") N.appCloseConnection ad bad100Server :: Bool -- ^ include extra headers? @@ -59,15 +68,15 @@ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where - app ad = do - _ <- forkIO $ forever $ N.appRead ad - forever $ do + app ad = Async.race_ + (silentIOError $ forever $ N.appRead ad) + (silentIOError $ forever $ do N.appWrite ad $ S.concat [ "HTTP/1.1 100 Continue\r\n" , if extraHeaders then "foo:bar\r\nbaz: bin\r\n" else "" , "\r\nHTTP/1.1 200 OK\r\ncontent-length: 5\r\n\r\nhello\r\n" ] - threadDelay 10000 + threadDelay 10000) earlyClose413 :: (Int -> IO a) -> IO a earlyClose413 inner = bracket @@ -77,7 +86,7 @@ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where - app ad = do + app ad = silentIOError $ do let readHeaders front = do newBS <- N.appRead ad let bs = S.append front newBS @@ -108,7 +117,7 @@ (N.runTCPServer (N.serverSettingsTCPSocket lsocket) app) (const $ inner port) where - app ad = do + app ad = silentIOError $ do let readHeaders front = do newBS <- N.appRead ad let bs = S.append front newBS @@ -203,7 +212,32 @@ let req = req' {redirectCount = 1} man <- newManager defaultManagerSettings withResponseHistory req man (const $ return ()) - `shouldThrow` \e -> - case e of - HttpExceptionRequest _ (TooManyRedirects _) -> True - _ -> False + `shouldThrow` \e -> + case e of + HttpExceptionRequest _ (TooManyRedirects _) -> True + _ -> False + + it "should not write to closed connection" $ do + -- see https://github.com/snoyberg/http-client/issues/225 + closedRef <- newIORef False + okRef <- newIORef True + let checkStatus = do + closed <- readIORef closedRef + when closed $ do + writeIORef okRef False + + conn <- makeConnection + (return S.empty) + (const checkStatus) + (checkStatus >> writeIORef closedRef True) + + Internal.connectionClose conn + + -- let GC release the connection and run finalizers + performGC + yield + performGC + + ok <- readIORef okRef + unless ok $ + throwIO (ErrorCall "already closed")