Add a property test for sequential hashes coming from LedgerEventHandler

CardanoSolutions · Jan 9, 2024 · ca2eb89 · ca2eb89
1 parent 1104a4b
commit ca2eb89
Show file tree

Hide file tree

Showing 3 changed files with 68 additions and 3 deletions.
diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -243,7 +243,10 @@ test-suite cardano-node-test
                       , base16-bytestring
                       , cardano-crypto-class
                       , cardano-api
+                      , cardano-ledger-alonzo
+                      , cardano-ledger-conway
                       , cardano-ledger-core
+                      , cardano-ledger-shelley
                       , cardano-node
                       , cardano-slotting
                       , cddl

diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs
@@ -733,8 +733,10 @@ instance DecCBOR AnchoredEvents where
       <! From
       <! From
 
-data Versioned a = Versioned Version a
-  deriving (Eq, Ord, Show)
+data Versioned a = Versioned
+  { versionedVersion :: Version
+  , versionedData :: a
+  } deriving (Eq, Ord, Show)
 
 serializeVersioned :: EncCBOR a => Versioned a -> ByteString
 serializeVersioned (Versioned version x) =

diff --git a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs
@@ -9,27 +9,44 @@ import           Prelude
 import           Cardano.Node.LedgerEvent
 
 import           Cardano.Crypto.Hash (Hash, HashAlgorithm, hashFromBytes)
+import           Cardano.Ledger.Alonzo.Rules (AlonzoBbodyEvent (ShelleyInAlonzoEvent))
+import qualified Cardano.Ledger.Conway.Rules as Conway
+import qualified Cardano.Ledger.Shelley.Rules as Shelley
+import           Cardano.Ledger.Shelley.API (InstantaneousRewards (..), KeyHash (..),
+                   ScriptHash (..))
+import           Cardano.Ledger.Shelley.Rules (RupdEvent (..), ShelleyEpochEvent (..),
+                   ShelleyMirEvent (..), ShelleyNewEpochEvent, ShelleyPoolreapEvent (..),
+                   ShelleyTickEvent (..))
 import qualified Codec.CBOR.Schema as CDDL
+import           Control.Monad.IO.Class (liftIO)
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as Hex
 import           Data.ByteString.Lazy (fromStrict)
 import           Data.ByteString.Short (ShortByteString, toShort)
+import qualified Data.ByteString.Short as SB
 import           Data.Foldable (for_, toList)
+import           Data.IORef (modifyIORef, newIORef, readIORef)
 import           Data.Map (Map)
 import           Data.Maybe (fromJust)
 import           Data.Set (Set)
 import           Data.String (IsString (..))
 import           Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
-import           Hedgehog (Property, discover, footnote)
+import           Hedgehog ((===), Property, discover, footnote)
 import qualified Hedgehog
 import qualified Hedgehog.Extras.Test.Process as Hedgehog
 import qualified Hedgehog.Gen as Gen
 import qualified Hedgehog.Internal.Property as Hedgehog
 import qualified Hedgehog.Range as Range
+import           Ouroboros.Consensus.Cardano.Block (CardanoEras, HardForkBlock)
+import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras (OneEraHash (OneEraHash))
+import           Ouroboros.Consensus.Ledger.Abstract (AuxLedgerEvent, LedgerEventHandler (handleLedgerEvent), LedgerState)
+import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock, ShelleyLedgerEvent (..))
+import           Ouroboros.Network.Block (ChainHash (BlockHash, GenesisHash), HeaderHash)
 import           System.FilePath ((</>))
 import           System.IO.Unsafe (unsafePerformIO)
+import           Text.Printf (printf)
 
 specification :: Text
 specification =
@@ -67,6 +84,41 @@ prop_LedgerEvent_CDDL_conformance =
         Hedgehog.footnote cbor
         Hedgehog.failure
 
+prop_LedgerEventHandler_sequentialEvents :: Property
+prop_LedgerEventHandler_sequentialEvents =
+  Hedgehog.property $ do
+
+  auxEvents <- Hedgehog.forAll $
+    Gen.list (Range.linear 2 20) $
+      Gen.list (Range.linear 1 3)
+        genAuxLedgerEvent
+
+  start <- Hedgehog.forAll $ Gen.word $ Range.constant 1 99
+
+  let slots = zip [start ..] auxEvents
+
+  anchoredEvents <- liftIO $ do
+    ref <- newIORef []
+    let writer aes = modifyIORef ref (aes :)
+        handler = handleLedgerEvent $ mkLedgerEventHandler writer
+    for_ slots $ \(s, es) -> do
+      let p = dummyChainHash (pred s)
+          h = dummyHeaderHash s
+      handler p h (fromIntegral s) 1 es
+    map versionedData . reverse <$> readIORef ref
+
+  let prevs = map prevBlockHeaderHash anchoredEvents
+      currs = map (At . blockHeaderHash) anchoredEvents
+
+  tail prevs === init currs
+
+dummyHeaderHash :: Word -> HeaderHash (HardForkBlock (CardanoEras StandardCrypto))
+dummyHeaderHash = OneEraHash . SB.pack . map (toEnum . fromEnum) . printf "%032d"
+
+dummyChainHash :: Word -> ChainHash (HardForkBlock (CardanoEras StandardCrypto))
+dummyChainHash 0 = GenesisHash
+dummyChainHash i = BlockHash $ dummyHeaderHash i
+
 --
 -- Generators
 --
@@ -75,6 +127,14 @@ type StakePoolId = KeyHash 'StakePool StandardCrypto
 
 type StakeCredential = Credential 'Staking StandardCrypto
 
+genAuxLedgerEvent :: Hedgehog.Gen (AuxLedgerEvent (LedgerState (HardForkBlock xs)))
+genAuxLedgerEvent =
+  Gen.choice
+    -- TODO: Add more types
+    [ ShelleyLedgerEventTICK . TickNewEpochEvent <$> (Conway.TotalRewardEvent <$> genEpoch <*> genRewardDistribution)
+    , ShelleyLedgerEventBBODY . ShelleyInAlonzoEvent . Shelley.LedgersEvent . Shelley.LedgerEvent . Conway.GovEvent <$> _
+    ]
+
 genAnchoredEvents :: Hedgehog.Gen AnchoredEvents
 genAnchoredEvents =
   AnchoredEvents