diff --git a/ouroboros-consensus-cardano/app/snapshot-converter.hs b/ouroboros-consensus-cardano/app/snapshot-converter.hs index c1d98d01aa..ff78fa54b4 100644 --- a/ouroboros-consensus-cardano/app/snapshot-converter.hs +++ b/ouroboros-consensus-cardano/app/snapshot-converter.hs @@ -233,7 +233,6 @@ data OutEnv = OutEnv LedgerState (CardanoBlock StandardCrypto) EmptyMK -> ResourceRegistry IO -> IO (SinkArgs (LedgerState (CardanoBlock StandardCrypto)) IO) - , outCreateExtra :: Maybe FilePath , outDeleteExtra :: Maybe FilePath , outProgressMsg :: String , outBackend :: SnapshotBackend @@ -287,13 +286,12 @@ main = withStdTerminalHandles $ do let crcOut = maybe inCRC (crcOfConcat inCRC) mCRCOut lift $ putStr "Generating new metadata file..." >> hFlush stdout - putMetadata outFilePath (SnapshotMetadata outBackend crcOut) + putMetadata outFilePath (SnapshotMetadata outBackend crcOut TablesCodecVersion1) lift $ putColored Green True "Done" wipeOutputPaths OutEnv{..} = do wipePath outFilePath - lift $ maybe (pure ()) (D.createDirectory . (outFilePath F.)) outCreateExtra maybe (pure ()) wipePath @@ -356,7 +354,7 @@ main = withStdTerminalHandles $ do InEnv st fp - (fromInMemory (fp F. "tables" F. "tvar")) + (fromInMemory (fp F. "tables")) ("InMemory@[" <> fp <> "]") c mtd @@ -412,8 +410,7 @@ main = withStdTerminalHandles $ do pure $ OutEnv fp - (toInMemory (fp F. "tables" F. "tvar")) - (Just "tables") + (toInMemory (fp F. "tables")) Nothing ("InMemory@[" <> fp <> "]") UTxOHDMemSnapshot @@ -431,7 +428,6 @@ main = withStdTerminalHandles $ do fp (toLMDB fp defaultLMDBLimits) Nothing - Nothing ("LMDB@[" <> fp <> "]") UTxOHDLMDBSnapshot LSM fp lsmDbPath -> do @@ -447,7 +443,6 @@ main = withStdTerminalHandles $ do OutEnv fp (toLSM lsmDbPath (last $ splitDirectories fp)) - Nothing (Just lsmDbPath) ("LSM@[" <> lsmDbPath <> "]") UTxOHDLSMSnapshot diff --git a/ouroboros-consensus-cardano/changelog.d/20250904_155947_javier.sagredo_version_tables.md b/ouroboros-consensus-cardano/changelog.d/20250904_155947_javier.sagredo_version_tables.md new file mode 100644 index 0000000000..7cb1d4cd00 --- /dev/null +++ b/ouroboros-consensus-cardano/changelog.d/20250904_155947_javier.sagredo_version_tables.md @@ -0,0 +1,23 @@ + + + + + +### Breaking + +- Change `TxIn (ShelleyBlock proto era)` to `BigEndianTxIn` which is a newtype wrapper over `TxIn` that *only* modifies the `MemPack` instance to ensure big-endian serialization. diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Alonzo b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Alonzo index 711ac926d4..e0d2a9ff87 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Alonzo and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Alonzo differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Babbage b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Babbage index 40ac2a6b03..16698aa6f6 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Babbage and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Babbage differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Conway b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Conway index 40ac2a6b03..16698aa6f6 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Conway and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Conway differ diff --git a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Dijkstra b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Dijkstra index 40ac2a6b03..16698aa6f6 100644 Binary files a/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Dijkstra and b/ouroboros-consensus-cardano/golden/cardano/disk/LedgerTables_Dijkstra differ diff --git a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal index 98286f47d7..077f7a5f14 100644 --- a/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal +++ b/ouroboros-consensus-cardano/ouroboros-consensus-cardano.cabal @@ -375,6 +375,7 @@ test-suite shelley-test containers, filepath, measures, + mempack, microlens, ouroboros-consensus:{ouroboros-consensus, unstable-consensus-testlib}, ouroboros-consensus-cardano, diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs index 2be95e56c4..1bae44982b 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/CanHardFork.hs @@ -466,6 +466,7 @@ translateLedgerStateShelleyToAllegraWrapper = LedgerTables . DiffMK . Diff.fromMapDeletes + . coerceTxInMapKeys . Map.map SL.upgradeTxOut $ avvms @@ -478,6 +479,7 @@ translateLedgerStateShelleyToAllegraWrapper = . withLedgerTables ls . LedgerTables . ValuesMK + . coerceTxInMapKeys $ avvms resultingState = diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs index 536743defe..7dffcff9f0 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/Ledger.hs @@ -28,7 +28,6 @@ import Cardano.Ledger.Binary.Decoding hiding (Decoder) import Cardano.Ledger.Binary.Encoding hiding (Encoding) import qualified Cardano.Ledger.Conway.State as SL import Cardano.Ledger.Core (Era, eraDecoder, eraProtVerLow) -import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Ledger.Shelley.LedgerState as SL ( esLStateL , lsCertStateL @@ -57,7 +56,8 @@ import Ouroboros.Consensus.Ledger.Tables import Ouroboros.Consensus.Protocol.Praos (Praos) import Ouroboros.Consensus.Protocol.TPraos (TPraos) import Ouroboros.Consensus.Shelley.Ledger - ( IsShelleyBlock + ( BigEndianTxIn + , IsShelleyBlock , ShelleyBlock , ShelleyCompatible , shelleyLedgerState @@ -70,7 +70,7 @@ instance HasCanonicalTxIn (CardanoEras c) where newtype CanonicalTxIn (CardanoEras c) = CardanoTxIn - { getCardanoTxIn :: SL.TxIn + { getCardanoTxIn :: BigEndianTxIn } deriving stock (Show, Eq, Ord) deriving newtype NoThunks diff --git a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/QueryHF.hs b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/QueryHF.hs index bfed11149c..cc1a248470 100644 --- a/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/QueryHF.hs +++ b/ouroboros-consensus-cardano/src/ouroboros-consensus-cardano/Ouroboros/Consensus/Cardano/QueryHF.hs @@ -19,6 +19,7 @@ module Ouroboros.Consensus.Cardano.QueryHF () where +import Data.Coerce import Data.Functor.Product import Data.SOP.BasicFunctors import Data.SOP.Constraint @@ -98,14 +99,14 @@ instance CardanoHardForkConstraints c => BlockSupportsHFLedgerQuery (CardanoEras answerShelleyLookupQueries (injectLedgerTables idx) (ejectHardForkTxOut idx) - (ejectCanonicalTxIn idx) + (coerce . ejectCanonicalTxIn idx) ) answerBlockQueryHFTraverse = answerCardanoQueryHF ( \idx -> answerShelleyTraversingQueries (ejectHardForkTxOut idx) - (ejectCanonicalTxIn idx) + (coerce . ejectCanonicalTxIn idx) (queryLedgerGetTraversingFilter idx) ) diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs index c096ab5d87..77e64c8bda 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Ledger.hs @@ -54,10 +54,13 @@ module Ouroboros.Consensus.Shelley.Ledger.Ledger -- * Low-level UTxO manipulations , slUtxoL + , BigEndianTxIn (..) + , coerceTxInSet + , coerceTxInMapKeys ) where import qualified Cardano.Ledger.BHeaderView as SL (BHeaderView) -import qualified Cardano.Ledger.BaseTypes as SL (epochInfoPure) +import qualified Cardano.Ledger.BaseTypes as SL (TxIx (..), epochInfoPure) import Cardano.Ledger.BaseTypes.NonZero (unNonZero) import Cardano.Ledger.Binary.Decoding ( decShareCBOR @@ -97,9 +100,11 @@ import Control.Arrow (left, second) import qualified Control.Exception as Exception import Control.Monad.Except import qualified Control.State.Transition.Extended as STS -import Data.Coerce (coerce) +import Data.Coerce import Data.Functor.Identity +import Data.Map.Strict (Map) import Data.MemPack +import Data.Set (Set) import qualified Data.Text as T import qualified Data.Text as Text import Data.Word @@ -135,7 +140,9 @@ import Ouroboros.Consensus.Util.CBOR , encodeWithOrigin ) import Ouroboros.Consensus.Util.IndexedMemPack +import Ouroboros.Consensus.Util.RedundantConstraints (keepRedundantConstraint) import Ouroboros.Consensus.Util.Versioned +import Unsafe.Coerce {------------------------------------------------------------------------------- Config @@ -317,7 +324,32 @@ shelleyLedgerTipPoint = shelleyTipToPoint . shelleyLedgerTip instance ShelleyCompatible proto era => UpdateLedger (ShelleyBlock proto era) -type instance TxIn (LedgerState (ShelleyBlock proto era)) = SL.TxIn +-- | The only purpose of this type is to modify the MemPack instance to use big +-- endian serialization. This is necessary to ensure streaming functions of the +-- UTxO set preserve the order of the entries, as otherwise we would get +-- different sortings if sorting via the Serialized form and the Haskell Ord +-- instance. +newtype BigEndianTxIn = BigEndianTxIn {getOriginalTxIn :: SL.TxIn} + deriving newtype (Eq, Show, Ord, NoThunks) + +newtype BigEndianTxIx = BigEndianTxIx {getOriginalTxIx :: SL.TxIx} + +instance MemPack BigEndianTxIx where + typeName = "BigEndianTxIx" + packedByteCount = packedByteCount . getOriginalTxIx + packM (BigEndianTxIx (SL.TxIx w)) = packM (byteSwap16 w) + unpackM = BigEndianTxIx . SL.TxIx . byteSwap16 <$> unpackM + +instance MemPack BigEndianTxIn where + typeName = "BigEndianTxIn" + packedByteCount = packedByteCount . getOriginalTxIn + packM (BigEndianTxIn (SL.TxIn txid txix)) = do + packM txid + packM (BigEndianTxIx txix) + unpackM = do + BigEndianTxIn <$> (SL.TxIn <$> unpackM <*> (getOriginalTxIx <$> unpackM)) + +type instance TxIn (LedgerState (ShelleyBlock proto era)) = BigEndianTxIn type instance TxOut (LedgerState (ShelleyBlock proto era)) = Core.TxOut era instance @@ -397,7 +429,7 @@ instance , shelleyLedgerTables = emptyLedgerTables } where - (_, shelleyLedgerState') = shelleyLedgerState `slUtxoL` SL.UTxO m + (_, shelleyLedgerState') = shelleyLedgerState `slUtxoL` SL.UTxO (coerceTxInMapKeys m) ShelleyLedgerState { shelleyLedgerTip , shelleyLedgerState @@ -409,7 +441,7 @@ instance { shelleyLedgerTip = shelleyLedgerTip , shelleyLedgerState = shelleyLedgerState' , shelleyLedgerTransition = shelleyLedgerTransition - , shelleyLedgerTables = LedgerTables (ValuesMK (SL.unUTxO tbs)) + , shelleyLedgerTables = LedgerTables (ValuesMK (coerceTxInMapKeys $ SL.unUTxO tbs)) } where (tbs, shelleyLedgerState') = shelleyLedgerState `slUtxoL` mempty @@ -419,6 +451,26 @@ instance , shelleyLedgerTransition } = st +-- | UNSAFE: use this function to coerce a @'Map' 'TxIn' ('TxOut' l)@ into and from +-- a @'Map' 'BigEndianTxIn' ('TxOut' l)@. +-- +-- This is only safe in such case because the keys are coercible and the 'Ord' +-- instance is exactly the same. +coerceTxInMapKeys :: forall k1 k2 v. Coercible k1 k2 => Map k1 v -> Map k2 v +coerceTxInMapKeys = unsafeCoerce + where + _ = keepRedundantConstraint (Proxy @(Coercible k1 k2)) + +-- | UNSAFE: use this function to coerce a @'Set' 'TxIn'@ into and from +-- a @'Set' 'BigEndianTxIn'@. +-- +-- This is only safe in such case because the keys are coercible and the 'Ord' +-- instance is exactly the same. +coerceTxInSet :: forall k1 k2. Coercible k1 k2 => Set k1 -> Set k2 +coerceTxInSet = unsafeCoerce + where + _ = keepRedundantConstraint (Proxy @(Coercible k1 k2)) + instance ShelleyBasedEra era => CanStowLedgerTables (Ticked (LedgerState (ShelleyBlock proto era))) @@ -432,7 +484,7 @@ instance } where (_, tickedShelleyLedgerState') = - tickedShelleyLedgerState `slUtxoL` SL.UTxO tbs + tickedShelleyLedgerState `slUtxoL` SL.UTxO (coerceTxInMapKeys tbs) TickedShelleyLedgerState { untickedShelleyLedgerTip , tickedShelleyLedgerTransition @@ -445,7 +497,7 @@ instance { untickedShelleyLedgerTip = untickedShelleyLedgerTip , tickedShelleyLedgerTransition = tickedShelleyLedgerTransition , tickedShelleyLedgerState = tickedShelleyLedgerState' - , tickedShelleyLedgerTables = LedgerTables (ValuesMK (SL.unUTxO tbs)) + , tickedShelleyLedgerTables = LedgerTables (ValuesMK (coerceTxInMapKeys (SL.unUTxO tbs))) } where (tbs, tickedShelleyLedgerState') = tickedShelleyLedgerState `slUtxoL` mempty @@ -583,6 +635,7 @@ instance getBlockKeySets = LedgerTables . KeysMK + . coerceTxInSet . Core.neededTxInsForBlock . shelleyBlockRaw diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs index 8ea85ed54b..75df8c78f8 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Mempool.hs @@ -98,8 +98,10 @@ import Ouroboros.Consensus.Ledger.Tables.Utils import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.Ledger.Block import Ouroboros.Consensus.Shelley.Ledger.Ledger - ( ShelleyLedgerConfig (shelleyLedgerGlobals) + ( BigEndianTxIn (..) + , ShelleyLedgerConfig (shelleyLedgerGlobals) , Ticked (TickedShelleyLedgerState, tickedShelleyLedgerState) + , coerceTxInSet , getPParams ) import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto) @@ -177,8 +179,9 @@ instance getTransactionKeySets (ShelleyTx _ tx) = LedgerTables $ - KeysMK - (tx ^. bodyTxL . allInputsTxBodyF) + KeysMK $ + coerceTxInSet + (tx ^. bodyTxL . allInputsTxBodyF) mkShelleyTx :: forall era proto. ShelleyBasedEra era => Tx era -> GenTx (ShelleyBlock proto era) mkShelleyTx tx = ShelleyTx (txIdTx tx) tx diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs index a71fc8ec8c..d4a9ab7339 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/Ledger/Query.hs @@ -67,6 +67,7 @@ import qualified Codec.CBOR.Encoding as CBOR import Codec.Serialise (decode, encode) import Control.DeepSeq (NFData) import Data.Bifunctor (second) +import Data.Coerce import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.MemPack @@ -554,9 +555,9 @@ instance hst = headerState ext st = shelleyLedgerState lst - answerBlockQueryLookup = answerShelleyLookupQueries id id id + answerBlockQueryLookup = answerShelleyLookupQueries id id coerce - answerBlockQueryTraverse = answerShelleyTraversingQueries id id shelleyQFTraverseTablesPredicate + answerBlockQueryTraverse = answerShelleyTraversingQueries id coerce shelleyQFTraverseTablesPredicate -- \| Is the given query supported by the given 'ShelleyNodeToClientVersion'? blockQueryIsSupportedOnVersion = \case @@ -1242,7 +1243,7 @@ answerShelleyLookupQueries injTables ejTxOut ejTxIn cfg q forker = LedgerTables (ValuesMK values) <- LedgerDB.roforkerReadTables forker - (castLedgerTables $ injTables (LedgerTables $ KeysMK txins)) + (castLedgerTables $ injTables (LedgerTables $ KeysMK $ coerceTxInSet txins)) pure $ SL.UTxO $ Map.mapKeys ejTxIn $ diff --git a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs index 528cafef8f..f03c7320ea 100644 --- a/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs +++ b/ouroboros-consensus-cardano/src/shelley/Ouroboros/Consensus/Shelley/ShelleyHFC.hs @@ -425,7 +425,7 @@ instance HasCanonicalTxIn '[ShelleyBlock proto era] where newtype CanonicalTxIn '[ShelleyBlock proto era] = ShelleyBlockHFCTxIn - { getShelleyBlockHFCTxIn :: SL.TxIn + { getShelleyBlockHFCTxIn :: BigEndianTxIn } deriving stock (Show, Eq, Ord) deriving newtype (NoThunks, MemPack) @@ -462,14 +462,14 @@ instance BlockSupportsHFLedgerQuery '[ShelleyBlock proto era] where answerBlockQueryHFLookup = \case - IZ -> answerShelleyLookupQueries (injectLedgerTables IZ) id (ejectCanonicalTxIn IZ) + IZ -> answerShelleyLookupQueries (injectLedgerTables IZ) id (coerce . ejectCanonicalTxIn IZ) IS idx -> case idx of {} answerBlockQueryHFTraverse = \case IZ -> answerShelleyTraversingQueries id - (ejectCanonicalTxIn IZ) + (coerce . ejectCanonicalTxIn IZ) (queryLedgerGetTraversingFilter @('[ShelleyBlock proto era]) IZ) IS idx -> case idx of {} diff --git a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs index d150d034fc..1270f456b5 100644 --- a/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs +++ b/ouroboros-consensus-cardano/src/unstable-cardano-testlib/Test/ThreadNet/Infra/ShelleyBasedHardFork.hs @@ -357,7 +357,7 @@ instance answerShelleyLookupQueries (injectLedgerTables idx) (ejectHardForkTxOutDefault idx) - (ejectCanonicalTxIn idx) + (coerce . ejectCanonicalTxIn idx) ) answerBlockQueryHFTraverse = @@ -365,7 +365,7 @@ instance ( \idx -> answerShelleyTraversingQueries (ejectHardForkTxOutDefault idx) - (ejectCanonicalTxIn idx) + (coerce . ejectCanonicalTxIn idx) (queryLedgerGetTraversingFilter @('[ShelleyBlock proto1 era1, ShelleyBlock proto2 era2]) idx) ) @@ -494,7 +494,7 @@ instance where newtype CanonicalTxIn (ShelleyBasedHardForkEras proto1 era1 proto2 era2) = ShelleyHFCTxIn - { getShelleyHFCTxIn :: SL.TxIn + { getShelleyHFCTxIn :: BigEndianTxIn } deriving stock (Show, Eq, Ord) deriving newtype (NoThunks, MemPack) diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs index 667ab64652..7d7bba34f5 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Examples.hs @@ -102,7 +102,7 @@ mkLedgerTables tx = Map.fromList $ zip exampleTxIns exampleTxOuts where - exampleTxIns :: [SL.TxIn] + exampleTxIns :: [BigEndianTxIn] exampleTxIns = case toList (tx ^. (LC.bodyTxL . LC.allInputsTxBodyF)) of [] -> error "No transaction inputs were provided to construct the ledger tables" -- We require at least one transaction input (and one @@ -112,7 +112,7 @@ mkLedgerTables tx = -- -- Also all transactions in Cardano have at least one input for -- automatic replay protection. - xs -> xs + xs -> map BigEndianTxIn xs exampleTxOuts :: [LC.TxOut era] exampleTxOuts = case toList (tx ^. (LC.bodyTxL . LC.outputsTxBodyL)) of diff --git a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs index 414a57bf72..3de6553e3b 100644 --- a/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs +++ b/ouroboros-consensus-cardano/src/unstable-shelley-testlib/Test/Consensus/Shelley/Generators.hs @@ -1,9 +1,12 @@ {-# LANGUAGE DataKinds #-} +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} @@ -239,6 +242,8 @@ instance <*> arbitrary <*> (LedgerTables . ValuesMK <$> arbitrary) +deriving newtype instance Arbitrary BigEndianTxIn + instance CanMock proto era => Arbitrary (AnnTip (ShelleyBlock proto era)) where arbitrary = AnnTip diff --git a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Translation.hs b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Translation.hs index e06ce63436..76347ac52a 100644 --- a/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Translation.hs +++ b/ouroboros-consensus-cardano/test/cardano-test/Test/Consensus/Cardano/Translation.hs @@ -27,7 +27,6 @@ import Cardano.Ledger.Shelley.API , translateCompactTxOutByronToShelley , translateTxIdByronToShelley ) -import qualified Cardano.Ledger.Shelley.API as SL import Cardano.Ledger.Shelley.LedgerState ( esLState , lsUTxOState @@ -67,8 +66,10 @@ import Ouroboros.Consensus.Protocol.TPraos (TPraos) import Ouroboros.Consensus.Shelley.Eras import Ouroboros.Consensus.Shelley.HFEras () import Ouroboros.Consensus.Shelley.Ledger - ( ShelleyBlock + ( BigEndianTxIn (..) + , ShelleyBlock , ShelleyLedgerConfig + , coerceTxInMapKeys , mkShelleyLedgerConfig , shelleyLedgerState , shelleyLedgerTables @@ -272,7 +273,7 @@ byronUtxosAreInsertsInShelleyUtxoDiff srcLedgerState destLedgerState = where toNextUtxoDiff :: LedgerState ByronBlock mk -> - Diff.Diff SL.TxIn (Core.TxOut ShelleyEra) + Diff.Diff BigEndianTxIn (Core.TxOut ShelleyEra) toNextUtxoDiff ledgerState = let Byron.UTxO utxo = Byron.cvsUtxo $ byronLedgerState ledgerState @@ -281,13 +282,13 @@ byronUtxosAreInsertsInShelleyUtxoDiff srcLedgerState destLedgerState = in Diff.Diff $ Map.map valFn $ Map.mapKeys keyFn utxo - translateTxInByronToShelley :: Byron.TxIn -> TxIn + translateTxInByronToShelley :: Byron.TxIn -> BigEndianTxIn translateTxInByronToShelley byronTxIn = let Byron.TxInUtxo txId txIx = byronTxIn shelleyTxId' = translateTxIdByronToShelley txId in - TxIn shelleyTxId' (TxIx txIx) + BigEndianTxIn $ TxIn shelleyTxId' (TxIx txIx) shelleyAvvmAddressesAreDeletesInUtxoDiff :: LedgerState (ShelleyBlock Proto ShelleyEra) EmptyMK -> @@ -298,9 +299,9 @@ shelleyAvvmAddressesAreDeletesInUtxoDiff srcLedgerState destLedgerState = where toNextUtxoDiff :: LedgerState (ShelleyBlock Proto ShelleyEra) EmptyMK -> - Diff.Diff SL.TxIn (Core.TxOut AllegraEra) + Diff.Diff BigEndianTxIn (Core.TxOut AllegraEra) toNextUtxoDiff = avvmAddressesToUtxoDiff . stashedAVVMAddresses . shelleyLedgerState - avvmAddressesToUtxoDiff (UTxO m) = Diff.Diff $ Map.map (\_ -> Diff.Delete) m + avvmAddressesToUtxoDiff (UTxO m) = Diff.Diff $ coerceTxInMapKeys $ Map.map (\_ -> Diff.Delete) m utxoTablesAreEmpty :: LedgerState (ShelleyBlock srcProto srcEra) EmptyMK -> @@ -329,7 +330,7 @@ nonEmptyAvvmAddresses ledgerState = extractUtxoDiff :: LedgerState (ShelleyBlock proto era) DiffMK -> - Diff SL.TxIn (Core.TxOut era) + Diff BigEndianTxIn (Core.TxOut era) extractUtxoDiff shelleyLedgerState = let DiffMK tables = getLedgerTables $ shelleyLedgerTables shelleyLedgerState in tables diff --git a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/LedgerTables.hs b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/LedgerTables.hs index 720d134382..a579386da5 100644 --- a/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/LedgerTables.hs +++ b/ouroboros-consensus-cardano/test/shelley-test/Test/Consensus/Shelley/LedgerTables.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} @@ -11,6 +14,9 @@ module Test.Consensus.Shelley.LedgerTables (tests) where import qualified Cardano.Ledger.Api.Era as L +import qualified Cardano.Ledger.BaseTypes as L +import qualified Cardano.Ledger.Shelley.API.Types as L +import Data.MemPack import Data.Proxy import Data.SOP.BasicFunctors import Data.SOP.Constraint @@ -29,12 +35,15 @@ import Test.Cardano.Ledger.Dijkstra.Arbitrary () import Test.Consensus.Shelley.Generators () import Test.Consensus.Shelley.MockCrypto (CanMock) import Test.LedgerTables +import Test.QuickCheck import Test.Tasty import Test.Tasty.QuickCheck tests :: TestTree tests = testGroup "LedgerTables" + . (testProperty "Serializing BigEndianTxIn preserves order" testBigEndianTxInPreservesOrder :) + . (testProperty "Serializing TxIn fails to preserve order" (expectFailure testTxInPreservesOrder) :) . hcollapse . hcmap (Proxy @TestLedgerTables) (K . f) $ (hpure Proxy :: NP Proxy (CardanoShelleyEras StandardCrypto)) @@ -74,3 +83,15 @@ instance Arbitrary (LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK) where arbitrary = projectLedgerTables . unstowLedgerTables <$> arbitrary + +testBigEndianTxInPreservesOrder :: L.TxId -> L.TxIx -> L.TxIx -> Property +testBigEndianTxInPreservesOrder txid txix1 txix2 = + let b1 = packByteString (BigEndianTxIn $ L.TxIn txid txix1) + b2 = packByteString (BigEndianTxIn $ L.TxIn txid txix2) + in counterexample (show b1 <> " " <> show b2) $ compare b1 b2 === compare txix1 txix2 + +testTxInPreservesOrder :: L.TxId -> L.TxIx -> L.TxIx -> Property +testTxInPreservesOrder txid txix1 txix2 = + let b1 = packByteString (L.TxIn txid txix1) + b2 = packByteString (L.TxIn txid txix2) + in counterexample (show b1 <> " " <> show b2) $ compare b1 b2 === compare txix1 txix2 diff --git a/ouroboros-consensus/changelog.d/20250904_155944_javier.sagredo_version_tables.md b/ouroboros-consensus/changelog.d/20250904_155944_javier.sagredo_version_tables.md new file mode 100644 index 0000000000..e47aa77efb --- /dev/null +++ b/ouroboros-consensus/changelog.d/20250904_155944_javier.sagredo_version_tables.md @@ -0,0 +1,24 @@ + + + + + +### Breaking + +- Version the ledger tables in snapshots. For now only the `TablesCodecVersion1` exists. Snapshots without a version will be regarded as invalid, thus triggering a replay of the chain. +- Change the InMemory snapshot format. The tables will be stored in `/tables` instead of `/tables/tvar`. diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs index 4a859b3746..60525b58d5 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/Snapshots.hs @@ -28,6 +28,7 @@ module Ouroboros.Consensus.Storage.LedgerDB.Snapshots , SnapshotFailure (..) , SnapshotMetadata (..) , SnapshotPolicyArgs (..) + , TablesCodecVersion (..) , defaultSnapshotPolicyArgs -- * Codec @@ -82,6 +83,7 @@ import Control.Monad.Except import Control.Tracer import Data.Aeson (FromJSON (..), ToJSON (..), (.:), (.=)) import qualified Data.Aeson as Aeson +import Data.Aeson.Types (Parser) import Data.Functor.Identity import qualified Data.List as List import Data.Maybe (isJust, mapMaybe) @@ -162,9 +164,24 @@ data ReadSnapshotErr ReadMetadataError FsPath MetadataErr deriving (Eq, Show) +data TablesCodecVersion = TablesCodecVersion1 + deriving (Eq, Show) + +instance ToJSON TablesCodecVersion where + toJSON TablesCodecVersion1 = Aeson.Number 1 + +instance FromJSON TablesCodecVersion where + parseJSON v = enforceVersion =<< parseJSON v + +enforceVersion :: Word8 -> Parser TablesCodecVersion +enforceVersion v = case v of + 1 -> pure TablesCodecVersion1 + _ -> fail "Unknown or outdated tables codec version" + data SnapshotMetadata = SnapshotMetadata { snapshotBackend :: SnapshotBackend , snapshotChecksum :: CRC + , snapshotTablesCodecVersion :: TablesCodecVersion } deriving (Eq, Show) @@ -173,6 +190,7 @@ instance ToJSON SnapshotMetadata where Aeson.object [ "backend" .= snapshotBackend sm , "checksum" .= getCRC (snapshotChecksum sm) + , "tablesCodecVersion" .= toJSON (snapshotTablesCodecVersion sm) ] instance FromJSON SnapshotMetadata where @@ -180,6 +198,7 @@ instance FromJSON SnapshotMetadata where SnapshotMetadata <$> o .: "backend" <*> fmap CRC (o .: "checksum") + <*> (parseJSON =<< (o .: "tablesCodecVersion")) data SnapshotBackend = UTxOHDMemSnapshot diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs index 745503fc82..27e82ec72f 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V1/Snapshots.hs @@ -260,6 +260,7 @@ writeSnapshot fs@(SomeHasFS hasFS) backingStore encLedger snapshot cs = do SnapshotMetadata { snapshotBackend = bsSnapshotBackend backingStore , snapshotChecksum = crc + , snapshotTablesCodecVersion = TablesCodecVersion1 } bsCopy backingStore diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs index a7000e4bb0..e28dc7f58d 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/InMemory.hs @@ -137,11 +137,10 @@ newInMemoryLedgerTablesHandle tracer someFS@(SomeHasFS hasFS) l = do ) ) , takeHandleSnapshot = \hint snapshotName -> do - createDirectoryIfMissing hasFS True $ mkFsPath [snapshotName, "tables"] h <- readTVarIO tv guardClosed h $ \values -> - withFile hasFS (mkFsPath [snapshotName, "tables", "tvar"]) (WriteMode MustBeNew) $ \hf -> + withFile hasFS (mkFsPath [snapshotName, "tables"]) (WriteMode MustBeNew) $ \hf -> fmap (Just . snd) $ hPutAllCRC hasFS hf $ CBOR.toLazyByteString $ @@ -204,6 +203,7 @@ writeSnapshot fs@(SomeHasFS hasFs) encLedger ds st = do SnapshotMetadata { snapshotBackend = UTxOHDMemSnapshot , snapshotChecksum = maybe crc1 (crcOfConcat crc1) crc2 + , snapshotTablesCodecVersion = TablesCodecVersion1 } implTakeSnapshot :: @@ -271,7 +271,7 @@ loadSnapshot tracer _rr ccfg fs ds = do (valuesMKDecoder extLedgerSt) ( fsPathFromList $ fsPathToList (snapshotToDirPath ds) - <> [fromString "tables", fromString "tvar"] + <> [fromString "tables"] ) let computedCRC = crcOfConcat checksumAsRead crcTables Monad.when (computedCRC /= snapshotChecksum snapshotMeta) $ diff --git a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs index 5112ef8f9f..952a1779bc 100644 --- a/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs +++ b/ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/Storage/LedgerDB/V2/LSM.hs @@ -417,6 +417,7 @@ writeSnapshot fs@(SomeHasFS hasFs) encLedger ds st = do SnapshotMetadata { snapshotBackend = UTxOHDLSMSnapshot , snapshotChecksum = maybe crc1 (crcOfConcat crc1) crc2 + , snapshotTablesCodecVersion = TablesCodecVersion1 } -- | Delete snapshot from disk and also from the LSM tree database. diff --git a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/Snapshots.hs b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/Snapshots.hs index e69c3b75ec..c65ba8435b 100644 --- a/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/Snapshots.hs +++ b/ouroboros-consensus/test/storage-test/Test/Ouroboros/Storage/LedgerDB/Snapshots.hs @@ -35,3 +35,4 @@ instance Arbitrary SnapshotMetadata where SnapshotMetadata <$> arbitrary <*> fmap CRC arbitrary + <*> pure TablesCodecVersion1