git.iko.soy/distributed-process
on master help sign in
Don't close connection on asynchronous exception
d714295Edsko de Vries
network-transport/src/Network/Transport/Internal.hs+2−2
compare with master
unifiedsplit
@@ -9,9 +9,9 @@ module Network.Transport.Internal ( -- * Encoders/decoders
9 , mapIOException
9 , mapIOException
10 , tryIO
10 , tryIO
11 , tryToEnum
11 , tryToEnum
12− -- * Replicated functionality from "base"
12+ -- * Replicated functionality from "base"
13 , void
13 , void
14− , forkIOWithUnmask
14+ , forkIOWithUnmask
15 -- * Debugging
15 -- * Debugging
16 , tlog
16 , tlog
17 ) where
17 ) where
network-transport/src/Network/Transport/TCP.hs+11−8
@@ -84,6 +84,7 @@ import Control.Exception ( IOException
84 , mask
84 , mask
85 , mask_
85 , mask_
86 , onException
86 , onException
87+ , fromException
87 )
88 )
88import Data.IORef (IORef, newIORef, writeIORef, readIORef)
89import Data.IORef (IORef, newIORef, writeIORef, readIORef)
89import Data.ByteString (ByteString)
90import Data.ByteString (ByteString)
@@ -542,7 +543,7 @@ apiCloseEndPoint transport evs ourEndPoint = do
542 -- TODO: should we signal on resolved here?
543 -- TODO: should we signal on resolved here?
543 tryCloseSocket (remoteSocket conn)
544 tryCloseSocket (remoteSocket conn)
544 return RemoteEndPointClosed
545 return RemoteEndPointClosed
545− RemoteEndPointClosed ->
546+ RemoteEndPointClosed ->
546 return RemoteEndPointClosed
547 return RemoteEndPointClosed
547
548
548-- | Special case of 'apiConnect': connect an endpoint to itself
549-- | Special case of 'apiConnect': connect an endpoint to itself
@@ -1031,7 +1032,7 @@ remoteStateIdentity =
1031 , caseClosed = return RemoteEndPointClosed
1032 , caseClosed = return RemoteEndPointClosed
1032 }
1033 }
1033
1034
1034−-- | Like modifyMVar, but if an exception occurs don't restore the remote
1035+-- | Like modifyMVar, but if an I/O exception occurs don't restore the remote
1035-- endpoint to its original value but close it instead
1036-- endpoint to its original value but close it instead
1036modifyRemoteState :: EndPointPair
1037modifyRemoteState :: EndPointPair
1037 -> RemoteStatePatternMatch (RemoteState, a)
1038 -> RemoteStatePatternMatch (RemoteState, a)
@@ -1046,8 +1047,11 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
1046 Right (st', a) -> do
1047 Right (st', a) -> do
1047 putMVar theirState st'
1048 putMVar theirState st'
1048 return a
1049 return a
1049− Left ex ->
1050+ Left ex -> do
1050− handleException ex vst
1051+ case fromException ex of
1052+ Just ioEx -> handleIOException ioEx vst
1053+ Nothing -> putMVar theirState st
1054+ throw ex
1051 -- The other cases are less interesting, because unless the endpoint is
1055 -- The other cases are less interesting, because unless the endpoint is
1052 -- in Valid state we're not supposed to do any IO on it
1056 -- in Valid state we're not supposed to do any IO on it
1053 RemoteEndPointClosing resolved vst -> do
1057 RemoteEndPointClosing resolved vst -> do
@@ -1069,8 +1073,8 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
1069 theirState :: MVar RemoteState
1073 theirState :: MVar RemoteState
1070 theirState = remoteState theirEndPoint
1074 theirState = remoteState theirEndPoint
1071
1075
1072− handleException :: SomeException -> ValidRemoteEndPointState -> IO a
1076+ handleIOException :: IOException -> ValidRemoteEndPointState -> IO ()
1073− handleException ex vst = do
1077+ handleIOException ex vst = do
1074 tryCloseSocket (remoteSocket vst)
1078 tryCloseSocket (remoteSocket vst)
1075 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1079 removeRemoteEndPoint (ourEndPoint, theirEndPoint)
1076 putMVar theirState RemoteEndPointClosed
1080 putMVar theirState RemoteEndPointClosed
@@ -1078,7 +1082,6 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
1078 code = EventConnectionLost (remoteAddress theirEndPoint) incoming
1082 code = EventConnectionLost (remoteAddress theirEndPoint) incoming
1079 err = TransportError code (show ex)
1083 err = TransportError code (show ex)
1080 writeChan (localChannel ourEndPoint) $ ErrorEvent err
1084 writeChan (localChannel ourEndPoint) $ ErrorEvent err
1081− throwIO ex
1082
1085
1083-- | Like 'modifyRemoteState' but without a return value
1086-- | Like 'modifyRemoteState' but without a return value
1084modifyRemoteState_ :: EndPointPair
1087modifyRemoteState_ :: EndPointPair
@@ -1330,7 +1333,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1330
1333
1331 -- Close the socket (if we don't have any outgoing connections)
1334 -- Close the socket (if we don't have any outgoing connections)
1332 closeSocket :: N.Socket -> IO Bool
1335 closeSocket :: N.Socket -> IO Bool
1333− closeSocket sock = do
1336+ closeSocket sock =
1334 modifyMVar theirState $ \st ->
1337 modifyMVar theirState $ \st ->
1335 case st of
1338 case st of
1336 RemoteEndPointInvalid _ ->
1339 RemoteEndPointInvalid _ ->