dbe9556 · distributed-process

git.iko.soy/distributed-process

on master help sign in

Code cleanup

dbe9556Edsko de Vries14 years ago

network-transport/src/Network/Transport/Internal.hs+19−14

compare with master

unifiedsplit

@@ -30,6 +30,7 @@ import Control.Exception ( IOException

30 , Exception

31 , catch

32 , try

33+ , throw

33 , throwIO

34 , throwIO

34 )

35 )

35import Control.Concurrent (ThreadId, forkIO)

36import Control.Concurrent (ThreadId, forkIO)

@@ -48,13 +49,15 @@ encodeInt32 i32 =

48 pokeByteOff p 0 (htonl . fromIntegral . fromEnum $ i32)

49 pokeByteOff p 0 (htonl . fromIntegral . fromEnum $ i32)

50-- | Deserialize 32-bit from network byte order

51-- | Deserialize 32-bit from network byte order

52+-- Throws an IO exception if this is not a valid integer.

51−decodeInt32 :: Num a => ByteString -> Maybe a

53+decodeInt32 :: Num a => ByteString -> a

52−decodeInt32 bs | BS.length bs /= 4 = Nothing

54+decodeInt32 bs

55+ | BS.length bs /= 4 = throw $ userError "decodeInt32: Invalid length"

53−decodeInt32 bs = Just . BSI.inlinePerformIO $ do

56+ | otherwise = BSI.inlinePerformIO $ do

54− let (fp, _, _) = BSI.toForeignPtr bs

57+ let (fp, _, _) = BSI.toForeignPtr bs

55− withForeignPtr fp $ \p -> do

58+ withForeignPtr fp $ \p -> do

56− w32 <- peekByteOff p 0

59+ w32 <- peekByteOff p 0

57− return (fromIntegral . ntohl $ w32)

60+ return (fromIntegral . ntohl $ w32)

59-- | Serialize 16-bit to network byte order

62-- | Serialize 16-bit to network byte order

60encodeInt16 :: Enum a => a -> ByteString

63encodeInt16 :: Enum a => a -> ByteString

@@ -63,13 +66,15 @@ encodeInt16 i16 =

63 pokeByteOff p 0 (htons . fromIntegral . fromEnum $ i16)

66 pokeByteOff p 0 (htons . fromIntegral . fromEnum $ i16)

65-- | Deserialize 16-bit from network byte order

68-- | Deserialize 16-bit from network byte order

69+-- Throws an IO exception if this is not a valid integer

66−decodeInt16 :: Num a => ByteString -> Maybe a

70+decodeInt16 :: Num a => ByteString -> a

67−decodeInt16 bs | BS.length bs /= 2 = Nothing

71+decodeInt16 bs

72+ | BS.length bs /= 2 = throw $ userError "decodeInt16: Invalid length"

68−decodeInt16 bs = Just . BSI.inlinePerformIO $ do

73+ | otherwise = BSI.inlinePerformIO $ do

69− let (fp, _, _) = BSI.toForeignPtr bs

74+ let (fp, _, _) = BSI.toForeignPtr bs

70− withForeignPtr fp $ \p -> do

75+ withForeignPtr fp $ \p -> do

71− w16 <- peekByteOff p 0

76+ w16 <- peekByteOff p 0

72− return (fromIntegral . ntohs $ w16)

77+ return (fromIntegral . ntohs $ w16)

74-- | Prepend a list of bytestrings with their total length

79-- | Prepend a list of bytestrings with their total length

75prependLength :: [ByteString] -> [ByteString]

80prependLength :: [ByteString] -> [ByteString]

network-transport/src/Network/Transport/Internal/TCP.hs+3−6

@@ -27,8 +27,9 @@ import qualified Network.Socket as N ( HostName

27 )

28import qualified Network.Socket.ByteString as NBS (recv)

29import Control.Concurrent (ThreadId)

30−import Control.Monad (liftM, forever)

30+import Control.Monad (forever)

31import Control.Exception (SomeException, catch, bracketOnError, throwIO, mask_)

32+import Control.Applicative ((<$>))

32import Data.ByteString (ByteString)

33import Data.ByteString (ByteString)

33import qualified Data.ByteString as BS (length, concat, null)

34import qualified Data.ByteString as BS (length, concat, null)

