d8aceac · distributed-process

git.iko.soy/distributed-process

Output exceptional event after endpoint is closed

commitd8aceacc05cfd78eeeefcbfefc997b79e839d344 authorEdsko de Vries <edsko@edsko.net> dateWed 23 May 2012, 13:55 (14 years ago) parentecd82fc

4 files changed+44−17

compare with master

unifiedsplit

network-transport/src/Network/Transport/TCP.hs+15−10 network-transport/tests/TestAuxiliary.hs+6 network-transport/tests/TestTCP.hs−6 network-transport/tests/TestTransport.hs+23−1

network-transport/src/Network/Transport/TCP.hs+15−10

@@ -10,9 +10,6 @@

1010-- Applications that use the TCP transport should use

1111-- 'Network.Socket.withSocketsDo' in their main function for Windows

1212-- compatibility (see "Network.Socket").

13−--

14−-- TODOs:

15−-- * Output exception on channel after endpoint is closed

1613module Network.Transport.TCP ( -- * Main API

1714 createTransport

1815 -- * Internals (exposed for unit tests)

@@ -80,6 +77,7 @@ import Control.Monad.Error (ErrorT(..), runErrorT)

8077import Control.Exception ( IOException

8178 , SomeException

8279 , handle

80+ , throw

8381 , throwIO

8482 , try

8583 , bracketOnError

@@ -293,7 +291,7 @@ data ValidLocalEndPointState = ValidLocalEndPointState

293291--

294292-- INV-CLOSE: Whenever we put an endpoint in closed state we remove that

295293-- endpoint from localConnections first, so that if a concurrent thread reads

296−-- the mvar, finds EndPointClosed, and then looks up the endpoint in

294+-- the mvar, finds RemoteEndPointClosed, and then looks up the endpoint in

297295-- localConnections it is guaranteed to either find a different remote

298296-- endpoint, or else none at all.

299297-- INV-RESOLVE: Whenever we move a endpoint from Closing to Closed state, we

@@ -399,7 +397,9 @@ createTransportExposeInternals host port = do

399397 return

400398 ( Transport

401399 { newEndPoint = apiNewEndPoint transport

402− , closeTransport = let evs = [EndPointClosed] in

400+ , closeTransport = let evs = [ EndPointClosed

401+ , throw $ userError "Transport closed"

402+ ] in

403403 apiCloseTransport transport (Just tid) evs

404404 }

405405 , TransportInternals

@@ -410,8 +410,10 @@ createTransportExposeInternals host port = do

410410 where

411411 terminationHandler :: TCPTransport -> SomeException -> IO ()

412412 terminationHandler transport ex = do

413− let ev = ErrorEvent (TransportError EventTransportFailed (show ex))

414− apiCloseTransport transport Nothing [ev]

413+ let evs = [ ErrorEvent (TransportError EventTransportFailed (show ex))

414+ , throw $ userError "Transport closed"

415+ ]

416+ apiCloseTransport transport Nothing evs

415417

416418--------------------------------------------------------------------------------

417419-- API functions --

@@ -438,7 +440,10 @@ apiNewEndPoint transport = try $ do

438440 { receive = readChan (localChannel ourEndPoint)

439441 , address = localAddress ourEndPoint

440442 , connect = apiConnect ourEndPoint

441− , closeEndPoint = apiCloseEndPoint transport [EndPointClosed] ourEndPoint

443+ , closeEndPoint = let evs = [ EndPointClosed

444+ , throw $ userError "Endpoint closed"

445+ ] in

446+ apiCloseEndPoint transport evs ourEndPoint

442447 , newMulticastGroup = return . Left $ newMulticastGroupError

443448 , resolveMulticastGroup = return . Left . const resolveMulticastGroupError

444449 }

@@ -501,7 +506,7 @@ apiSend :: EndPointPair -- ^ Local and remote endpoint

501506 -> [ByteString] -- ^ Payload

502507 -> IO (Either (TransportError SendErrorCode) ())

503508apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =

504− -- The 'join' joins the inner exception that we explicitly return) for

509+ -- The 'join' joins the inner exception (which we explicitly return, for

505510 -- instance if the connection is closed) with the outer exception (which is

506511 -- returned by 'try' when an exception is thrown by 'sendOn', and handled

507512 -- by 'withRemoteState')

@@ -733,7 +738,7 @@ requestConnectionTo ourEndPoint theirAddress = go

733738 readMVar resolved >> go

734739

735740 RemoteEndPointClosed ->

736− -- EndPointClosed indicates that a concurrent thread was in the

741+ -- RemoteEndPointClosed indicates that a concurrent thread was in the

737742 -- process of closing the TCP connection to the remote endpoint when

738743 -- we obtained a reference to it. By INV-CLOSE we can assume that the

739744 -- remote endpoint will now have been removed from ourState, so we

network-transport/tests/TestAuxiliary.hs+6

@@ -80,3 +80,9 @@ instance Show err => Traceable (TransportError err) where

8080

8181instance Traceable EndPointAddress where

8282 trace = traceShow . endPointAddressToByteString

83+

84+instance Traceable SomeException where

85+ trace = traceShow

86+

87+instance Traceable ThreadId where

88+ trace = const Nothing

network-transport/tests/TestTCP.hs−6

@@ -57,15 +57,9 @@ instance Traceable N.Socket where

5757instance Traceable N.AddrInfo where

5858 trace = traceShow

5959

60−instance Traceable ThreadId where

61− trace = const Nothing

62−

6360instance Traceable TransportInternals where

6461 trace = const Nothing

6562

66−instance Traceable SomeException where

67− trace = traceShow

68−

6963-- Test that the server gets a ConnectionClosed message when the client closes

7064-- the socket without sending an explicit control message to the server first

7165testEarlyDisconnect :: IO N.ServiceName -> IO ()

network-transport/tests/TestTransport.hs+23−1

@@ -4,11 +4,12 @@ module TestTransport where

44import Prelude hiding (catch, (>>=), (>>), return, fail)

55import TestAuxiliary (forkTry, runTests)

66import Control.Concurrent.MVar (newEmptyMVar, takeMVar, putMVar, readMVar)

7+import Control.Exception (evaluate, try, SomeException)

78import Control.Monad (replicateM, replicateM_, when, guard, forM_)

89import Control.Monad.Error ()

910import Network.Transport hiding (connect)

1011import qualified Network.Transport as NT

11−import Network.Transport.Internal (tlog)

12+import Network.Transport.Internal (tlog, tryIO)

1213import Network.Transport.Util (spawn)

1314import Data.ByteString (ByteString)

1415import Data.ByteString.Char8 (pack)

@@ -734,6 +735,26 @@ testConnectClosedEndPoint transport = do

734735

735736 takeMVar clientDone

736737

738+-- | We should receive an exception when doing a 'receive' after we have been

739+-- notified that an endpoint has been closed

740+testExceptionOnReceive :: IO (Either String Transport) -> IO ()

741+testExceptionOnReceive newTransport = do

742+ Right transport <- newTransport

743+

744+ -- Test one: when we close an endpoint specifically

745+ Right endpoint1 <- newEndPoint transport

746+ closeEndPoint endpoint1

747+ EndPointClosed <- receive endpoint1

748+ Left _ <- (try :: IO a -> IO (Either SomeException a)) (receive endpoint1 >>= evaluate)

749+

750+ -- Test two: when we close the entire transport

751+ Right endpoint2 <- newEndPoint transport

752+ closeTransport transport

753+ EndPointClosed <- receive endpoint2

754+ Left _ <- (try :: IO a -> IO (Either SomeException a)) (receive endpoint2 >>= evaluate)

755+

756+ return ()

757+

737758-- Transport tests

738759testTransport :: IO (Either String Transport) -> IO ()

739760testTransport newTransport = do

@@ -753,6 +774,7 @@ testTransport newTransport = do

753774 , ("CloseEndPoint", testCloseEndPoint transport numPings)

754775 , ("CloseTransport", testCloseTransport newTransport)

755776 , ("ConnectClosedEndPoint", testConnectClosedEndPoint transport)

777+ , ("ExceptionOnReceive", testExceptionOnReceive newTransport)

756778 ]

757779 where

758780 numPings = 10000 :: Int