566d9bc · distributed-process

git.iko.soy/distributed-process

on master help sign in

Relax RELY conditions for send and close

566d9bcEdsko de Vries14 years ago

network-transport/src/Network/Transport/TCP.hs+16−8

compare with master

unifiedsplit

@@ -384,7 +384,7 @@ apiConnect ourEndPoint theirAddress _ = try $ do

384

385-- | Close a connection

386--

387−-- RELY: Remote endpoint must be in 'RemoteEndPointValid' or 'RemoteEndPointClosed'

387+-- RELY: The endpoint must not be invalid

388-- GUARANTEE: If the connection is alive on entry then the remote endpoint will

389-- either be RemoteEndPointValid or RemoteEndPointClosing. Otherwise, the state

390-- of the remote endpoint will not be changed.

@@ -405,14 +405,15 @@ apiClose theirEndPoint connId connAlive = void . tryIO $ do

405 RemoteEndPointClosed -> do

406 return st

407 RemoteEndPointClosing _ _ ->

408− fail "apiClose RELY violation"

408+ -- See discussion in apiSend why we must allow for this case

409+ return st

409 RemoteEndPointInvalid _ ->

410 RemoteEndPointInvalid _ ->

410 fail "apiClose RELY violation"

411 fail "apiClose RELY violation"

411 closeIfUnused theirEndPoint

412 closeIfUnused theirEndPoint

412

413

413-- | Send data across a connection

414-- | Send data across a connection

414--

415--

415−-- RELY: The remote endpoint must be in state 'RemoteEndPointValid' or 'RemoteEndPointClosed'

416+-- RELY: The endpoint must not be in invalid state.

416-- GUARANTEE: The state of the remote endpoint will not be changed.

417-- GUARANTEE: The state of the remote endpoint will not be changed.

417apiSend :: RemoteEndPoint -> ConnectionId -> IORef Bool -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

418apiSend :: RemoteEndPoint -> ConnectionId -> IORef Bool -> [ByteString] -> IO (Either (TransportError SendErrorCode) ())

418apiSend theirEndPoint connId connAlive payload = do

419apiSend theirEndPoint connId connAlive payload = do

@@ -423,9 +424,16 @@ apiSend theirEndPoint connId connAlive payload = do

423 then mapExceptionIO sendFailed $ sendOn vst (encodeInt32 connId : prependLength payload)

424 then mapExceptionIO sendFailed $ sendOn vst (encodeInt32 connId : prependLength payload)

424 else throw $ TransportError SendFailed "Connection closed"

425 else throw $ TransportError SendFailed "Connection closed"

425 RemoteEndPointClosed -> do

426 RemoteEndPointClosed -> do

426− return (Left $ TransportError SendFailed "Endpoint closed")

427+ return (Left $ TransportError SendFailed "Connection closed")

427 RemoteEndPointClosing _ _ ->

428 RemoteEndPointClosing _ _ ->

428− error "apiSend RELY violation"

429+ -- The only way for the endpoint to be in closing state, while a

430+ -- connection is still active, is for the application to call 'close'

431+ -- on the connection triggering "garbage collection" of the TCP channel

432+ -- (CloseSocket request to the remote endpoint) which hasn't completed

433+ -- yet. Even if the remote endpoint comes back with "please don't

434+ -- close", this still means that our *outgoing* connection has been

435+ -- closed

436+ return (Left $ TransportError SendFailed "Connection closed")

429 RemoteEndPointInvalid _ ->

437 RemoteEndPointInvalid _ ->

430 error "apiSend RELY violation"

438 error "apiSend RELY violation"

431 where

439 where

@@ -960,9 +968,9 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do

960 _ ->

968 _ ->

961 error "handleIncomingMessages RELY violation"

969 error "handleIncomingMessages RELY violation"

962 sendOn vst ( encodeInt32 ControlResponse

970 sendOn vst ( encodeInt32 ControlResponse

963− : encodeInt32 reqId

971+ : encodeInt32 reqId

964− : prependLength [encodeInt32 newId]

972+ : prependLength [encodeInt32 newId]

965− )

973+ )

966 -- We add the new connection ID to the list of open connections only once the

974 -- We add the new connection ID to the list of open connections only once the

967 -- endpoint has been notified of the new connection (sendOn may fail)

975 -- endpoint has been notified of the new connection (sendOn may fail)

968 return (RemoteEndPointValid vst)

976 return (RemoteEndPointValid vst)

network-transport/tests/TestAuxiliary.hs+1−1

@@ -32,7 +32,7 @@ runTest :: String -> IO () -> IO Bool

32runTest description test = do

33 putStr $ "Running " ++ show description ++ ": "

34 hFlush stdout

35− done <- try . timeout 10000000 $ test

35+ done <- try . timeout 20000000 $ test

36 case done of

37 Left err -> failed $ "(exception: " ++ show (err :: SomeException) ++ ")"

38 Right Nothing -> failed $ "(timeout)"

network-transport/tests/TestTransport.hs+39−33

@@ -374,7 +374,7 @@ testParallelConnects transport numPings = do

374

375-- | Test that sending on a closed connection gives an error