34import Data.Int (Int32)

35import Data.Int (Int32)

@@ -82,11 +83,7 @@ recvWithLength sock = recvInt32 sock >>= recvExact sock

83-- | Receive a 32-bit integer

84-- | Receive a 32-bit integer

84recvInt32 :: Num a => N.Socket -> IO a

85recvInt32 :: Num a => N.Socket -> IO a

85−recvInt32 sock = do

86− mi <- liftM (decodeInt32 . BS.concat) $ recvExact sock 4

86+recvInt32 sock = decodeInt32 . BS.concat <$> recvExact sock 4

87− case mi of

88− Nothing -> throwIO (userError "Invalid integer")

89− Just i -> return i

91-- | Close a socket, ignoring I/O exceptions

88-- | Close a socket, ignoring I/O exceptions

92tryCloseSocket :: N.Socket -> IO ()

89tryCloseSocket :: N.Socket -> IO ()

network-transport/src/Network/Transport/TCP.hs+70−81

@@ -73,7 +73,6 @@ import Control.Concurrent.MVar ( MVar

73import Control.Category ((>>>))

74import Control.Applicative ((<$>))

75import Control.Monad (when, unless)

76−import Control.Monad.Error (ErrorT(..), runErrorT)

77import Control.Exception ( IOException

76import Control.Exception ( IOException

78 , SomeException

77 , SomeException

79 , handle

78 , handle

@@ -374,7 +373,7 @@ data TransportInternals = TransportInternals

374 -- | Find the socket between a local and a remote endpoint

373 -- | Find the socket between a local and a remote endpoint

375 , socketBetween :: EndPointAddress

374 , socketBetween :: EndPointAddress

376 -> EndPointAddress

375 -> EndPointAddress

377− -> IO (Either String N.Socket)

376+ -> IO N.Socket

378 }

377 }

379

378

380--------------------------------------------------------------------------------

379--------------------------------------------------------------------------------

@@ -626,39 +625,38 @@ connectToSelf ourEndPoint = try . mapIOException connectFailed $ do

626--------------------------------------------------------------------------------

625--------------------------------------------------------------------------------

627

626

628-- Find a socket between two endpoints

627-- Find a socket between two endpoints

628+--

629+-- Throws an IO exception if the socket could not be found.

629internalSocketBetween :: TCPTransport -- ^ Transport

630internalSocketBetween :: TCPTransport -- ^ Transport

630 -> EndPointAddress -- ^ Local endpoint

631 -> EndPointAddress -- ^ Local endpoint

631 -> EndPointAddress -- ^ Remote endpoint

632 -> EndPointAddress -- ^ Remote endpoint

632− -> IO (Either String N.Socket)

633+ -> IO N.Socket

633−internalSocketBetween transport ourAddress theirAddress = runErrorT $ do

634+internalSocketBetween transport ourAddress theirAddress = do

634− ourEndPoint <- ErrorT $

635− withMVar (transportState transport) $ \st -> case st of

635+ ourEndPoint <- withMVar (transportState transport) $ \st -> case st of

636 TransportClosed ->

637− return . Left $ "Transport closed"

637+ throwIO $ userError "Transport closed"

638 TransportValid vst ->

639 case vst ^. localEndPointAt ourAddress of

640− Nothing -> return . Left $ "Local endpoint not found"

640+ Nothing -> throwIO $ userError "Local endpoint not found"

641− Just ep -> return . Right $ ep

641+ Just ep -> return ep

642− theirEndPoint <- ErrorT $

643− withMVar (localState ourEndPoint) $ \st -> case st of

642+ theirEndPoint <- withMVar (localState ourEndPoint) $ \st -> case st of

644 LocalEndPointClosed ->

643 LocalEndPointClosed ->

645− return . Left $ "Local endpoint closed"

644+ throwIO $ userError "Local endpoint closed"

646 LocalEndPointValid vst ->

645 LocalEndPointValid vst ->

647 case vst ^. localConnectionTo theirAddress of

646 case vst ^. localConnectionTo theirAddress of

648− Nothing -> return . Left $ "Remote endpoint not found"

647+ Nothing -> throwIO $ userError "Remote endpoint not found"

649− Just ep -> return . Right $ ep

648+ Just ep -> return ep

650− ErrorT $

651− withMVar (remoteState theirEndPoint) $ \st -> case st of

649+ withMVar (remoteState theirEndPoint) $ \st -> case st of

652− RemoteEndPointInit _ ->

650+ RemoteEndPointInit _ ->

653− return . Left $ "Remote endpoint not yet initialized"

651+ throwIO $ userError "Remote endpoint not yet initialized"

654− RemoteEndPointValid vst ->

652+ RemoteEndPointValid vst ->

655− return . Right $ remoteSocket vst

653+ return $ remoteSocket vst

656− RemoteEndPointClosing _ vst ->

654+ RemoteEndPointClosing _ vst ->

657− return . Right $ remoteSocket vst

655+ return $ remoteSocket vst

658− RemoteEndPointClosed ->

656+ RemoteEndPointClosed ->

659− return . Left $ "Remote endpoint closed"

657+ throwIO $ userError "Remote endpoint closed"

660− RemoteEndPointInvalid _ ->

658+ RemoteEndPointInvalid _ ->

661− return . Left $ "Remote endpoint invalid"

659+ throwIO $ userError "Remote endpoint invalid"

662

660

663--------------------------------------------------------------------------------

661--------------------------------------------------------------------------------

664-- Lower level functionality --

662-- Lower level functionality --

@@ -708,35 +706,25 @@ createLocalEndPoint transport = do

708requestConnectionTo :: LocalEndPoint

706requestConnectionTo :: LocalEndPoint

709 -> EndPointAddress

707 -> EndPointAddress

710 -> IO (RemoteEndPoint, ConnectionId)

708 -> IO (RemoteEndPoint, ConnectionId)

711−requestConnectionTo ourEndPoint theirAddress = go

709+requestConnectionTo ourEndPoint theirAddress = do

710+ (theirEndPoint, isNew) <- mapIOException connectFailed $

711+ findRemoteEndPoint ourEndPoint theirAddress BlockOnInit

712+ (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)))

