From f18f3ab039c79d6d0eadb39bcd1f8a114f952091 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Domen=20Ko=C5=BEar?= Date: Wed, 27 Dec 2023 15:21:01 +0000 Subject: [PATCH] if socket raises an exception that resource vanished, consider it closed --- src/Network/WebSockets/Stream.hs | 12 +++++++++--- websockets.cabal | 8 ++++---- 2 files changed, 13 insertions(+), 7 deletions(-) diff --git a/src/Network/WebSockets/Stream.hs b/src/Network/WebSockets/Stream.hs index 06cefe4..d799b7a 100644 --- a/src/Network/WebSockets/Stream.hs +++ b/src/Network/WebSockets/Stream.hs @@ -14,7 +14,7 @@ module Network.WebSockets.Stream import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, putMVar, takeMVar, withMVar) -import Control.Exception (SomeException, SomeAsyncException, throwIO, catch, fromException) +import Control.Exception (SomeException, SomeAsyncException, throwIO, catch, try, fromException) import Control.Monad (forM_) import qualified Data.Attoparsec.ByteString as Atto import qualified Data.Binary.Get as BIN @@ -31,6 +31,7 @@ import qualified Network.Socket.ByteString.Lazy as SBL (sendAll) #else import qualified Network.Socket.ByteString as SB (sendAll) #endif +import System.IO.Error (isResourceVanishedError) import Network.WebSockets.Types @@ -116,8 +117,13 @@ makeSocketStream :: S.Socket -> IO Stream makeSocketStream socket = makeStream receive send where receive = do - bs <- SB.recv socket 8192 - return $ if B.null bs then Nothing else Just bs + bs <- try $ SB.recv socket 8192 + case bs of + -- If the resource vanished, the socket was closed + Left e | isResourceVanishedError e -> return Nothing + | otherwise -> throwIO e + Right bs' | B.null bs' -> return Nothing + | otherwise -> return $ Just bs' send Nothing = return () send (Just bs) = do diff --git a/websockets.cabal b/websockets.cabal index 804c46a..133f8fc 100644 --- a/websockets.cabal +++ b/websockets.cabal @@ -82,7 +82,7 @@ Library Build-depends: async >= 2.2 && < 2.3, attoparsec >= 0.10 && < 0.15, - base >= 4.8 && < 5, + base >= 4.14 && < 5, base64-bytestring >= 0.1 && < 1.3, binary >= 0.8.1 && < 0.11, bytestring >= 0.9 && < 0.12, @@ -140,7 +140,7 @@ Test-suite websockets-tests -- Copied from regular dependencies... async >= 2.2 && < 2.3, attoparsec >= 0.10 && < 0.15, - base >= 4 && < 5, + base >= 4.14 && < 5, base64-bytestring >= 0.1 && < 1.3, binary >= 0.8.1 && < 0.11, bytestring >= 0.9 && < 0.12, @@ -200,7 +200,7 @@ Executable websockets-autobahn -- Copied from regular dependencies... async >= 2.2 && < 2.3, attoparsec >= 0.10 && < 0.15, - base >= 4 && < 5, + base >= 4.14 && < 5, base64-bytestring >= 0.1 && < 1.3, binary >= 0.8.1 && < 0.11, bytestring >= 0.9 && < 0.12, @@ -227,7 +227,7 @@ Benchmark bench-mask -- Copied from regular dependencies... async >= 2.2 && < 2.3, attoparsec >= 0.10 && < 0.15, - base >= 4 && < 5, + base >= 4.14 && < 5, base64-bytestring >= 0.1 && < 1.3, binary >= 0.8.1 && < 0.11, bytestring >= 0.9 && < 0.12,