http-client 0.5.3 → 0.5.3.1
raw patch · 4 files changed
+66/−26 lines, 4 files
Files
- ChangeLog.md +5/−0
- Network/HTTP/Client/Connection.hs +7/−6
- http-client.cabal +1/−1
- test-nonet/Network/HTTP/ClientSpec.hs +53/−19
ChangeLog.md view
@@ -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)
Network/HTTP/Client/Connection.hs view
@@ -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'.
http-client.cabal view
@@ -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: <http://www.stackage.org/package/http-client>. homepage: https://github.com/snoyberg/http-client
test-nonet/Network/HTTP/ClientSpec.hs view
@@ -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")