diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 80f8a691651..d8ba9cec73b 100644 --- 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 index 4c39a02f5ad..e56095093f0 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -733,8 +733,10 @@ instance DecCBOR AnchoredEvents where 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 index 53d708c3297..610e6847b8b 100644 --- a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs @@ -9,12 +9,23 @@ 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) @@ -22,14 +33,20 @@ 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