713+

714+ -- If this is a new endpoint, start the initialization process and wait

715+ forM_ isNew $ \resolved -> do

716+ void . forkEndPointThread ourEndPoint $ do

717+ let outgoing = 1

718+ setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing

719+ readMVar resolved

720+

721+ reply <- mapIOException connectFailed $

722+ doRemoteRequest (ourEndPoint, theirEndPoint) RequestConnectionId

723+ return (theirEndPoint, decodeInt32 . BS.concat $ reply)

712 where

724 where

713− go = do

714− (theirEndPoint, isNew) <- mapIOException connectFailed $

715− findRemoteEndPoint ourEndPoint theirAddress True

716− (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)))

717−

718− -- If this is a new endpoint, start the initialization process and wait

719− forM_ isNew $ \resolved -> do

720− void . forkEndPointThread ourEndPoint $ do

721− let outgoing = 1

722− setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing

723− readMVar resolved

724−

725− reply <- mapIOException connectFailed $

726− doRemoteRequest (ourEndPoint, theirEndPoint) RequestConnectionId

727− case decodeInt32 . BS.concat $ reply of

728− Nothing ->

729− throwIO (connectFailed $ userError "Invalid integer")

730− Just cid ->

731− return (theirEndPoint, cid)

732−

733 connectFailed = TransportError ConnectFailed . show

725 connectFailed = TransportError ConnectFailed . show

734

726

735-- | Set up a remote endpoint

727-- | Set up a remote endpoint

736−--

737−-- RELY: The state of the remote endpoint must be uninitialized.

738−-- GUARANTEE: Will only change the state to RemoteEndPointValid or

739−-- RemoteEndPointInvalid.

740setupRemoteEndPoint :: EndPointPair -- ^ Local endpoint, remote endpoint

728setupRemoteEndPoint :: EndPointPair -- ^ Local endpoint, remote endpoint

741 -> Int -- ^ Initial (outgoing) refcount

729 -> Int -- ^ Initial (outgoing) refcount

742 -> IO ()

730 -> IO ()

@@ -751,9 +739,7 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing = do

751 , _remoteIncoming = IntSet.empty

739 , _remoteIncoming = IntSet.empty

752 , sendOn = sendMany sock

740 , sendOn = sendMany sock

