Additional check for not-leader slots in LeadershipSchedule tests

cardano-testnet/src/Testnet/Util/Assert.hs

@@ -7,7 +7,7 @@
 module Testnet.Util.Assert
   ( readJsonLines
   , assertChainExtended
-  , getRelevantLeaderSlots
+  , getRelevantSlots
   ) where
 
 import           Prelude hiding (lines)
@@ -71,30 +71,44 @@ newtype Kind = Kind
   { kind :: Text
   } deriving (Eq, Show)
 
-data TraceNodeIsLeader = TraceNodeIsLeader
-  { kind :: Text
-  , slot :: Int
-  } deriving (Eq, Show)
-
-instance FromJSON TraceNodeIsLeader where
-  parseJSON = Aeson.withObject "TraceNodeIsLeader" $ \v -> do
-    k <- v .: "val" >>= (.: "kind")
-    if k == "TraceNodeIsLeader"
-    then TraceNodeIsLeader k <$> (v .: "val" >>= (.: "slot"))
-    else fail $ "Expected kind was TraceNodeIsLeader, found " <> show k <> "instead"
+data TraceNode
+  = TraceNode
+    { isLeader :: !Bool
+    , kind     :: !Text
+    , slot     :: !Int
+    }
+  deriving (Eq, Show)
+
+instance FromJSON TraceNode where
+  parseJSON = Aeson.withObject "TraceNode" $ \v -> do
+    kind' <- v .: "val" >>= (.: "kind")
+    let slotP = v .: "val" >>= (.: "slot")
+    case kind' of
+      "TraceNodeIsLeader" -> TraceNode True kind' <$> slotP
+      "TraceNodeNotLeader" -> TraceNode False kind' <$> slotP
+      _ -> fail $ "Expected kind was TraceNodeIsLeader, found " <> show kind' <> "instead"
 
 instance FromJSON Kind where
   parseJSON = Aeson.withObject "Kind" $ \v ->
     Kind <$> v .: "kind"
 
-getRelevantLeaderSlots :: FilePath -> Int -> H.PropertyT (ReaderT IntegrationState (ResourceT IO)) [Int]
-getRelevantLeaderSlots poolNodeStdoutFile slotLowerBound = do
+getRelevantSlots :: FilePath -> Int -> H.PropertyT (ReaderT IntegrationState (ResourceT IO)) ([Int], [Int])
+getRelevantSlots poolNodeStdoutFile slotLowerBound = do
   vs <- readJsonLines poolNodeStdoutFile
+  let slots = L.map unLogEntry $ Maybe.mapMaybe (Aeson.parseMaybe Aeson.parseJSON) vs
+
   leaderSlots <- H.noteShow
-    $ L.map (slot . unLogEntry)
-    $ Maybe.mapMaybe (Aeson.parseMaybe (Aeson.parseJSON @(LogEntry TraceNodeIsLeader)))
-    vs
+    $ map slot
+    $ filter isLeader slots
+  notLeaderSlots <- H.noteShow
+    $ map slot
+    $ filter (not . isLeader) slots
+
   relevantLeaderSlots <- H.noteShow
     $ L.filter       (>= slotLowerBound)
     leaderSlots
-  return relevantLeaderSlots
+  relevantNotLeaderSlots <- H.noteShow
+    $ L.filter       (>= slotLowerBound)
+    notLeaderSlots
+
+  pure (relevantLeaderSlots, relevantNotLeaderSlots)

cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs

@@ -505,11 +505,19 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "alonzo-leadership-schedu
 
   -- We need enough time to pass such that the expected leadership slots generated by the
   -- leadership-schedule command have actually occurred.
-  leaderSlots <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
-    someLeaderSlots <- getRelevantLeaderSlots (nodeStdout $ poolRuntime poolNode1) (minimum expectedLeadershipSlotNumbers)
+  (leaderSlots, notLeaderSlots) <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
+    (someLeaderSlots, someNotLeaderSlots) <- getRelevantSlots (nodeStdout $ poolRuntime poolNode1) (minimum expectedLeadershipSlotNumbers)
     maxActualSlot <- H.noteShow $ maximum someLeaderSlots
     H.assert $ maxActualSlot >= maxSlotExpected
-    pure someLeaderSlots
+    pure (someLeaderSlots, someNotLeaderSlots)
+
+  H.noteShow_ expectedLeadershipSlotNumbers
+  H.noteShow_ leaderSlots
+  H.noteShow_ notLeaderSlots
+
+  -- Double check that we've seen all slots
+  H.annotate "Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader"
+  ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === []
 
   -- It's possible for some slots to not be assigned in TPraos when BFT nodes are running.
   -- TODO Remove BFT nodes from testnet and assert the schedule is equal to actual slots

cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs

@@ -21,7 +21,7 @@ import           Control.Monad (void)
 import           Data.List ((\\))
 import           Data.Monoid (Last (..))
 import           GHC.Stack (callStack)
-import           Hedgehog (Property)
+import           Hedgehog (Property, (===))
 import           Prelude
 import           System.Environment (getEnvironment)
 import           System.FilePath ((</>))
@@ -136,17 +136,22 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
 
     -- We need enough time to pass such that the expected leadership slots generated by the
     -- leadership-schedule command have actually occurred.
-    leaderSlots <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
-      someLeaderSlots <- getRelevantLeaderSlots (poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers)
+    (leaderSlots, notLeaderSlots) <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
+      (someLeaderSlots, someNotLeaderSlots) <- getRelevantSlots (poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers)
       if L.null someLeaderSlots
         then H.failure
         else do
           maxActualSlot <- H.noteShow $ maximum someLeaderSlots
           H.assert $ maxActualSlot >= maxSlotExpected
-          pure someLeaderSlots
+          pure (someLeaderSlots, someNotLeaderSlots)
 
     H.noteShow_ expectedLeadershipSlotNumbers
     H.noteShow_ leaderSlots
+    H.noteShow_ notLeaderSlots
+
+    -- Double check that we've seen all slots
+    H.annotate "Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader"
+    ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === []
 
     -- As there are no BFT nodes, the next leadership schedule should match slots assigned exactly
     H.assert $ L.null (expectedLeadershipSlotNumbers \\ leaderSlots)
@@ -178,17 +183,23 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch
 
     -- We need enough time to pass such that the expected leadership slots generated by the
     -- leadership-schedule command have actually occurred.
-    leaderSlots <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
-      someLeaderSlots <- getRelevantLeaderSlots (poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers)
+    (leaderSlots, notLeaderSlots) <- H.byDeadlineM 10 leadershipDeadline "Wait for chain to surpass all expected leadership slots" $ do
+      (someLeaderSlots, someNotLeaderSlots) <- getRelevantSlots (poolNodeStdout poolNode1) (minimum expectedLeadershipSlotNumbers)
       if L.null someLeaderSlots
         then H.failure
         else do
           maxActualSlot <- H.noteShow $ maximum someLeaderSlots
           H.assert $ maxActualSlot >= maxSlotExpected
-      pure someLeaderSlots
+      pure (someLeaderSlots, someNotLeaderSlots)
 
     H.noteShow_ expectedLeadershipSlotNumbers
     H.noteShow_ leaderSlots
+    H.noteShow_ notLeaderSlots
+
+    -- Double check that we've seen all slots
+    H.annotate "Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader"
+    ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === []
 
     -- As there are no BFT nodes, the next leadership schedule should match slots assigned exactly
     H.assert $ L.null (expectedLeadershipSlotNumbers \\ leaderSlots)
+