From fcd3744e87a2ec75ace3330ea31dbef47c21a010 Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 17 Apr 2023 16:53:15 +0200 Subject: [PATCH 1/2] Additional check for not-leader slots in LeadershipSchedule tests --- cardano-testnet/src/Testnet/Util/Assert.hs | 50 ++++++++++++------- .../Test/Cli/Alonzo/LeadershipSchedule.hs | 14 ++++-- .../Test/Cli/Babbage/LeadershipSchedule.hs | 25 +++++++--- 3 files changed, 61 insertions(+), 28 deletions(-) diff --git a/cardano-testnet/src/Testnet/Util/Assert.hs b/cardano-testnet/src/Testnet/Util/Assert.hs index 8eb3ec69b1b..6724f586c89 100644 --- a/cardano-testnet/src/Testnet/Util/Assert.hs +++ b/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) diff --git a/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs b/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs index 1801de3f0fc..1d44f5f4b10 100644 --- a/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs +++ b/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 diff --git a/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs index 48f1d1c1a5e..f3ea42a1640 100644 --- a/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs +++ b/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) + From 45657ed52bad3363d429a20162ec7bdb6809c3ff Mon Sep 17 00:00:00 2001 From: Mateusz Galazyn Date: Mon, 17 Apr 2023 17:39:30 +0200 Subject: [PATCH 2/2] Replace H.annotate with H.noteShow_ --- cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs | 3 ++- cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs | 5 +++-- 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs b/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs index 1d44f5f4b10..13c738427a4 100644 --- a/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs +++ b/cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs @@ -22,6 +22,7 @@ import qualified Data.Map.Strict as Map import Data.Monoid (Last (..)) import Data.Set (Set) import qualified Data.Set as Set +import Data.Text (Text) import qualified Data.Text as T import qualified Data.Time.Clock as DTC import GHC.Stack (callStack) @@ -516,7 +517,7 @@ hprop_leadershipSchedule = integrationRetryWorkspace 2 "alonzo-leadership-schedu H.noteShow_ notLeaderSlots -- Double check that we've seen all slots - H.annotate "Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" + H.noteShow_ ("Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" :: Text) ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === [] -- It's possible for some slots to not be assigned in TPraos when BFT nodes are running. diff --git a/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs b/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs index f3ea42a1640..8d8deff5e0c 100644 --- a/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs +++ b/cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs @@ -20,6 +20,7 @@ import Cardano.CLI.Shelley.Output (QueryTipLocalStateOutput (..)) import Control.Monad (void) import Data.List ((\\)) import Data.Monoid (Last (..)) +import Data.Text (Text) import GHC.Stack (callStack) import Hedgehog (Property, (===)) import Prelude @@ -150,7 +151,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch H.noteShow_ notLeaderSlots -- Double check that we've seen all slots - H.annotate "Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" + H.noteShow_ ("Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" :: Text) ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === [] -- As there are no BFT nodes, the next leadership schedule should match slots assigned exactly @@ -197,7 +198,7 @@ hprop_leadershipSchedule = H.integrationRetryWorkspace 2 "babbage-leadership-sch H.noteShow_ notLeaderSlots -- Double check that we've seen all slots - H.annotate "Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" + H.noteShow_ ("Slots not seen as TraceNodeIsLeader nor TraceNodeNotLeader" :: Text) ([minimum expectedLeadershipSlotNumbers .. maxSlotExpected] \\ leaderSlots) \\ notLeaderSlots === [] -- As there are no BFT nodes, the next leadership schedule should match slots assigned exactly