753 }

741 }

754− modifyMVar_ theirState $ \(RemoteEndPointInit resolved) -> do

755− putMVar resolved ()

756− return (RemoteEndPointValid vst)

742+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointValid vst)

757 return True

743 return True

758 Right (sock, ConnectionRequestInvalid) -> do

744 Right (sock, ConnectionRequestInvalid) -> do

759 -- We remove the endpoint from our local state again because the next

745 -- We remove the endpoint from our local state again because the next

@@ -763,9 +749,7 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing = do

763 -- connection requests.

749 -- connection requests.

764 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

750 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

765 let err = invalidAddress "Invalid endpoint"

751 let err = invalidAddress "Invalid endpoint"

766− modifyMVar_ theirState $ \(RemoteEndPointInit resolved) -> do

767− putMVar resolved ()

768− return (RemoteEndPointInvalid err)

752+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointInvalid err)

769 tryCloseSocket sock

753 tryCloseSocket sock

770 return False

754 return False

771 Right (sock, ConnectionRequestCrossed) -> do

755 Right (sock, ConnectionRequestCrossed) -> do

@@ -775,9 +759,7 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing = do

775 return False

759 return False

776 Left err -> do

760 Left err -> do

777 removeRemoteEndPoint (ourEndPoint, theirEndPoint) -- See comment above

761 removeRemoteEndPoint (ourEndPoint, theirEndPoint) -- See comment above

778− modifyMVar_ theirState $ \(RemoteEndPointInit resolved) -> do

779− putMVar resolved ()

780− return (RemoteEndPointInvalid err)

762+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointInvalid err)

781 return False

763 return False

782

764

783 -- If we get to this point without an exception, then

765 -- If we get to this point without an exception, then

@@ -800,14 +782,12 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing = do

800 onError result = do

782 onError result = do

801 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

783 removeRemoteEndPoint (ourEndPoint, theirEndPoint)

802 case result of

784 case result of

803− Left err -> do

785+ Left err ->

804− tryPutMVar theirState (RemoteEndPointInvalid err)

786+ void $ tryPutMVar theirState (RemoteEndPointInvalid err)

805− return ()

806 Right (sock, _) -> do

787 Right (sock, _) -> do

807 let err = failed "setupRemoteEndPoint failed"

788 let err = failed "setupRemoteEndPoint failed"

808 tryPutMVar theirState (RemoteEndPointInvalid err)

789 tryPutMVar theirState (RemoteEndPointInvalid err)

809 tryCloseSocket sock

790 tryCloseSocket sock

810− return ()

811

791

812 failed = TransportError ConnectFailed

792 failed = TransportError ConnectFailed

813 ourAddress = localAddress ourEndPoint

793 ourAddress = localAddress ourEndPoint

@@ -815,6 +795,21 @@ setupRemoteEndPoint (ourEndPoint, theirEndPoint) outgoing = do

815 theirState = remoteState theirEndPoint

795 theirState = remoteState theirEndPoint

816 invalidAddress = TransportError ConnectNotFound

796 invalidAddress = TransportError ConnectNotFound

817

797

798+resolveInit :: EndPointPair -> RemoteState -> IO ()

799+resolveInit (ourEndPoint, theirEndPoint) newState =

800+ modifyMVar_ (remoteState theirEndPoint) $ \st -> case st of

801+ RemoteEndPointInvalid _ ->

802+ relyViolation (ourEndPoint, theirEndPoint) "resolveInit (invalid)"

803+ RemoteEndPointInit resolved -> do

804+ putMVar resolved ()

805+ return newState

806+ RemoteEndPointClosed ->

807+ throwIO $ userError "Remote endpoint closed"

808+ RemoteEndPointClosing _ _ ->

809+ relyViolation (ourEndPoint, theirEndPoint) "resolveInit (closing)"

810+ RemoteEndPointValid _ ->

811+ relyViolation (ourEndPoint, theirEndPoint) "resolveInit (valid)"

812+

818-- | Establish a connection to a remote endpoint

813-- | Establish a connection to a remote endpoint

819socketToEndPoint :: EndPointAddress -- ^ Our address

814socketToEndPoint :: EndPointAddress -- ^ Our address

820 -> EndPointAddress -- ^ Their address

