git.iko.soy/distributed-process
on master help sign in
Deal with invalid connection requests
fae5beaEdsko de Vries
network-transport/src/Network/Transport/TCP.hs+46−39
compare with master
unifiedsplit
@@ -326,9 +326,11 @@ data RemoteEndPoint = RemoteEndPoint
326 , remoteId :: Int
326 , remoteId :: Int
327 }
327 }
328
328
329+data Origin = Local | Remote
330+
329data RemoteState =
331data RemoteState =
330 RemoteEndPointInvalid (TransportError ConnectErrorCode)
332 RemoteEndPointInvalid (TransportError ConnectErrorCode)
331− | RemoteEndPointInit (MVar ())
333+ | RemoteEndPointInit (MVar ()) Origin
332 | RemoteEndPointValid ValidRemoteEndPointState
334 | RemoteEndPointValid ValidRemoteEndPointState
333 | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState
335 | RemoteEndPointClosing (MVar ()) ValidRemoteEndPointState
334 | RemoteEndPointClosed
336 | RemoteEndPointClosed
@@ -513,7 +515,7 @@ apiSend (ourEndPoint, theirEndPoint) connId connAlive payload =
513 withRemoteState (ourEndPoint, theirEndPoint) RemoteStatePatternMatch
515 withRemoteState (ourEndPoint, theirEndPoint) RemoteStatePatternMatch
514 { caseInvalid = \_ ->
516 { caseInvalid = \_ ->
515 relyViolation (ourEndPoint, theirEndPoint) "apiSend"
517 relyViolation (ourEndPoint, theirEndPoint) "apiSend"
516− , caseInit = \_ ->
518+ , caseInit = \_ _ ->
517 relyViolation (ourEndPoint, theirEndPoint) "apiSend"
519 relyViolation (ourEndPoint, theirEndPoint) "apiSend"
518 , caseValid = \vst -> do
520 , caseValid = \vst -> do
519 alive <- readIORef connAlive
521 alive <- readIORef connAlive
@@ -564,7 +566,7 @@ apiCloseEndPoint transport evs ourEndPoint = do
564 case st of
566 case st of
565 RemoteEndPointInvalid _ ->
567 RemoteEndPointInvalid _ ->
566 return st
568 return st
567− RemoteEndPointInit resolved -> do
569+ RemoteEndPointInit resolved _ -> do
568 putMVar resolved ()
570 putMVar resolved ()
569 return RemoteEndPointClosed
571 return RemoteEndPointClosed
570 RemoteEndPointValid conn -> do
572 RemoteEndPointValid conn -> do
@@ -647,7 +649,7 @@ internalSocketBetween transport ourAddress theirAddress = do
647 Nothing -> throwIO $ userError "Remote endpoint not found"
649 Nothing -> throwIO $ userError "Remote endpoint not found"
648 Just ep -> return ep
650 Just ep -> return ep
649 withMVar (remoteState theirEndPoint) $ \st -> case st of
651 withMVar (remoteState theirEndPoint) $ \st -> case st of
650− RemoteEndPointInit _ ->
652+ RemoteEndPointInit _ _ ->
651 throwIO $ userError "Remote endpoint not yet initialized"
653 throwIO $ userError "Remote endpoint not yet initialized"
652 RemoteEndPointValid vst ->
654 RemoteEndPointValid vst ->
653 return $ remoteSocket vst
655 return $ remoteSocket vst
@@ -708,8 +710,7 @@ requestConnectionTo :: LocalEndPoint
708 -> IO (RemoteEndPoint, ConnectionId)
710 -> IO (RemoteEndPoint, ConnectionId)
709requestConnectionTo ourEndPoint theirAddress = do
711requestConnectionTo ourEndPoint theirAddress = do
710 (theirEndPoint, isNew) <- mapIOException connectFailed $
712 (theirEndPoint, isNew) <- mapIOException connectFailed $
711− findRemoteEndPoint ourEndPoint theirAddress BlockOnInit
713+ findRemoteEndPoint ourEndPoint theirAddress Local
712− (RemoteEndPointValid . (remoteOutgoing ^: (+ 1)))
713
714
714 -- If this is a new endpoint, start the initialization process and wait
715 -- If this is a new endpoint, start the initialization process and wait
715 forM_ isNew $ \resolved -> do
716 forM_ isNew $ \resolved -> do
@@ -800,7 +801,7 @@ resolveInit (ourEndPoint, theirEndPoint) newState =
800 modifyMVar_ (remoteState theirEndPoint) $ \st -> case st of
801 modifyMVar_ (remoteState theirEndPoint) $ \st -> case st of
801 RemoteEndPointInvalid _ ->
802 RemoteEndPointInvalid _ ->
802 relyViolation (ourEndPoint, theirEndPoint) "resolveInit (invalid)"
803 relyViolation (ourEndPoint, theirEndPoint) "resolveInit (invalid)"
803− RemoteEndPointInit resolved -> do
804+ RemoteEndPointInit resolved _ -> do
804 putMVar resolved ()
805 putMVar resolved ()
805 return newState
806 return newState
806 RemoteEndPointClosed ->
807 RemoteEndPointClosed ->
@@ -917,7 +918,7 @@ doRemoteRequest (ourEndPoint, theirEndPoint) header = do
917 throwIO (userError "Local endpoint closed")
918 throwIO (userError "Local endpoint closed")
918 withRemoteState (ourEndPoint, theirEndPoint) RemoteStatePatternMatch
919 withRemoteState (ourEndPoint, theirEndPoint) RemoteStatePatternMatch
919 { caseInvalid = throwIO
920 { caseInvalid = throwIO
920− , caseInit = \_ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
921+ , caseInit = \_ _ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (init)"
921 , caseValid = \vst -> sendOn vst [encodeInt32 header, encodeInt32 reqId]
922 , caseValid = \vst -> sendOn vst [encodeInt32 header, encodeInt32 reqId]
922 , caseClosing = \_ _ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
923 , caseClosing = \_ _ -> relyViolation (ourEndPoint, theirEndPoint) "doRemoteRequest (closing)"
923 , caseClosed = throwIO $ userError "Remote endpoint closed"
924 , caseClosed = throwIO $ userError "Remote endpoint closed"
@@ -988,7 +989,7 @@ forkEndPointThread ourEndPoint p =
988
989
989data RemoteStatePatternMatch a = RemoteStatePatternMatch
990data RemoteStatePatternMatch a = RemoteStatePatternMatch
990 { caseInvalid :: TransportError ConnectErrorCode -> IO a
991 { caseInvalid :: TransportError ConnectErrorCode -> IO a
991− , caseInit :: MVar () -> IO a
992+ , caseInit :: MVar () -> Origin -> IO a
992 , caseValid :: ValidRemoteEndPointState -> IO a
993 , caseValid :: ValidRemoteEndPointState -> IO a
993 , caseClosing :: MVar () -> ValidRemoteEndPointState -> IO a
994 , caseClosing :: MVar () -> ValidRemoteEndPointState -> IO a
994 , caseClosed :: IO a
995 , caseClosed :: IO a
@@ -998,7 +999,7 @@ remoteStateIdentity :: RemoteStatePatternMatch RemoteState
998remoteStateIdentity =
999remoteStateIdentity =
999 RemoteStatePatternMatch
1000 RemoteStatePatternMatch
1000 { caseInvalid = return . RemoteEndPointInvalid
1001 { caseInvalid = return . RemoteEndPointInvalid
1001− , caseInit = return . RemoteEndPointInit
1002+ , caseInit = (return .) . RemoteEndPointInit
1002 , caseValid = return . RemoteEndPointValid
1003 , caseValid = return . RemoteEndPointValid
1003 , caseClosing = (return .) . RemoteEndPointClosing
1004 , caseClosing = (return .) . RemoteEndPointClosing
1004 , caseClosed = return RemoteEndPointClosed
1005 , caseClosed = return RemoteEndPointClosed
@@ -1026,8 +1027,8 @@ modifyRemoteState (ourEndPoint, theirEndPoint) match =
1026 throwIO ex
1027 throwIO ex
1027 -- The other cases are less interesting, because unless the endpoint is
1028 -- The other cases are less interesting, because unless the endpoint is
1028 -- in Valid state we're not supposed to do any IO on it
1029 -- in Valid state we're not supposed to do any IO on it
1029− RemoteEndPointInit resolved -> do
1030+ RemoteEndPointInit resolved origin -> do
1030− (st', a) <- onException (restore $ caseInit match resolved)
1031+ (st', a) <- onException (restore $ caseInit match resolved origin)
1031 (putMVar theirState st)
1032 (putMVar theirState st)
1032 putMVar theirState st'
1033 putMVar theirState st'
1033 return a
1034 return a
@@ -1068,7 +1069,7 @@ modifyRemoteState_ (ourEndPoint, theirEndPoint) match =
1068 modifyRemoteState (ourEndPoint, theirEndPoint)
1069 modifyRemoteState (ourEndPoint, theirEndPoint)
1069 RemoteStatePatternMatch
1070 RemoteStatePatternMatch
1070 { caseInvalid = u . caseInvalid match
1071 { caseInvalid = u . caseInvalid match
1071− , caseInit = u . caseInit match
1072+ , caseInit = \resolved origin -> u $ caseInit match resolved origin
1072 , caseValid = u . caseValid match
1073 , caseValid = u . caseValid match
1073 , caseClosing = \resolved vst -> u $ caseClosing match resolved vst
1074 , caseClosing = \resolved vst -> u $ caseClosing match resolved vst
1074 , caseClosed = u $ caseClosed match
1075 , caseClosed = u $ caseClosed match
@@ -1087,9 +1088,9 @@ withRemoteState (ourEndPoint, theirEndPoint) match =
1087 { caseInvalid = \err -> do
1088 { caseInvalid = \err -> do
1088 a <- caseInvalid match err
1089 a <- caseInvalid match err
1089 return (RemoteEndPointInvalid err, a)
1090 return (RemoteEndPointInvalid err, a)
1090− , caseInit = \resolved -> do
1091+ , caseInit = \resolved origin -> do
1091− a <- caseInit match resolved
1092+ a <- caseInit match resolved origin
1092− return (RemoteEndPointInit resolved, a)
1093+ return (RemoteEndPointInit resolved origin, a)
1093 , caseValid = \vst -> do
1094 , caseValid = \vst -> do
1094 a <- caseValid match vst
1095 a <- caseValid match vst
1095 return (RemoteEndPointValid vst, a)
1096 return (RemoteEndPointValid vst, a)
@@ -1139,11 +1140,9 @@ handleConnectionRequest transport sock = handle handleException $ do
1139 go ourEndPoint theirAddress = do
1140 go ourEndPoint theirAddress = do
1140 mEndPoint <- handle ((>> return Nothing) . invalidEndPoint) $ do
1141 mEndPoint <- handle ((>> return Nothing) . invalidEndPoint) $ do
1141 (theirEndPoint, isNew) <-
1142 (theirEndPoint, isNew) <-
1142− findRemoteEndPoint ourEndPoint theirAddress DontBlockOnInit
1143+ findRemoteEndPoint ourEndPoint theirAddress Remote
1143− (throw $ userError "Already connected")
1144
1144
1145 let ourAddress = localAddress ourEndPoint
1145 let ourAddress = localAddress ourEndPoint
1146− theirState = remoteState theirEndPoint
1147 crossed = isNothing isNew && ourAddress < theirAddress
1146 crossed = isNothing isNew && ourAddress < theirAddress
1148
1147
1149 if crossed
1148 if crossed
@@ -1158,8 +1157,8 @@ handleConnectionRequest transport sock = handle handleException $ do
1158 , _remoteIncoming = IntSet.empty
1157 , _remoteIncoming = IntSet.empty
1159 , sendOn = sendMany sock
1158 , sendOn = sendMany sock
1160 }
1159 }
1161− resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointValid vst)
1162 sendMany sock [encodeInt32 ConnectionRequestAccepted]
1160 sendMany sock [encodeInt32 ConnectionRequestAccepted]
1161+ resolveInit (ourEndPoint, theirEndPoint) (RemoteEndPointValid vst)
1163 return (Just theirEndPoint)
1162 return (Just theirEndPoint)
1164 -- If we left the scope of the exception handler with a return value of
1163 -- If we left the scope of the exception handler with a return value of
1165 -- Nothing then the socket is already closed; otherwise, the socket has
1164 -- Nothing then the socket is already closed; otherwise, the socket has
@@ -1176,17 +1175,14 @@ handleConnectionRequest transport sock = handle handleException $ do
1176 tryIO $ sendMany sock [encodeInt32 ConnectionRequestInvalid]
1175 tryIO $ sendMany sock [encodeInt32 ConnectionRequestInvalid]
1177 tryCloseSocket sock
1176 tryCloseSocket sock
1178
1177
1179−data BlockOnInit = BlockOnInit | DontBlockOnInit
1180−
1181-- | Find a remote endpoint. If the remote endpoint does not yet exist we
1178-- | Find a remote endpoint. If the remote endpoint does not yet exist we
1182-- create it in Init state and return the corresponding 'resolved' MVar.
1179-- create it in Init state and return the corresponding 'resolved' MVar.
1183findRemoteEndPoint
1180findRemoteEndPoint
1184 :: LocalEndPoint
1181 :: LocalEndPoint
1185 -> EndPointAddress
1182 -> EndPointAddress
1186− -> BlockOnInit
1183+ -> Origin
1187− -> (ValidRemoteEndPointState -> RemoteState) -- ^ Apply if in Valid state
1188 -> IO (RemoteEndPoint, Maybe (MVar ()))
1184 -> IO (RemoteEndPoint, Maybe (MVar ()))
1189−findRemoteEndPoint ourEndPoint theirAddress blockOnInit whenValid = go
1185+findRemoteEndPoint ourEndPoint theirAddress findOrigin = go
1190 where
1186 where
1191 go = do
1187 go = do
1192 (theirEndPoint, isNew) <- modifyMVar ourState $ \st -> case st of
1188 (theirEndPoint, isNew) <- modifyMVar ourState $ \st -> case st of
@@ -1195,7 +1191,7 @@ findRemoteEndPoint ourEndPoint theirAddress blockOnInit whenValid = go
1195 return (st, (theirEndPoint, Nothing))
1191 return (st, (theirEndPoint, Nothing))
1196 Nothing -> do
1192 Nothing -> do
1197 resolved <- newEmptyMVar
1193 resolved <- newEmptyMVar
1198− theirState <- newMVar (RemoteEndPointInit resolved)
1194+ theirState <- newMVar (RemoteEndPointInit resolved findOrigin)
1199 let theirEndPoint = RemoteEndPoint
1195 let theirEndPoint = RemoteEndPoint
1200 { remoteAddress = theirAddress
1196 { remoteAddress = theirAddress
1201 , remoteState = theirState
1197 , remoteState = theirState
@@ -1216,18 +1212,29 @@ findRemoteEndPoint ourEndPoint theirAddress blockOnInit whenValid = go
1216 Nothing -> do
1212 Nothing -> do
1217 let theirState = remoteState theirEndPoint
1213 let theirState = remoteState theirEndPoint
1218 snapshot <- modifyMVar theirState $ \st -> case st of
1214 snapshot <- modifyMVar theirState $ \st -> case st of
1219− RemoteEndPointValid vst -> do
1215+ RemoteEndPointValid vst ->
1220− let st' = whenValid vst
1216+ case findOrigin of
1217+ Local -> do
1218+ let st' = RemoteEndPointValid
1219+ . (remoteOutgoing ^: (+ 1))
1220+ $ vst
1221− return (st', st')
1221+ return (st', st')
1222+ Remote ->
1223+ throwIO $ userError "Already connected"
1222− _ ->
1224+ _ ->
1223 return (st, st)
1225 return (st, st)
1226+ -- The snapshot may no longer be up to date at this point, but if we
1227+ -- increased the refcount then it can only either be valid or closed
1228+ -- (after an explicit call to 'closeEndPoint' or 'closeTransport')
1224 case snapshot of
1229 case snapshot of
1225 RemoteEndPointInvalid err ->
1230 RemoteEndPointInvalid err ->
1226 throwIO err
1231 throwIO err
1227− RemoteEndPointInit resolved ->
1232+ RemoteEndPointInit resolved initOrigin ->
1228− case blockOnInit of
1233+ case (findOrigin, initOrigin) of
1229− BlockOnInit -> readMVar resolved >> go
1234+ (Local, Local) -> readMVar resolved >> go
1235+ (Local, Remote) -> readMVar resolved >> go
1230− DontBlockOnInit -> return (theirEndPoint, Nothing)
1236+ (Remote, Local) -> return (theirEndPoint, Nothing)
1237+ (Remote, Remote) -> throwIO $ userError "Already connected"
1231 RemoteEndPointValid _ ->
1238 RemoteEndPointValid _ ->
1232 return (theirEndPoint, Nothing)
1239 return (theirEndPoint, Nothing)
1233 RemoteEndPointClosing resolved _ ->
1240 RemoteEndPointClosing resolved _ ->
@@ -1246,7 +1253,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1246 case st of
1253 case st of
1247 RemoteEndPointInvalid _ ->
1254 RemoteEndPointInvalid _ ->
1248 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages"
1255 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages"
1249− RemoteEndPointInit _ ->
1256+ RemoteEndPointInit _ _ ->
1250 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages"
1257 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages"
1251 RemoteEndPointValid ep ->
1258 RemoteEndPointValid ep ->
1252 return . Just $ remoteSocket ep
1259 return . Just $ remoteSocket ep
@@ -1307,7 +1314,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1307 vst <- case st of
1314 vst <- case st of
1308 RemoteEndPointInvalid _ ->
1315 RemoteEndPointInvalid _ ->
1309 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:createNewConnection"
1316 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:createNewConnection"
1310− RemoteEndPointInit _ ->
1317+ RemoteEndPointInit _ _ ->
1311 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:createNewConnection"
1318 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:createNewConnection"
1312 RemoteEndPointValid vst ->
1319 RemoteEndPointValid vst ->
1313 return (remoteIncoming ^: IntSet.insert newId $ vst)
1320 return (remoteIncoming ^: IntSet.insert newId $ vst)
@@ -1359,7 +1366,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1359 modifyMVar_ theirState $ \st -> case st of
1366 modifyMVar_ theirState $ \st -> case st of
1360 RemoteEndPointInvalid _ ->
1367 RemoteEndPointInvalid _ ->
1361 relyViolation (ourEndPoint, theirEndPoint) "closeConnection"
1368 relyViolation (ourEndPoint, theirEndPoint) "closeConnection"
1362− RemoteEndPointInit _ ->
1369+ RemoteEndPointInit _ _ ->
1363 relyViolation (ourEndPoint, theirEndPoint) "closeConnection"
1370 relyViolation (ourEndPoint, theirEndPoint) "closeConnection"
1364 RemoteEndPointValid vst -> do
1371 RemoteEndPointValid vst -> do
1365 unless (IntSet.member cid (vst ^. remoteIncoming)) $
1372 unless (IntSet.member cid (vst ^. remoteIncoming)) $
@@ -1385,7 +1392,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1385 case st of
1392 case st of
1386 RemoteEndPointInvalid _ ->
1393 RemoteEndPointInvalid _ ->
1387 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:closeSocket"
1394 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:closeSocket"
1388− RemoteEndPointInit _ ->
1395+ RemoteEndPointInit _ _ ->
1389 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:closeSocket"
1396 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:closeSocket"
1390 RemoteEndPointValid vst -> do
1397 RemoteEndPointValid vst -> do
1391 -- We regard a CloseSocket message as an (optimized) way for the
1398 -- We regard a CloseSocket message as an (optimized) way for the
@@ -1434,7 +1441,7 @@ handleIncomingMessages (ourEndPoint, theirEndPoint) = do
1434 case st of
1441 case st of
1435 RemoteEndPointInvalid _ ->
1442 RemoteEndPointInvalid _ ->
1436 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
1443 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
1437− RemoteEndPointInit _ ->
1444+ RemoteEndPointInit _ _ ->
1438 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
1445 relyViolation (ourEndPoint, theirEndPoint) "handleIncomingMessages:prematureExit"
1439 RemoteEndPointValid vst -> do
1446 RemoteEndPointValid vst -> do
1440 let code = EventConnectionLost
1447 let code = EventConnectionLost
network-transport/tests/TestTCP.hs+23−7
@@ -476,8 +476,8 @@ testBlockAfterCloseSocket nextPort = do
476
476
477-- | Test what happens when a remote endpoint sends a connection request to our
477-- | Test what happens when a remote endpoint sends a connection request to our
478-- transport for an endpoint it already has a connection to
478-- transport for an endpoint it already has a connection to
479−testUnnecessaryConnect :: IO N.ServiceName -> IO ()
479+testUnnecessaryConnect :: IO N.ServiceName -> Int -> IO ()
480−testUnnecessaryConnect nextPort = do
480+testUnnecessaryConnect nextPort numThreads = do
481 clientDone <- newEmptyMVar
481 clientDone <- newEmptyMVar
482 serverAddr <- newEmptyMVar
482 serverAddr <- newEmptyMVar
483
483
@@ -489,8 +489,24 @@ testUnnecessaryConnect nextPort = do
489 forkTry $ do
489 forkTry $ do
490 -- We pick an address < 127.0.0.1 so that this is not rejected purely because of the "crossed" check
490 -- We pick an address < 127.0.0.1 so that this is not rejected purely because of the "crossed" check
491 let ourAddress = EndPointAddress "126.0.0.1"
491 let ourAddress = EndPointAddress "126.0.0.1"
492+
493+ -- We should only get a single 'Accepted' reply
494+ gotAccepted <- newEmptyMVar
495+ dones <- replicateM numThreads $ do
496+ done <- newEmptyMVar
497+ forkTry $ do
498+ Right (_, reply) <- readMVar serverAddr >>= socketToEndPoint ourAddress
499+ case reply of
492− Right (_, ConnectionRequestAccepted) <- readMVar serverAddr >>= socketToEndPoint ourAddress
500+ ConnectionRequestAccepted ->
501+ putMVar gotAccepted ()
493− Right (_, ConnectionRequestInvalid) <- readMVar serverAddr >>= socketToEndPoint ourAddress
502+ ConnectionRequestInvalid ->
503+ return ()
504+ ConnectionRequestCrossed ->
505+ throwIO $ userError "Unexpected response (Crossed)"
506+ putMVar done ()
507+ return done
508+
509+ mapM_ readMVar (gotAccepted : dones)
494 putMVar clientDone ()
510 putMVar clientDone ()
495
511
496 takeMVar clientDone
512 takeMVar clientDone
@@ -501,7 +517,7 @@ testMany nextPort = do
501 Right masterTransport <- nextPort >>= createTransport "127.0.0.1"
517 Right masterTransport <- nextPort >>= createTransport "127.0.0.1"
502 Right masterEndPoint <- newEndPoint masterTransport
518 Right masterEndPoint <- newEndPoint masterTransport
503
519
504− replicateM_ 20 $ do
520+ replicateM_ 10 $ do
505 mTransport <- nextPort >>= createTransport "127.0.0.1"
521 mTransport <- nextPort >>= createTransport "127.0.0.1"
506 case mTransport of
522 case mTransport of
507 Left ex -> do
523 Left ex -> do
@@ -511,7 +527,7 @@ testMany nextPort = do
511 _ -> return ()
527 _ -> return ()
512 throwIO ex
528 throwIO ex
513 Right transport ->
529 Right transport ->
514− replicateM_ 3 $ do
530+ replicateM_ 2 $ do
515 Right endpoint <- newEndPoint transport
531 Right endpoint <- newEndPoint transport
516 Right _ <- connect endpoint (address masterEndPoint) ReliableOrdered defaultConnectHints
532 Right _ <- connect endpoint (address masterEndPoint) ReliableOrdered defaultConnectHints
517 return ()
533 return ()
@@ -744,7 +760,7 @@ main = do
744 , ("EarlyCloseSocket", testEarlyCloseSocket nextPort)
760 , ("EarlyCloseSocket", testEarlyCloseSocket nextPort)
745 , ("IgnoreCloseSocket", testIgnoreCloseSocket nextPort)
761 , ("IgnoreCloseSocket", testIgnoreCloseSocket nextPort)
746 , ("BlockAfterCloseSocket", testBlockAfterCloseSocket nextPort)
762 , ("BlockAfterCloseSocket", testBlockAfterCloseSocket nextPort)
747− , ("TestUnnecessaryConnect", testUnnecessaryConnect nextPort)
763+ , ("TestUnnecessaryConnect", testUnnecessaryConnect nextPort 10)
748 , ("InvalidAddress", testInvalidAddress nextPort)
764 , ("InvalidAddress", testInvalidAddress nextPort)
749 , ("InvalidConnect", testInvalidConnect nextPort)
765 , ("InvalidConnect", testInvalidConnect nextPort)
750 , ("Many", testMany nextPort)
766 , ("Many", testMany nextPort)