Added Pruning multinode_Sim test

- Fixed Simulation/Network/Snocket.hs accept function:
  Accept should be careful when finding a connection in Established or
  HalfOpened state, acting accordingly: When in Established state, fail
  the accept call as in the other side, the connect call fell through;
  when in HalfOpened, do not successfully return nor fail, but rather
  just take a new connection from the TBQueue.

  (This should be catched with more thorough Socket tests, see issue #3289)

- multinode_Sim tests refactor

ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs

@@ -859,7 +859,11 @@ withConnectionManager ConnectionManagerArguments {
                 TerminatingState {} -> return Nothing
 
                 TerminatedState {} -> return Nothing
+
+            traverse_ (traceWith trTracer . TransitionTrace peerAddr) mbTransition
+
             traceCounters stateVar
+
             -- Note that we don't set a timeout thread here which would perform
             -- @
             --   Commit^{dataFlow}
@@ -871,8 +875,6 @@ withConnectionManager ConnectionManagerArguments {
             -- idle, it will call 'unregisterInboundConnection' which will
             -- perform the aforementioned @Commit@ transition.
 
-            traverse_ (traceWith trTracer . TransitionTrace peerAddr) mbTransition
-
             -- If mbTransition is Nothing, it means that the connVar was read
             -- either in Terminating or TerminatedState. Either case we should
             -- return Disconnected instead of Connected.

ouroboros-network-framework/src/Simulation/Network/Snocket.hs

@@ -940,6 +940,26 @@ mkSnocket state tr = Snocket { getLocalAddr
                                 (TestAddress addr))
     accept FD { fdVar } = pure accept_
       where
+        readTBQueueUntil :: (a -> STM m Bool) -> TBQueue m a -> STM m a
+        readTBQueueUntil p queue = do
+          a <- readTBQueue queue
+          shouldReturn <- p a
+          if shouldReturn
+             then return a
+             else readTBQueueUntil p queue
+
+        isHalfOpened :: TestAddress addr
+                     -> ChannelWithInfo m (TestAddress addr)
+                     -> STM m Bool
+        isHalfOpened localAddress cwi = do
+          connMap <- readTVar (nsConnections state)
+          let connId = ConnectionId localAddress (cwiAddress cwi)
+
+          case Map.lookup (normaliseId connId) connMap of
+             Nothing                            -> return True
+             Just (Connection _ _ _ HalfOpened) -> return True
+             _                                  -> return False
+
         accept_ = Accept $ \unmask -> do
             bracketOnError
               (unmask $ atomically $ do
@@ -963,10 +983,21 @@ mkSnocket state tr = Snocket { getLocalAddr
                                   , Just (localAddress connId)
                                   , mkSockType fd
                                   )
+
                   FDListening localAddress queue -> do
-                    cwi <- readTBQueue queue
+                    -- We should not accept nor fail the 'accept' call
+                    -- in the presence of a connection that is in
+                    -- HalfOpened state. So we take from the TBQueue
+                    -- until we have found one that is __not__ in HalfOpened
+                    -- state.
+                    cwi <- readTBQueueUntil
+                            (isHalfOpened localAddress)
+                            queue
+
+                    let connId = ConnectionId localAddress (cwiAddress cwi)
+
                     return $ Right ( cwi
-                                   , localAddress
+                                   , connId
                                    )
 
                   FDClosed {} ->
@@ -988,28 +1019,31 @@ mkSnocket state tr = Snocket { getLocalAddr
                                            (STAcceptFailure fdType err))
                     return (AcceptFailure err, accept_)
 
-                  Right (chann, localAddress) -> do
+                  Right (chann, connId@ConnectionId { remoteAddress }) -> do
                     let ChannelWithInfo
-                          { cwiAddress       = remoteAddress
-                          , cwiSDUSize       = sduSize
+                          { cwiSDUSize       = sduSize
                           , cwiChannelLocal  = channelLocal
                           , cwiChannelRemote = channelRemote
                           } = chann
-                        connId = ConnectionId { localAddress, remoteAddress }
+
                     fdRemote <- atomically $ do
+
                       modifyTVar (nsConnections state)
                                  (Map.adjust (\s -> s { connState = Established })
                                              (normaliseId connId))
+
                       FD <$> newTVar (FDConnected
-                                        connId
-                                        Connection
-                                          { connChannelLocal  = channelLocal
-                                          , connChannelRemote = channelRemote
-                                          , connSDUSize       = sduSize
-                                          , connState         = Established
-                                          })
-                    traceWith tr (WithAddr (Just localAddress) Nothing
+                                          connId
+                                          Connection
+                                            { connChannelLocal  = channelLocal
+                                            , connChannelRemote = channelRemote
+                                            , connSDUSize       = sduSize
+                                            , connState         = Established
+                                            })
+
+                    traceWith tr (WithAddr (Just (localAddress connId)) Nothing
                                            (STAccepted remoteAddress))
+
                     return (Accepted fdRemote remoteAddress, accept_)