815 -> EndPointAddress -- ^ Their address

@@ -904,9 +899,6 @@ decodeEndPointAddress (EndPointAddress bs) =

904

899

905-- | Do a (blocking) remote request

900-- | Do a (blocking) remote request

906--

901--

907−-- RELY: Remote endpoint must be in valid or closed state.

908−-- GUARANTEE: Will not change the state of the remote endpoint.

909−--

910-- May throw IO (user) exception if the local or the remote endpoint is closed,

902-- May throw IO (user) exception if the local or the remote endpoint is closed,

911-- or if the send fails.

903-- or if the send fails.

912doRemoteRequest :: EndPointPair -> ControlHeader -> IO [ByteString]

904doRemoteRequest :: EndPointPair -> ControlHeader -> IO [ByteString]

@@ -1147,7 +1139,7 @@ handleConnectionRequest transport sock = handle handleException $ do

1147 go ourEndPoint theirAddress = do

1139 go ourEndPoint theirAddress = do

1148 mEndPoint <- handle ((>> return Nothing) . invalidEndPoint) $ do

1140 mEndPoint <- handle ((>> return Nothing) . invalidEndPoint) $ do

1149 (theirEndPoint, isNew) <-

1141 (theirEndPoint, isNew) <-

1150− findRemoteEndPoint ourEndPoint theirAddress False

1142+ findRemoteEndPoint ourEndPoint theirAddress DontBlockOnInit

1151 (throw $ userError "Already connected")

1143 (throw $ userError "Already connected")

1152

1144

1153 let ourAddress = localAddress ourEndPoint

1145 let ourAddress = localAddress ourEndPoint

@@ -1166,9 +1158,7 @@ handleConnectionRequest transport sock = handle handleException $ do

1166 , _remoteIncoming = IntSet.empty

1158 , _remoteIncoming = IntSet.empty

1167 , sendOn = sendMany sock

1159 , sendOn = sendMany sock

1168 }

1160 }

1169− modifyMVar_ theirState $ \(RemoteEndPointInit resolved) -> do

1170− putMVar resolved ()

1171− return (RemoteEndPointValid vst)

1161+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointValid vst)

1172 sendMany sock [encodeInt32 ConnectionRequestAccepted]

1162 sendMany sock [encodeInt32 ConnectionRequestAccepted]

1173 return (Just theirEndPoint)

1163 return (Just theirEndPoint)

1174 -- If we left the scope of the exception handler with a return value of

1164 -- If we left the scope of the exception handler with a return value of

@@ -1186,15 +1176,17 @@ handleConnectionRequest transport sock = handle handleException $ do

1186 tryIO $ sendMany sock [encodeInt32 ConnectionRequestInvalid]

1176 tryIO $ sendMany sock [encodeInt32 ConnectionRequestInvalid]

1187 tryCloseSocket sock

1177 tryCloseSocket sock

1188

1178

1179+data BlockOnInit = BlockOnInit | DontBlockOnInit

1180+

1189-- | Find a remote endpoint. If the remote endpoint does not yet exist we

1181-- | Find a remote endpoint. If the remote endpoint does not yet exist we

1190-- create it in Init state and return the corresponding 'resolved' MVar.

1182-- create it in Init state and return the corresponding 'resolved' MVar.

1191findRemoteEndPoint

1183findRemoteEndPoint

1192− :: LocalEndPoint -- ^ Local endpoint

1184+ :: LocalEndPoint

1193− -> EndPointAddress -- ^ Remote address

1185+ -> EndPointAddress

1194− -> Bool -- ^ Wait if remote endpoint is in Init state

1186+ -> BlockOnInit

1195 -> (ValidRemoteEndPointState -> RemoteState) -- ^ Apply if in Valid state

1187 -> (ValidRemoteEndPointState -> RemoteState) -- ^ Apply if in Valid state

1196 -> IO (RemoteEndPoint, Maybe (MVar ()))

1188 -> IO (RemoteEndPoint, Maybe (MVar ()))

1197−findRemoteEndPoint ourEndPoint theirAddress waitOnInit whenValid = go

1189+findRemoteEndPoint ourEndPoint theirAddress blockOnInit whenValid = go

1198 where

1190 where

1199 go = do

