New Alonzo leadership schedule test

IntersectMBO · Jun 26, 2022 · eb74e22 · eb74e22
1 parent 7599ade
commit eb74e22
Show file tree

Hide file tree

Showing 5 changed files with 560 additions and 7 deletions.
diff --git a/cardano-testnet/cardano-testnet.cabal b/cardano-testnet/cardano-testnet.cabal
@@ -52,6 +52,7 @@ library
                       , safe-exceptions
                       , text
                       , time
+                      , transformers
                       , unordered-containers
 
   hs-source-dirs:       src
@@ -123,8 +124,10 @@ test-suite cardano-testnet-tests
                       , tasty-expected-failure
                       , tasty-hedgehog
                       , text
+                      , time
 
   other-modules:
+                        Spec.Cli.Alonzo.LeadershipSchedule
                         Spec.Cli.KesPeriodInfo
                         Spec.Node.Shutdown
                         Spec.ShutdownOnSlotSynced

diff --git a/cardano-testnet/src/Test/Assert.hs b/cardano-testnet/src/Test/Assert.hs
@@ -1,22 +1,31 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE TypeApplications #-}
 
+{- HLINT ignore "Redundant return" -}
+
 module Test.Assert
   ( readJsonLines
   , assertChainExtended
+  , getRelevantLeaderSlots
   ) where
 
-import Control.Lens ((^.))
+import Control.Lens ((^.), (^?), to)
 import Control.Monad (Monad(..))
 import Control.Monad.IO.Class (MonadIO)
+import Control.Monad.Trans.Reader (ReaderT)
+import Control.Monad.Trans.Resource (ResourceT)
 import Data.Aeson (Value)
 import Data.Bool (Bool(..))
 import Data.Eq (Eq (..))
 import Data.Function ((.), ($))
 import Data.Functor ((<$>))
+import Data.Int (Int)
 import Data.Maybe (mapMaybe)
+import Data.Ord (Ord(..))
 import GHC.Stack (HasCallStack)
 import Hedgehog (MonadTest)
+import Hedgehog.Extras.Internal.Test.Integration (IntegrationState)
+import Prelude (fromIntegral)
 import System.FilePath (FilePath)
 import System.IO (IO)
 import Test.Runtime (NodeLoggingFormat(..))
@@ -25,9 +34,11 @@ import qualified Data.Aeson as J
 import qualified Data.Aeson.Lens as J
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.List as L
+import qualified Data.Maybe as Maybe
 import qualified Data.Time.Clock as DTC
 import qualified Hedgehog as H
 import qualified Hedgehog.Extras.Stock.IO.File as IO
+import qualified Hedgehog.Extras.Test.Base as H
 import qualified Test.Process as H
 
 readJsonLines :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m [Value]
@@ -50,3 +61,14 @@ assertChainExtended deadline nodeLoggingFormat nodeStdoutFile =
       NodeLoggingFormatAsText -> IO.fileContains "Chain extended, new tip" nodeStdoutFile
       NodeLoggingFormatAsJson -> fileJsonGrep nodeStdoutFile (\v -> v ^. J.key "data" . J.key "kind" . J._String == "")
 
+getRelevantLeaderSlots :: FilePath -> Int -> H.PropertyT (ReaderT IntegrationState (ResourceT IO)) [Int]
+getRelevantLeaderSlots poolNodeStdoutFile slotLowerBound = do
+  vs <- readJsonLines poolNodeStdoutFile
+  leaderSlots <- H.noteShow
+    $ Maybe.mapMaybe (\v -> v ^? J.key "data" . J.key "val" . J.key "slot" . J._Integer. to fromIntegral)
+    $ L.filter       (\v -> v ^. J.key "data" . J.key "val" . J.key "kind" . J._String == "TraceNodeIsLeader")
+    vs
+  relevantLeaderSlots <- H.noteShow
+    $ L.filter       (>= slotLowerBound)
+    leaderSlots
+  return relevantLeaderSlots
diff --git a/cardano-testnet/src/Testnet/Cardano.hs b/cardano-testnet/src/Testnet/Cardano.hs
@@ -477,12 +477,6 @@ testnet testnetOptions H.Conf {..} = do
   -- Make the pool operator cold keys
   -- This was done already for the BFT nodes as part of the genesis creation
 
-        -- poolVrfVkeys
-        -- poolVrfSkeys
-        -- poolStakingVkeys
-        -- poolStakingSkeys
-        -- (poolVrfVkeys, poolVrfSkeys, poolStakingVkeys, poolStakingSkeys)
-
   poolKeys <- forM poolNodesN $ \i -> do
     let node = "node-pool" <> show @Int i
 

diff --git a/cardano-testnet/test/Main.hs b/cardano-testnet/test/Main.hs
@@ -7,6 +7,7 @@ module Main
 import           Prelude
 import           Test.Tasty (TestTree)
 
+import qualified Spec.Cli.Alonzo.LeadershipSchedule
 -- import qualified Spec.Cli.KesPeriodInfo
 import qualified Spec.Node.Shutdown
 import qualified Spec.ShutdownOnSlotSynced
@@ -20,6 +21,9 @@ tests = pure $ T.testGroup "test/Spec.hs"
   [ T.testGroup "Spec"
     [ H.ignoreOnWindows "Shutdown" Spec.Node.Shutdown.hprop_shutdown
     , H.ignoreOnWindows "ShutdownOnSlotSynced" Spec.ShutdownOnSlotSynced.hprop_shutdownOnSlotSynced
+    , T.testGroup "Alonzo"
+      [ H.ignoreOnWindows "leadership-schedule" Spec.Cli.Alonzo.LeadershipSchedule.hprop_leadershipSchedule
+      ]
       -- Ignored on Windows due to <stdout>: commitBuffer: invalid argument (invalid character)
       -- as a result of the kes-period-info output to stdout.
       -- TODO: Babbage temporarily ignored due to broken protocol-state query