From 397c998c40b30a92ef0145502c83ab6b886f2a80 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Mon, 8 Jan 2024 16:38:30 -0700 Subject: [PATCH 1/3] Update commit for ouroboros-consensus source dep --- cabal.project | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/cabal.project b/cabal.project index 05151d9aae4..32cb6d87907 100644 --- a/cabal.project +++ b/cabal.project @@ -66,8 +66,8 @@ package bitvec source-repository-package type: git location: https://github.com/CardanoSolutions/ouroboros-consensus - tag: 79da9a368cb6d2e7ed5ff5e89bb318b94c3c606d - --sha256: 02wjbvgbfdr5rybncxgx6slxh4gzx1vh4i34n6h834qghiq4yykb + tag: b56731a6305ba9bf7d858716f64098fec97490fc + --sha256: 05hv6j1hbxbdajzgv2l8m5p8bvva3nqiapy4mwm1qy8qzmz1d6g4 subdir: ouroboros-consensus ouroboros-consensus-cardano From cd54ab859d38294ae54c9ff73d828d5a3da0d97a Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Mon, 8 Jan 2024 17:23:43 -0700 Subject: [PATCH 2/3] Fix LedgerEvent tests --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 3 ++ .../test/Test/Cardano/Node/LedgerEvent.hs | 52 +++++++++++-------- 2 files changed, 32 insertions(+), 23 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index bb29626c56f..79cfa4fd9f2 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -25,7 +25,9 @@ module Cardano.Node.LedgerEvent ( , LedgerNewEpochEvent (..) , LedgerRewardUpdateEvent (..) , Versioned (..) + , deserializeVersioned , ledgerEventName + , serializeVersioned -- ** Using Ledger events , StandardLedgerEventHandler @@ -732,6 +734,7 @@ 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 dad92f851d3..b2d2ca6de54 100644 --- a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DataKinds #-} {-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TemplateHaskell #-} module Test.Cardano.Node.LedgerEvent where @@ -13,6 +14,7 @@ import Data.ByteString (ByteString) import qualified Data.ByteString.Base16 as Hex import Data.ByteString.Lazy (fromStrict) import Data.ByteString.Short (ShortByteString, toShort) +import Data.Foldable (for_, toList) import Data.Map (Map) import Data.Maybe (fromJust) import Data.Set (Set) @@ -40,29 +42,30 @@ prop_roundtrip_LedgerEvent_CBOR :: Property prop_roundtrip_LedgerEvent_CBOR = Hedgehog.property $ do version <- Hedgehog.forAll Gen.enumBounded - event <- Hedgehog.forAll genAnchoredEvent - footnote ("serialized event: " <> show (Hex.encode $ serializeAnchoredEvent version event)) - Hedgehog.tripping event - (serializeAnchoredEvent version) - (fmap snd . deserializeAnchoredEvent . fromStrict) + event <- Hedgehog.forAll genAnchoredEvents + footnote ("serialized event: " <> show (Hex.encode $ serializeVersioned $ Versioned version event)) + Hedgehog.tripping (Versioned version event) + serializeVersioned + (fmap snd . deserializeVersioned . fromStrict) prop_LedgerEvent_CDDL_conformance :: Property prop_LedgerEvent_CDDL_conformance = Hedgehog.property $ do version <- Hedgehog.forAll Gen.enumBounded - event <- Hedgehog.forAll genAnchoredEvent + event <- Hedgehog.forAll genAnchoredEvents Hedgehog.label (labelName event) -- FIXME: We do want to validate full anchored events here, not just ledger events. -- This requires the `cddl-cat` Rust crate to support the '.cbor' control -- operator which should make for a straightforward and nice contribution. - let bytes = serialize' version (ledgerEvent event) - case CDDL.validate specification bytes of - Right () -> - Hedgehog.success - Left (CDDL.ValidationError { CDDL.cbor = cbor, CDDL.hint = hint }) -> do - Hedgehog.footnote hint - Hedgehog.footnote cbor - Hedgehog.failure + for_ (ledgerEvents event) $ \le -> do + let bytes = serialize' version le + case CDDL.validate specification bytes of + Right () -> + Hedgehog.success + Left (CDDL.ValidationError { CDDL.cbor = cbor, CDDL.hint = hint }) -> do + Hedgehog.footnote hint + Hedgehog.footnote cbor + Hedgehog.failure -- -- Generators @@ -72,17 +75,20 @@ type StakePoolId = KeyHash 'StakePool StandardCrypto type StakeCredential = Credential 'Staking StandardCrypto -genAnchoredEvent :: Hedgehog.Gen AnchoredEvent -genAnchoredEvent = - AnchoredEvent +genAnchoredEvents :: Hedgehog.Gen AnchoredEvents +genAnchoredEvents = + AnchoredEvents <$> (At <$> genBlockHeaderHash) <*> genBlockHeaderHash <*> genSlotNo <*> genBlockNo - <*> Gen.choice (mconcat - [ fmap LedgerNewEpochEvent <$> genLedgerNewEpochEvent - , fmap LedgerRewardUpdateEvent <$> genLedgerRewardUpdateEvent - ]) + <*> Gen.nonEmpty + (Range.linear 0 20) + (Gen.choice + (mconcat + [ fmap LedgerNewEpochEvent <$> genLedgerNewEpochEvent + , fmap LedgerRewardUpdateEvent <$> genLedgerRewardUpdateEvent + ])) genLedgerNewEpochEvent :: [Hedgehog.Gen (LedgerNewEpochEvent StandardCrypto)] genLedgerNewEpochEvent = @@ -191,10 +197,10 @@ genStakeCredentialMap genValue = Gen.map (Range.linear 0 3) ((,) <$> genCredential <*> genValue) labelName - :: AnchoredEvent + :: AnchoredEvents -> Hedgehog.LabelName labelName = - fromString . T.unpack . ledgerEventName . ledgerEvent + fromString . T.unpack . T.intercalate "," . map ledgerEventName . toList . ledgerEvents unsafeHashFromBytes :: (HashAlgorithm algo) From 1104a4bb79620e1851d41748f23b51c1c63be337 Mon Sep 17 00:00:00 2001 From: Neil Mayhew Date: Fri, 5 Jan 2024 17:07:14 -0700 Subject: [PATCH 3/3] Allow ledgerEvents to be an empty list in AnchoredEvents This allows us to keep track of the hashes of blocks that don't generate any ledger events --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 11 ++++++----- cardano-node/test/Test/Cardano/Node/LedgerEvent.hs | 2 +- 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index 79cfa4fd9f2..4c39a02f5ad 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -90,7 +90,7 @@ import qualified Codec.CBOR.Decoding as CBOR import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Read as CBOR import qualified Codec.CBOR.Write as CBOR -import Control.Arrow ((&&&)) +import Control.Arrow ((&&&), (***)) import Control.Concurrent.STM (newTChanIO, readTChan, writeTChan) import Control.Monad.Fail (MonadFail (..)) import Control.State.Transition (Event) @@ -159,7 +159,7 @@ instance Crypto crypto => DecCBOR (LedgerEvent crypto) where SumD LedgerBody decRaw n = Invalid n -type LedgerEvents = NE.NonEmpty (LedgerEvent StandardCrypto) -- ^ convenient alias to refer to a list of LedgerEvents +type LedgerEvents = [LedgerEvent StandardCrypto] -- ^ convenient alias to refer to a list of LedgerEvents -- TODO(KtorZ): Discuss that design choice; I believe we should favor a more -- 'flat' structure for events instead of preserving whatever the ledger imposes @@ -711,7 +711,7 @@ data AnchoredEvents = , blockHeaderHash :: !ShortByteString , slotNo :: !SlotNo , blockNo :: !BlockNo - , ledgerEvents :: !(NonEmpty (LedgerEvent StandardCrypto)) + , ledgerEvents :: ![LedgerEvent StandardCrypto] } deriving (Eq, Show) @@ -850,5 +850,6 @@ mkVersionedAnchoredEvents prevHash headerHash slotNo blockNo auxEvents = chainHashToOriginHash :: ChainHash b -> WithOrigin (HeaderHash b) chainHashToOriginHash GenesisHash = Origin chainHashToOriginHash (BlockHash bh) = At bh - versionedEvents = mapMaybe (sequence . (eventCodecVersion &&& fromAuxLedgerEvent)) auxEvents - versionedGroups = map (first NE.head . NE.unzip) . NE.groupBy ((==) `on` fst) $ versionedEvents + versionedEvents = map (eventCodecVersion &&& fromAuxLedgerEvent) auxEvents + versionedGroups = map makeGroup $ NE.groupWith fst versionedEvents + makeGroup = (NE.head *** catMaybes . NE.toList) . NE.unzip diff --git a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs index b2d2ca6de54..53d708c3297 100644 --- a/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/test/Test/Cardano/Node/LedgerEvent.hs @@ -82,7 +82,7 @@ genAnchoredEvents = <*> genBlockHeaderHash <*> genSlotNo <*> genBlockNo - <*> Gen.nonEmpty + <*> Gen.list (Range.linear 0 20) (Gen.choice (mconcat