376testSendAfterClose :: Transport -> Int -> IO ()

377−testSendAfterClose transport _ = do

377+testSendAfterClose transport numRepeats = do

378 server <- spawn transport echoServer

379 clientDone <- newEmptyMVar

380

@@ -382,19 +382,22 @@ testSendAfterClose transport _ = do

382 Right endpoint <- newEndPoint transport

383

384 -- We request two lightweight connections

385+ replicateM numRepeats $ do

385− Right conn1 <- connect endpoint server ReliableOrdered

386+ Right conn1 <- connect endpoint server ReliableOrdered

386− Right conn2 <- connect endpoint server ReliableOrdered

387+ Right conn2 <- connect endpoint server ReliableOrdered

387−

388+

388− -- Close the second, but leave the first open; then output on the second

389+ -- Close the second, but leave the first open; then output on the second

389− -- connection (i.e., on a closed connection while there is still another

390+ -- connection (i.e., on a closed connection while there is still another

390− -- connection open)

391+ -- connection open)

391− close conn2

392+ close conn2

393+ Left (TransportError SendFailed _) <- send conn2 ["ping2"]

394+

395+ -- Now close the first connection, and output on it (i.e., output while

396+ -- there are no lightweight connection at all anymore)

397+ close conn1

392− Left (TransportError SendFailed _) <- send conn2 ["ping2"]

398+ Left (TransportError SendFailed _) <- send conn2 ["ping2"]

393

399

394− -- Now close the first connection, and output on it (i.e., output while

400+ return ()

395− -- there are no lightweight connection at all anymore)

396− close conn1

397− Left (TransportError SendFailed _) <- send conn2 ["ping2"]

398

401

399 putMVar clientDone ()

402 putMVar clientDone ()

400

403

@@ -402,32 +405,35 @@ testSendAfterClose transport _ = do

402

405

403-- | Test that closing the same connection twice has no effect

406-- | Test that closing the same connection twice has no effect

404testCloseTwice :: Transport -> Int -> IO ()

407testCloseTwice :: Transport -> Int -> IO ()

405−testCloseTwice transport _ = do

408+testCloseTwice transport numRepeats = do

406 server <- spawn transport echoServer

409 server <- spawn transport echoServer

407 clientDone <- newEmptyMVar

410 clientDone <- newEmptyMVar

408

411

409 forkTry $ do

412 forkTry $ do

410 Right endpoint <- newEndPoint transport

413 Right endpoint <- newEndPoint transport

411

414

415+ replicateM numRepeats $ do

412− -- We request two lightweight connections

416+ -- We request two lightweight connections

413− Right conn1 <- connect endpoint server ReliableOrdered

417+ Right conn1 <- connect endpoint server ReliableOrdered

414− Right conn2 <- connect endpoint server ReliableOrdered

418+ Right conn2 <- connect endpoint server ReliableOrdered

415−

419+

416− -- Close the second one twice

420+ -- Close the second one twice

417− close conn2

421+ close conn2

418− close conn2

422+ close conn2

419−

423+

420− -- Then send a message on the first and close that too

424+ -- Then send a message on the first and close that twice too

421− send conn1 ["ping"]

425+ send conn1 ["ping"]

422− close conn1

426+ close conn1

423−

424− -- Verify expected response from the echo server

425− ConnectionOpened cid1 _ _ <- receive endpoint

426− ConnectionOpened cid2 _ _ <- receive endpoint

427− ConnectionClosed cid2' <- receive endpoint ; True <- return $ cid2' == cid2

428− Received cid1' ["ping"] <- receive endpoint ; True <- return $ cid1' == cid1

429− ConnectionClosed cid1'' <- receive endpoint ; True <- return $ cid1'' == cid1

430

427

428+ -- Verify expected response from the echo server

429+ ConnectionOpened cid1 _ _ <- receive endpoint

430+ ConnectionOpened cid2 _ _ <- receive endpoint

431+ ConnectionClosed cid2' <- receive endpoint ; True <- return $ cid2' == cid2

432+ Received cid1' ["ping"] <- receive endpoint ; True <- return $ cid1' == cid1

433+ ConnectionClosed cid1'' <- receive endpoint ; True <- return $ cid1'' == cid1

434+

435+ return ()

436+

431 putMVar clientDone ()

437 putMVar clientDone ()

432

438

433 takeMVar clientDone

439 takeMVar clientDone

@@ -722,7 +728,7 @@ testTransport newTransport = do

722 , ("ConnectToSelf", testConnectToSelf transport numPings)

728 , ("ConnectToSelf", testConnectToSelf transport numPings)

723 , ("ConnectToSelfTwice", testConnectToSelfTwice transport numPings)

729 , ("ConnectToSelfTwice", testConnectToSelfTwice transport numPings)

724 , ("CloseEndPoint", testCloseEndPoint transport numPings)

730 , ("CloseEndPoint", testCloseEndPoint transport numPings)

725− , ("CloseTransport", testCloseTransport newTransport)

731+ , ("CloseTransport", testCloseTransport newTransport)

726 ]

732 ]

727 where

733 where

728 numPings = 10000 :: Int

734 numPings = 10000 :: Int