Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Additional check for not-leader slots in LeadershipSchedule tests #5110

Merged
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
50 changes: 32 additions & 18 deletions cardano-testnet/src/Testnet/Util/Assert.hs
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@
module Testnet.Util.Assert
( readJsonLines
, assertChainExtended
, getRelevantLeaderSlots
, getRelevantSlots
) where

import Prelude hiding (lines)
Expand Down Expand Up @@ -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
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Why the rename? TraceNodeIsLeader was a good name.

Copy link
Contributor Author

@carbolymer carbolymer Apr 18, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I needed a type which would also capture TraceNodeNotLeader . So my options were:

  1. create another similar type, with the same fields, duplicate ToJSON instance
  2. rename the type, create two constructors TraceNodeIsLeader and TraceNodeNotLeader , both with fields slot and kind
  3. rename the type and the constructor, add isLeader flag

3rd looked like the least amount of duplication. Which alternative would you propose?

= 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])
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Returning something like data LeadershipSlots = LeadershipSlots { leaderSlots :: [Int], notLeaderSlots :: [Int] } would make this more readable.

getRelevantSlots poolNodeStdoutFile slotLowerBound = do
Copy link
Contributor Author

@carbolymer carbolymer Apr 17, 2023

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This function now returns all slots seen in the logs. This is useful to double check if we didn't omit any slot, especially those with TraceNodeNotLeader entries in logs.

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Are TraceNodeIsLeader and TraceNodeNotLeader definitely the only two TraceNode kinds?

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There's also TraceNodeCannotForge - should we check for it as well?

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)
15 changes: 12 additions & 3 deletions cardano-testnet/test/Test/Cli/Alonzo/LeadershipSchedule.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -505,11 +506,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.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.
-- TODO Remove BFT nodes from testnet and assert the schedule is equal to actual slots
Expand Down
26 changes: 19 additions & 7 deletions cardano-testnet/test/Test/Cli/Babbage/LeadershipSchedule.hs
Original file line number Diff line number Diff line change
Expand Up @@ -20,8 +20,9 @@ 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 Hedgehog (Property, (===))
import Prelude
import System.Environment (getEnvironment)
import System.FilePath ((</>))
Expand Down Expand Up @@ -136,17 +137,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.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
H.assert $ L.null (expectedLeadershipSlotNumbers \\ leaderSlots)
Expand Down Expand Up @@ -178,17 +184,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.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
H.assert $ L.null (expectedLeadershipSlotNumbers \\ leaderSlots)