Added test to check no self connects

ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs

@@ -141,6 +141,8 @@ tests =
   , testProperty "cm & ig timeouts enforced"
                  prop_diffusion_timeouts_enforced
   , testProperty "unit #4177" unit_4177
+  , testProperty "never connect to self"
+                 prop_never_connects_to_self
 #endif
 #if !defined(mingw32_HOST_OS)
   , testGroup "coverage"
@@ -2610,6 +2612,62 @@ prop_diffusion_timeouts_enforced defaultBearerInfo diffScript =
        in getAllProperty
         $ verifyAllTimeouts True transitionSignal
 
+-- | This property checks that a node never connects to itself.
+--
+-- Connecting to itself means connecting to exactly the same address and port
+-- of a node's listening socket. This is something that in the real world
+-- wouldn't happen since the kernel would disallow it.
+--
+-- This check is important because our network simulation mock can not disallow
+-- such cases, so we try very hard that our diffusion generator will not make
+-- create a cenario where a node is connecting to itself.
+--
+prop_never_connects_to_self :: AbsBearerInfo
+                            -> DiffusionScript
+                            -> Property
+prop_never_connects_to_self absBearerInfo diffScript =
+    let sim :: forall s . IOSim s Void
+        sim = diffusionSimulation (toBearerInfo absBearerInfo)
+                                  diffScript
+                                  tracersExtraWithTimeName
+                                  tracerDiffusionSimWithTimeName
+                                  nullTracer
+
+        events :: [Trace () DiffusionTestTrace]
+        events = fmap ( Trace.fromList ()
+                      . fmap (\(WithName _ (WithTime _ b)) -> b))
+               . Trace.toList
+               . splitWithNameTrace
+               . Trace.fromList ()
+               . fmap snd
+               . Trace.toList
+               . fmap (\(WithTime t (WithName name b))
+                       -> (t, WithName name (WithTime t b)))
+               . withTimeNameTraceEvents
+                  @DiffusionTestTrace
+                  @NtNAddr
+               . Trace.fromList (MainReturn (Time 0) () [])
+               . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te)
+               . take 125000
+               . traceEvents
+               $ runSimTrace sim
+
+     in conjoin (never_connects_to_self <$> events)
+
+  where
+    never_connects_to_self :: Trace () DiffusionTestTrace -> Property
+    never_connects_to_self events =
+      let connectionManagerEvents = Trace.toList
+                                  . selectDiffusionConnectionManagerEvents
+                                  $ events
+
+       in counterexample (intercalate "\n" . map show $ connectionManagerEvents)
+        $ all (\ cmt -> case cmt of
+                          TrConnect mbLocalAddr remoteAddr -> mbLocalAddr /= Just remoteAddr
+                          _                                -> True
+              )
+              connectionManagerEvents
+
 -- Utils
 --
 

ouroboros-network/test/Test/Ouroboros/Network/Testnet/Simulation/Node.hs

@@ -237,7 +237,7 @@ genDomainMap raps selfIP = do
   m <- mapM (\d -> do
     size <- chooseInt (1, 5)
     ips' <- nub <$> vectorOf size (genIP ips)
-    return (d, delete selfIP ips')) domains
+    return (d, filter (/= selfIP) ips')) domains
 
   return (Map.fromList m)
 
@@ -324,12 +324,8 @@ genNodeArgs :: [RelayAccessPoint]
            -> (NtNAddr, RelayAccessPoint)
            -> Gen NodeArgs
 genNodeArgs raps minConnected genLocalRootPeers (ntnAddr, rap) = do
-  -- Slot length needs to be greater than 0 else we get a livelock on
-  -- the IOSim.
-  --
-  -- Quota values matches mainnet, so a slot length of 1s and 1 / 20
-  -- chance that someone gets to make a block
-  let rapsWithoutSelf = delete rap raps
+
+  let rapsWithoutSelf = filter (/= rap) raps
       (RelayAccessAddress rapIP _) = rap
   seed <- arbitrary
 
@@ -439,7 +435,7 @@ genNonHotDiffusionScript = do
     genLocalRootPeers l r = do
       nrGroups <- chooseInt (1, 3)
       -- Remove self from local root peers
-      let newL = l \\ [r]
+      let newL = filter (/= r) l
           size = length newL
           sizePerGroup = (size `div` nrGroups) + 1
 
@@ -505,7 +501,7 @@ genHotDiffusionScript = do
                         -> Gen [(Int, Map RelayAccessPoint PeerAdvertise)]
       genLocalRootPeers l r = do
         -- Remove self from local root peers
-        let newL = delete r l
+        let newL = filter (/= r) l
             size = length newL
 
         peerAdvertise <- vectorOf size arbitrary