1191 go = do

1200 (theirEndPoint, isNew) <- modifyMVar ourState $ \st -> case st of

1192 (theirEndPoint, isNew) <- modifyMVar ourState $ \st -> case st of

@@ -1233,9 +1225,9 @@ findRemoteEndPoint ourEndPoint theirAddress waitOnInit whenValid = go

1233 RemoteEndPointInvalid err ->

1225 RemoteEndPointInvalid err ->

1234 throwIO err

1226 throwIO err

1235 RemoteEndPointInit resolved ->

1227 RemoteEndPointInit resolved ->

1236− if waitOnInit

1228+ case blockOnInit of

1237− then readMVar resolved >> go

1229+ BlockOnInit -> readMVar resolved >> go

1238− else return (theirEndPoint, Nothing)

1230+ DontBlockOnInit -> return (theirEndPoint, Nothing)

1239 RemoteEndPointValid _ ->

1231 RemoteEndPointValid _ ->

1240 return (theirEndPoint, Nothing)

1232 return (theirEndPoint, Nothing)

1241 RemoteEndPointClosing resolved _ ->

1233 RemoteEndPointClosing resolved _ ->

@@ -1248,9 +1240,6 @@ findRemoteEndPoint ourEndPoint theirAddress waitOnInit whenValid = go

1248-- | Handle requests from a remote endpoint.

1240-- | Handle requests from a remote endpoint.

1249--

1241--

1250-- Returns only if the remote party closes the socket or if an error occurs.

1242-- Returns only if the remote party closes the socket or if an error occurs.

1251−--

1252−-- RELY: The remote endpoint must not be invalid.

1253−-- GUARANTEE: May change the remote endpoint to RemoteEndPointClosed state.

1254handleIncomingMessages :: EndPointPair -> IO ()

1243handleIncomingMessages :: EndPointPair -> IO ()

1255handleIncomingMessages (ourEndPoint, theirEndPoint) = do

1244handleIncomingMessages (ourEndPoint, theirEndPoint) = do

1256 mSock <- withMVar theirState $ \st ->

1245 mSock <- withMVar theirState $ \st ->

network-transport/tests/TestTCP.hs+4−4

@@ -654,7 +654,7 @@ testUnidirectionalError nextPort = do

654 takeMVar serverGotPing

655

656 -- Close the *outgoing* part of the socket only

657− Right sock <- socketBetween internals (address endpoint) theirAddr

657+ sock <- socketBetween internals (address endpoint) theirAddr

658 N.shutdown sock N.ShutdownSend

659

660 -- At this point we cannot notice the problem yet so we shouldn't receive an event yet

@@ -670,7 +670,7 @@ testUnidirectionalError nextPort = do

670 takeMVar serverGotPing

671

672 -- Again, close the outgoing part of the socket

673− Right sock' <- socketBetween internals (address endpoint) theirAddr

673+ sock' <- socketBetween internals (address endpoint) theirAddr

674 N.shutdown sock' N.ShutdownSend

675

676 -- We now find the error when we attempt to close the connection

@@ -682,7 +682,7 @@ testUnidirectionalError nextPort = do

682 takeMVar serverGotPing

683

684 -- We repeat once more.

685− Right sock'' <- socketBetween internals (address endpoint) theirAddr

685+ sock'' <- socketBetween internals (address endpoint) theirAddr

686 N.shutdown sock'' N.ShutdownSend

687

688 -- Now we notice the problem when we try to connect

@@ -727,7 +727,7 @@ testInvalidCloseConnection nextPort = do

727 Right _ <- connect endpoint theirAddr ReliableOrdered defaultConnectHints

728

729 -- Get a handle on the TCP connection and manually send an invalid CloseConnection request

730− Right sock <- socketBetween internals ourAddr theirAddr

730+ sock <- socketBetween internals ourAddr theirAddr

731 sendMany sock [encodeInt32 CloseConnection, encodeInt32 (12345 :: Int)]

732

733 putMVar clientDone ()

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

@@ -49,7 +49,7 @@ echoServer endpoint = do

49 -- Ignore

50 go cs

51 ErrorEvent _ ->

52− fail (show event)

52+ putStrLn $ "Echo server received error event: " ++ show event

53 EndPointClosed ->

54 return ()