testnet: provide additional context in counterexamples

It's useful to provide not only the transitions that didn't match, but
also the time and the server name to make it easier to locate the
transition in a trace.

ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs

@@ -1166,7 +1166,7 @@ prop_connection_manager_valid_transition_order (Fixed rnd) serverAcc (ArbDataFlo
            MainReturn {} -> mempty
            _             -> All False
        )
-       (verifyAbstractTransitionOrder True)
+       (verifyAbstractTransitionOrder id True)
     . fmap (map ttTransition)
     . groupConns id abstractStateIsFinalTransition
     $ abstractTransitionEvents
@@ -1206,7 +1206,7 @@ prop_connection_manager_valid_transition_order_racy (Fixed rnd) serverAcc (ArbDa
                MainReturn {} -> mempty
                _             -> All False
            )
-           (verifyAbstractTransitionOrder True)
+           (verifyAbstractTransitionOrder id True)
         . fmap (map ttTransition)
         . groupConns id abstractStateIsFinalTransition
         $ abstractTransitionEvents

ouroboros-network-framework/testlib/Ouroboros/Network/ConnectionManager/Test/Utils.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE NamedFieldPuns      #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Ouroboros.Network.ConnectionManager.Test.Utils where
 
@@ -193,35 +194,37 @@ validTransitionMap t@Transition { fromState, toState } =
 -- Assuming all transitions in the transition list are valid, we only need to
 -- look at the 'toState' of the current transition and the 'fromState' of the
 -- next transition.
-verifyAbstractTransitionOrder :: Bool -- ^ Check last transition: useful for
+verifyAbstractTransitionOrder :: forall a. Show a
+                              => (a -> AbstractTransition)
+                              -> Bool -- ^ Check last transition: useful for
                                       --    distinguish Diffusion layer tests
                                       --    vs non-Diffusion ones.
-                              -> [AbstractTransition]
+                              -> [a]
                               -> All
-verifyAbstractTransitionOrder _ [] = mempty
-verifyAbstractTransitionOrder checkLast (h:t) = go t h
+verifyAbstractTransitionOrder _ _ [] = mempty
+verifyAbstractTransitionOrder get checkLast (h:t) = go t h
   where
-    go :: [AbstractTransition] -> AbstractTransition -> All
+    go :: [a] -> a -> All
     -- All transitions must end in the 'UnknownConnectionSt', and since we
     -- assume that all transitions are valid we do not have to check the
     -- 'fromState'.
-    go [] (Transition _ UnknownConnectionSt) = mempty
-    go [] tr@(Transition _ _)          =
+    go [] a | (Transition _ UnknownConnectionSt) <- get a = mempty
+    go [] a | tr@(Transition _ _) <- get a =
       All
         $ counterexample
             ("\nUnexpected last transition: " ++ show tr)
             (property (not checkLast))
     -- All transitions have to be in a correct order, which means that the
     -- current state we are looking at (current toState) needs to be equal to
     -- the next 'fromState', in order for the transition chain to be correct.
-    go (next@(Transition nextFromState _) : ts)
-        curr@(Transition _ currToState) =
+    go (a : as) b | (Transition nextFromState _) <- get a
+                  , (Transition _ currToState) <- get b =
          All
            (counterexample
               ("\nUnexpected transition order!\nWent from: "
-              ++ show curr ++ "\nto: " ++ show next)
+              ++ show b ++ "\nto: " ++ show a)
               (property (currToState == nextFromState)))
-         <> go ts next
+         <> go as a
 
 
 -- | List of all valid transition's names.

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs

@@ -275,8 +275,10 @@ testWithIOSim f traceNumber bi ds =
       sim = diffusionSimulation (toBearerInfo bi)
                                 ds
                                 iosimTracer
+      trace = runSimTrace sim
    in labelDiffusionScript ds
-    $ f (runSimTrace sim) traceNumber
+    $ counterexample (Trace.ppTrace show (ppSimEvent 0 0 0) $ Trace.take traceNumber trace)
+    $ f trace traceNumber
 
 testWithIOSimPOR :: (SimTrace Void -> Int -> Property)
                  -> Int
@@ -3041,7 +3043,7 @@ prop_diffusion_cm_valid_transition_order_iosim_por ioSimTrace traceNumber =
          property
        . bifoldMap
           (const mempty)
-          (verifyAbstractTransitionOrder False)
+          (verifyAbstractTransitionOrder id False)
        . fmap (map ttTransition)
        . groupConns id abstractStateIsFinalTransitionTVarTracing
 
@@ -3074,25 +3076,24 @@ prop_diffusion_cm_valid_transition_order ioSimTrace traceNumber =
                      . last
                      $ evsList
          in classifySimulatedTime lastTime
-          $ classifyNumberOfEvents (length evsList)
-          $ verify_cm_valid_transition_order
-          $ (\(WithName _ (WithTime _ b)) -> b)
-          <$> ev
+          . classifyNumberOfEvents (length evsList)
+          . verify_cm_valid_transition_order
+          $ ev
         )
       <$> events
   where
-    verify_cm_valid_transition_order :: Trace () DiffusionTestTrace -> Property
+    verify_cm_valid_transition_order :: Trace () (WithName NtNAddr (WithTime DiffusionTestTrace)) -> Property
     verify_cm_valid_transition_order events =
-      let abstractTransitionEvents :: Trace () (AbstractTransitionTrace NtNAddr)
+      let abstractTransitionEvents :: Trace () (WithName NtNAddr (WithTime (AbstractTransitionTrace NtNAddr)))
           abstractTransitionEvents =
-            selectDiffusionConnectionManagerTransitionEvents events
+            selectDiffusionConnectionManagerTransitionEvents' events
 
        in  property
          . bifoldMap
             (const mempty)
-            (verifyAbstractTransitionOrder False)
-         . fmap (map ttTransition)
-         . groupConns id abstractStateIsFinalTransition
+            (verifyAbstractTransitionOrder (wtEvent . wnEvent) False)
+         . fmap (map (fmap (fmap ttTransition)))
+         . groupConns (wtEvent . wnEvent) abstractStateIsFinalTransition
          $ abstractTransitionEvents
 
 -- | Unit test that checks issue 4258
@@ -4178,6 +4179,18 @@ selectDiffusionConnectionManagerTransitionEvents =
             _                                           -> Nothing)
   . Trace.toList
 
+selectDiffusionConnectionManagerTransitionEvents'
+  :: Trace () (WithName NtNAddr (WithTime DiffusionTestTrace))
+  -> Trace () (WithName NtNAddr (WithTime (AbstractTransitionTrace NtNAddr)))
+selectDiffusionConnectionManagerTransitionEvents' =
+    Trace.fromList ()
+  . mapMaybe
+     (\case
+       (WithName addr (WithTime time (DiffusionConnectionManagerTransitionTrace e)))
+         -> Just (WithName addr (WithTime time e))
+       _ -> Nothing)
+  . Trace.toList
+
 selectDiffusionConnectionManagerTransitionEventsTime
   :: Trace () (Time, DiffusionTestTrace)
   -> Trace () (Time, AbstractTransitionTrace NtNAddr)