From a375b34dab1989143714e1d769c755203efb1e2f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Emil=20Holm=20Gj=C3=B8rup?= Date: Mon, 18 Dec 2023 14:29:51 +0100 Subject: [PATCH] Address review comments --- .../KonsensusV1/Consensus/Blocks.hs | 145 ++++++------------ .../KonsensusV1/TreeState/LowLevel.hs | 5 +- .../Concordium/KonsensusV1/TreeState/Types.hs | 14 +- .../src/Concordium/KonsensusV1/Types.hs | 130 ++++++++++------ .../EndToEnd/CredentialDeploymentTests.hs | 63 ++++---- .../TransactionTableIntegrationTest.hs | 36 ++--- .../ConcordiumTests/KonsensusV1/CatchUp.hs | 18 +-- .../ConcordiumTests/KonsensusV1/Common.hs | 9 +- .../KonsensusV1/Consensus/Blocks.hs | 136 +++++++--------- .../ConcordiumTests/KonsensusV1/LMDB.hs | 9 +- .../KonsensusV1/TransactionProcessingTest.hs | 9 +- .../KonsensusV1/TreeStateTest.hs | 16 +- .../ConcordiumTests/KonsensusV1/Types.hs | 16 +- 13 files changed, 277 insertions(+), 329 deletions(-) diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Blocks.hs b/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Blocks.hs index b032c3aa46..cbde97f72e 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Blocks.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Blocks.hs @@ -16,21 +16,20 @@ import Control.Monad.State import Control.Monad.Trans.Maybe import Data.Function import Data.Ord -import qualified Data.Serialize as Serialize import Data.Time import qualified Data.Vector as Vector import Lens.Micro.Platform -import qualified Concordium.Crypto.SHA256 as Hash import Concordium.Logger import Concordium.TimeMonad import Concordium.Types import Concordium.Types.Accounts +import Concordium.Types.BakerIdentity +import Concordium.Types.Block (localToAbsoluteBlockHeight) import Concordium.Types.HashableTo +import Concordium.Types.Option import Concordium.Types.Parameters hiding (getChainParameters) -import qualified Concordium.Types.ProtocolVersion as BasePV import Concordium.Types.SeedState -import qualified Concordium.Types.Transactions as Types import Concordium.Utils import Concordium.Genesis.Data.BaseV1 @@ -56,10 +55,6 @@ import Concordium.KonsensusV1.TreeState.Types import Concordium.KonsensusV1.Types import Concordium.Scheduler (FilteredTransactions (..)) import Concordium.TimerMonad -import Concordium.Types.BakerIdentity -import Concordium.Types.Block (AbsoluteBlockHeight, localToAbsoluteBlockHeight) -import Concordium.Types.Option -import Concordium.Types.Transactions (TransactionOutcomesHash) -- | A block that has passed initial verification, but must still be executed, added to the state, -- and (potentially) signed as a finalizer. @@ -762,49 +757,49 @@ processBlock parent VerifiedBlock{vbBlock = pendingBlock, ..} rejectBlock Right (newState, energyUsed) -> case blockDerivableHashes pendingBlock of - DBHashesV0 pendingBlockDerivableHashes -> do - -- Prior to PV7 the transaction outcome was tracked separate from - -- the state hash, meaning both have to be checked here. - outcomesHash <- getTransactionOutcomesHash newState - let pendingBlockTxOutcomesHash = bdhv0TransactionOutcomesHash pendingBlockDerivableHashes - let pendingBlockStateHash = bdhv0BlockStateHash pendingBlockDerivableHashes - if - | outcomesHash /= pendingBlockTxOutcomesHash -> do - -- Incorrect transaction outcomes - logEvent Konsensus LLTrace $ - "Block " - <> show pbHash - <> " stated transaction outcome hash (" - <> show pendingBlockTxOutcomesHash - <> ") does not match computed value (" - <> show outcomesHash - <> ")." - flag $ BlockInvalidTransactionOutcomesHash sBlock (bpBlock parent) - rejectBlock - | getHash newState /= pendingBlockStateHash -> do - -- Incorrect state hash - logEvent Konsensus LLTrace $ - "Block " - <> show pbHash - <> " stated state hash (" - <> show pendingBlockStateHash - <> ") does not match computed value (" - <> show (getHash newState :: StateHash) - <> ")." - flag $ BlockInvalidStateHash sBlock (bpBlock parent) - rejectBlock - | otherwise -> - continue newState energyUsed - DBHashesV1 pendingBlockDerivableHashes -> do + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = pendingBlockTxOutcomesHash, + dbhv0BlockStateHash = pendingBlockStateHash + } -> do + -- Prior to PV7 the transaction outcome was tracked separate from + -- the state hash, meaning both have to be checked here. + outcomesHash <- getTransactionOutcomesHash newState + if + | outcomesHash /= pendingBlockTxOutcomesHash -> do + -- Incorrect transaction outcomes + logEvent Konsensus LLTrace $ + "Block " + <> show pbHash + <> " stated transaction outcome hash (" + <> show pendingBlockTxOutcomesHash + <> ") does not match computed value (" + <> show outcomesHash + <> ")." + flag $ BlockInvalidTransactionOutcomesHash sBlock (bpBlock parent) + rejectBlock + | getHash newState /= pendingBlockStateHash -> do + -- Incorrect state hash + logEvent Konsensus LLTrace $ + "Block " + <> show pbHash + <> " stated state hash (" + <> show pendingBlockStateHash + <> ") does not match computed value (" + <> show (getHash newState :: StateHash) + <> ")." + flag $ BlockInvalidStateHash sBlock (bpBlock parent) + rejectBlock + | otherwise -> + continue newState energyUsed + DerivableBlockHashesV1{dbhv1BlockResultHash = pendingBlockResultHash} -> do -- Starting from P7 the baked block only contains a block result hash -- which is computed from transaction outcomes, the block state hash -- and more. - let pendingBlockResultHash = bdhv1BlockResultHash pendingBlockDerivableHashes let relativeBlockHeight = 1 + blockHeight parent computedResultHash <- computeBlockResultHash newState relativeBlockHeight if computedResultHash /= pendingBlockResultHash then do - -- Incorrect state hash + -- Incorrect block result hash logEvent Konsensus LLTrace $ "Block " <> show pbHash @@ -1225,15 +1220,15 @@ bakeBlock BakeBlockInputs{..} = do updateFocusBlockTo bbiParent ptt <- use pendingTransactionTable (filteredTransactions, newState, energyUsed) <- constructBlockState runtime tt ptt executionData - bbDerivableHashes <- case BasePV.blockHashVersion @(BasePV.BlockHashVersionFor (MPV m)) of - BasePV.SBlockHashVersion0 -> do - bdhv0TransactionOutcomesHash <- getTransactionOutcomesHash newState - bdhv0BlockStateHash <- getStateHash newState - return $ DBHashesV0 BlockDerivableHashesV0{..} - BasePV.SBlockHashVersion1 -> do + bbDerivableHashes <- case blockHashVersion @(BlockHashVersionFor (MPV m)) of + SBlockHashVersion0 -> do + dbhv0TransactionOutcomesHash <- getTransactionOutcomesHash newState + dbhv0BlockStateHash <- getStateHash newState + return $ DerivableBlockHashesV0{..} + SBlockHashVersion1 -> do let relativeBlockHeight = 1 + blockHeight bbiParent - bdhv1BlockResultHash <- computeBlockResultHash newState relativeBlockHeight - return $ DBHashesV1 BlockDerivableHashesV1{..} + dbhv1BlockResultHash <- computeBlockResultHash newState relativeBlockHeight + return $ DerivableBlockHashesV1{..} let bakedBlock = BakedBlock { bbRound = bbiRound, @@ -1272,52 +1267,6 @@ bakeBlock BakeBlockInputs{..} = do pendingTransactionTable .=! newPTT return signedBlock --- | Information needed for computing the result hash for a block. -data BlockResultHashInput = BlockResultHashInput - { -- | Hash of the block state. - shiBlockStateHash :: StateHash, - -- | Hash of the transaction outcomes. - shiTransationOutcomesHash :: TransactionOutcomesHash, - -- | The finalization committee hash for the current epoch. - shiCurrentFinalizationCommitteeHash :: FinalizationCommitteeHash, - -- | The finalization committee hash for the next epoch. - shiNextFinalizationCommitteeHash :: FinalizationCommitteeHash, - -- | The block height information of this block. - shiBlockHeightInfo :: BlockHeightInfo - } - --- | The block height information of a block. -data BlockHeightInfo = BlockHeightInfo - { -- | The absolute height of the block. - bhiAbsoluteBlockHeight :: AbsoluteBlockHeight, - -- | The genesis index of the block. - bhiGenesisIndex :: !GenesisIndex, - -- | The relative block height from the genesis prior to this block. - bhiRelativeBlockHeight :: !BlockHeight - } - --- | Compute the block result hash given the result hash input. -makeBlockResultHash :: BlockResultHashInput -> BlockResultHash -makeBlockResultHash BlockResultHashInput{..} = - BlockResultHash $ - Hash.hashOfHashes - ( Hash.hashOfHashes - (v0StateHash shiBlockStateHash) - (Types.tohGet shiTransationOutcomesHash) - ) - ( Hash.hashOfHashes - (blockHeightInfoHash shiBlockHeightInfo) - ( Hash.hashOfHashes - (theFinalizationCommitteeHash shiCurrentFinalizationCommitteeHash) - (theFinalizationCommitteeHash shiNextFinalizationCommitteeHash) - ) - ) - where - blockHeightInfoHash BlockHeightInfo{..} = Hash.hash $ Serialize.runPut $ do - Serialize.put bhiAbsoluteBlockHeight - Serialize.put bhiGenesisIndex - Serialize.put bhiRelativeBlockHeight - -- | Extract information from SkovData and the block state to compute the result block hash. computeBlockResultHash :: forall m. diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel.hs index cb9b087d81..ac2c6cb514 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel.hs @@ -31,6 +31,8 @@ data StoredBlock (pv :: ProtocolVersion) = StoredBlock stbStatePointer :: !(BlockStateRef pv) } +type instance BlockProtocolVersion (StoredBlock pv) = pv + -- | Get the block state hash for a stored block. stbBlockStateHash :: StoredBlock pv -> StateHash stbBlockStateHash storedBlock = @@ -42,7 +44,7 @@ stbBlockStateHash storedBlock = GenesisBlock meta -> gmStateHash meta NormalBlock signedBlock -> case blockDerivableHashes signedBlock of - DBHashesV0 hashes -> bdhv0BlockStateHash hashes + DerivableBlockHashesV0{..} -> dbhv0BlockStateHash instance (IsProtocolVersion pv) => Serialize (StoredBlock pv) where put StoredBlock{..} = do @@ -77,7 +79,6 @@ instance HashableTo BlockHash (StoredBlock pv) where getHash = getHash . stbBlock instance HasBlockMetadata (StoredBlock pv) where - type BlockMetadataProtocolVersion (StoredBlock pv) = pv blockMetadata = stbInfo -- | 'MonadTreeStateStore' defines the interface to the low-level tree state database. diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs index a8850ff280..78826c7323 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs @@ -73,6 +73,8 @@ data BlockMetadata pv = BlockMetadata } deriving (Eq, Show) +type instance BlockProtocolVersion (BlockMetadata pv) = pv + instance forall pv. (IsProtocolVersion pv) => Serialize (BlockMetadata pv) where put BlockMetadata{..} = do put bmHeight @@ -99,11 +101,8 @@ instance forall pv. (IsProtocolVersion pv) => Serialize (BlockMetadata pv) where -- | A class for structures that include 'BlockMetadata'. class HasBlockMetadata bm where - -- | The protocol version of the metadata. - type BlockMetadataProtocolVersion bm :: ProtocolVersion - -- | Get the block metadata. - blockMetadata :: bm -> BlockMetadata (BlockMetadataProtocolVersion bm) + blockMetadata :: bm -> BlockMetadata (BlockProtocolVersion bm) -- | The height of the block. blockHeight :: bm -> BlockHeight @@ -131,7 +130,6 @@ class HasBlockMetadata bm where {-# INLINE blockTransactionsSize #-} instance HasBlockMetadata (BlockMetadata pv) where - type BlockMetadataProtocolVersion (BlockMetadata pv) = pv blockMetadata = id -- | A pointer to a block that has been executed @@ -145,6 +143,8 @@ data BlockPointer (pv :: ProtocolVersion) = BlockPointer bpState :: !(PBS.HashedPersistentBlockState pv) } +type instance BlockProtocolVersion (BlockPointer pv) = pv + instance HashableTo BlockHash (BlockPointer pv) where getHash BlockPointer{..} = getHash bpBlock @@ -172,7 +172,6 @@ instance Show (BlockPointer pv) where ++ "] }" instance HasBlockMetadata (BlockPointer pv) where - type BlockMetadataProtocolVersion (BlockPointer pv) = pv blockMetadata = bpInfo -- | A block that is pending its parent. @@ -184,6 +183,8 @@ data PendingBlock (pv :: ProtocolVersion) = PendingBlock } deriving (Eq, Show) +type instance BlockProtocolVersion (PendingBlock pv) = pv + instance HashableTo BlockHash (PendingBlock pv) where getHash PendingBlock{..} = getHash pbBlock @@ -197,7 +198,6 @@ instance BlockData (PendingBlock pv) where blockTransactionCount = blockTransactionCount . pbBlock instance BakedBlockData (PendingBlock pv) where - type BakedBlockProtocolVersion (PendingBlock pv) = pv blockQuorumCertificate = blockQuorumCertificate . pbBlock blockParent = blockParent . pbBlock blockBaker = blockBaker . pbBlock diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Types.hs b/concordium-consensus/src/Concordium/KonsensusV1/Types.hs index 49e8c74e92..ff71600581 100644 --- a/concordium-consensus/src/Concordium/KonsensusV1/Types.hs +++ b/concordium-consensus/src/Concordium/KonsensusV1/Types.hs @@ -35,7 +35,6 @@ import Concordium.Types.Block (AbsoluteBlockHeight) import Concordium.Types.HashableTo import Concordium.Types.Option import Concordium.Types.Parameters (IsConsensusV1) -import qualified Concordium.Types.ProtocolVersion as BasePV import Concordium.Types.Transactions import Concordium.Utils.BinarySearch import Concordium.Utils.Serialization @@ -820,11 +819,11 @@ instance Serialize FinalizationMessage where 1 -> FMTimeoutMessage <$> get _ -> fail "Invalid finalization message type." +-- | Type family providing a mapping of the protocol version for types which are parametized by this. +type family BlockProtocolVersion block :: ProtocolVersion + -- | Projections for the data associated with a baked (i.e. non-genesis) block. class BakedBlockData d where - -- | The protocol version associated with the block. - type BakedBlockProtocolVersion d :: ProtocolVersion - -- | Quorum certificate on the parent block. blockQuorumCertificate :: d -> QuorumCertificate @@ -849,7 +848,7 @@ class BakedBlockData d where blockSignature :: d -> BlockSignature -- | The hashes derived from the state and content of the block. - blockDerivableHashes :: d -> DerivableBlockHashes (BakedBlockProtocolVersion d) + blockDerivableHashes :: d -> DerivableBlockHashes (BlockProtocolVersion d) -- | Projections for the data associated with a block (including a genesis block). class BlockData b where @@ -902,35 +901,27 @@ data BakedBlock (pv :: ProtocolVersion) = BakedBlock } deriving (Eq, Show) --- | Hashes in a block which can be derived from the current state and content of the block. --- This version is used prior to P7. -data BlockDerivableHashesV0 = BlockDerivableHashesV0 - { -- | Hash of the transaction outcomes. - bdhv0TransactionOutcomesHash :: !TransactionOutcomesHash, - -- | Hash of the block state. - bdhv0BlockStateHash :: !StateHash - } - deriving (Eq, Show) - --- | Hashes in a block which can be derived from the current state and content of the block. --- This version is in P7 and onwards. -newtype BlockDerivableHashesV1 = BlockDerivableHashesV1 - { -- | Hash of the block results, includes block state and transaction outcomes. - bdhv1BlockResultHash :: BlockResultHash - } - deriving newtype (Eq, Show) - -- | Hashes in a block which can be derived from the current state and content of the block. -- This type depends on the protocol version. -type DerivableBlockHashes (pv :: ProtocolVersion) = DerivableBlockHashesBHV (BasePV.BlockHashVersionFor pv) +type DerivableBlockHashes (pv :: ProtocolVersion) = DerivableBlockHashesBHV (BlockHashVersionFor pv) -- | Hashes in a block which can be derived from the current state and content of the block. -- This type depends on the block hash version. -data DerivableBlockHashesBHV (bhv :: BasePV.BlockHashVersion) where +data DerivableBlockHashesBHV (bhv :: BlockHashVersion) where -- | For block hashing version 0 (Prior to P7). - DBHashesV0 :: !BlockDerivableHashesV0 -> DerivableBlockHashesBHV 'BasePV.BlockHashVersion0 + DerivableBlockHashesV0 :: + { -- | Hash of the transaction outcomes. + dbhv0TransactionOutcomesHash :: !TransactionOutcomesHash, + -- | Hash of the block state. + dbhv0BlockStateHash :: !StateHash + } -> + DerivableBlockHashesBHV 'BlockHashVersion0 -- | For block hashing version 1 (P7 and onwards). - DBHashesV1 :: !BlockDerivableHashesV1 -> DerivableBlockHashesBHV 'BasePV.BlockHashVersion1 + DerivableBlockHashesV1 :: + { -- | Hash of the block results, includes block state and transaction outcomes. + dbhv1BlockResultHash :: !BlockResultHash + } -> + DerivableBlockHashesBHV 'BlockHashVersion1 deriving instance Show (DerivableBlockHashesBHV bhv) deriving instance Eq (DerivableBlockHashesBHV bhv) @@ -938,22 +929,22 @@ deriving instance Eq (DerivableBlockHashesBHV bhv) -- | Serialize derivable hashes. putDerivableBlockHashes :: Putter (DerivableBlockHashesBHV bhv) putDerivableBlockHashes derivableBlockHashes = case derivableBlockHashes of - DBHashesV0 hashes -> do - put $ bdhv0BlockStateHash hashes - put $ bdhv0TransactionOutcomesHash hashes - DBHashesV1 hashes -> do - put $ bdhv1BlockResultHash hashes + DerivableBlockHashesV0{..} -> do + put dbhv0BlockStateHash + put dbhv0TransactionOutcomesHash + DerivableBlockHashesV1{..} -> do + put dbhv1BlockResultHash -- | Deserialize derivable hashes. getDerivableBlockHashes :: SProtocolVersion pv -> Get (DerivableBlockHashes pv) -getDerivableBlockHashes spv = case BasePV.sBlockHashVersionFor spv of - BasePV.SBlockHashVersion0 -> do - bdhv0BlockStateHash <- get - bdhv0TransactionOutcomesHash <- get - return $ DBHashesV0 BlockDerivableHashesV0{..} - BasePV.SBlockHashVersion1 -> do - bdhv1BlockResultHash <- get - return $ DBHashesV1 BlockDerivableHashesV1{..} +getDerivableBlockHashes spv = case sBlockHashVersionFor spv of + SBlockHashVersion0 -> do + dbhv0BlockStateHash <- get + dbhv0TransactionOutcomesHash <- get + return $ DerivableBlockHashesV0{..} + SBlockHashVersion1 -> do + dbhv1BlockResultHash <- get + return $ DerivableBlockHashesV1{..} -- | Flags indicating which optional values are set in a 'BakedBlock'. data BakedBlockFlags = BakedBlockFlags @@ -1050,8 +1041,9 @@ data SignedBlock (pv :: ProtocolVersion) = SignedBlock } deriving (Eq, Show) +type instance BlockProtocolVersion (SignedBlock pv) = pv + instance BakedBlockData (SignedBlock pv) where - type BakedBlockProtocolVersion (SignedBlock pv) = pv blockQuorumCertificate = bbQuorumCertificate . sbBlock blockBaker = bbBaker . sbBlock blockTimeoutCertificate = bbTimeoutCertificate . sbBlock @@ -1230,17 +1222,17 @@ instance HashableTo BlockQuasiHash (BakedBlock pv) where timeoutHash = getHash bbTimeoutCertificate finalizationHash = getHash bbEpochFinalizationEntry dataHash = case bbDerivableHashes of - DBHashesV0 derivableHashesV0 -> Hash.hashOfHashes transactionsAndOutcomesHash stateHash + DerivableBlockHashesV0{..} -> Hash.hashOfHashes transactionsAndOutcomesHash stateHash where transactionsAndOutcomesHash = Hash.hashOfHashes transactionsHash outcomesHash where transactionsHash = computeTransactionsHash bbTransactions - outcomesHash = tohGet $ bdhv0TransactionOutcomesHash derivableHashesV0 - stateHash = v0StateHash $ bdhv0BlockStateHash derivableHashesV0 - DBHashesV1 derivableHashesV1 -> Hash.hashOfHashes transactionsHash stateHash + outcomesHash = tohGet dbhv0TransactionOutcomesHash + stateHash = v0StateHash dbhv0BlockStateHash + DerivableBlockHashesV1{..} -> Hash.hashOfHashes transactionsHash blockResultHash where transactionsHash = computeTransactionsHash bbTransactions - stateHash = theBlockResultHash $ bdhv1BlockResultHash derivableHashesV1 + blockResultHash = theBlockResultHash dbhv1BlockResultHash -- | Compute the block hash from the header hash and quasi-hash. computeBlockHash :: BlockHeaderHash -> BlockQuasiHash -> BlockHash @@ -1397,3 +1389,49 @@ newtype QuorumCertificateCheckedWitness = QuorumCertificateCheckedWitness Epoch -- | Get the associated 'QuorumCertificateWitness' for a 'QuorumCertificate'. toQuorumCertificateWitness :: QuorumCertificate -> QuorumCertificateCheckedWitness toQuorumCertificateWitness qc = QuorumCertificateCheckedWitness (qcEpoch qc) + +-- | Information needed for computing the result hash for a block. +data BlockResultHashInput = BlockResultHashInput + { -- | Hash of the block state. + shiBlockStateHash :: StateHash, + -- | Hash of the transaction outcomes. + shiTransationOutcomesHash :: TransactionOutcomesHash, + -- | The finalization committee hash for the current epoch. + shiCurrentFinalizationCommitteeHash :: FinalizationCommitteeHash, + -- | The finalization committee hash for the next epoch. + shiNextFinalizationCommitteeHash :: FinalizationCommitteeHash, + -- | The block height information of this block. + shiBlockHeightInfo :: BlockHeightInfo + } + +-- | The block height information of a block. +data BlockHeightInfo = BlockHeightInfo + { -- | The absolute height of the block. + bhiAbsoluteBlockHeight :: AbsoluteBlockHeight, + -- | The genesis index of the block. + bhiGenesisIndex :: !GenesisIndex, + -- | The relative block height from the genesis prior to this block. + bhiRelativeBlockHeight :: !BlockHeight + } + +-- | Compute the block result hash given the result hash input. +makeBlockResultHash :: BlockResultHashInput -> BlockResultHash +makeBlockResultHash BlockResultHashInput{..} = + BlockResultHash $ + Hash.hashOfHashes + ( Hash.hashOfHashes + (v0StateHash shiBlockStateHash) + (tohGet shiTransationOutcomesHash) + ) + ( Hash.hashOfHashes + (blockHeightInfoHash shiBlockHeightInfo) + ( Hash.hashOfHashes + (theFinalizationCommitteeHash shiCurrentFinalizationCommitteeHash) + (theFinalizationCommitteeHash shiNextFinalizationCommitteeHash) + ) + ) + where + blockHeightInfoHash BlockHeightInfo{..} = Hash.hash $ runPut $ do + put bhiAbsoluteBlockHeight + put bhiGenesisIndex + put bhiRelativeBlockHeight diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs index c1b6594123..0c611d9459 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs @@ -89,11 +89,10 @@ testBB1 = bbNonce = computeBlockNonce genesisLEN 1 (bakerVRFKey bakerId), bbTransactions = Vec.fromList [credBi1], bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "b9444648bf759471276fdba1930af0c543847d22de89c27939791898d757516d", - bdhv0BlockStateHash = read "b8bc96ec5f162db36784ea96ec29e3e8ad92abff341a6847e3bf524fdada28ff" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "b9444648bf759471276fdba1930af0c543847d22de89c27939791898d757516d", + dbhv0BlockStateHash = read "b8bc96ec5f162db36784ea96ec29e3e8ad92abff341a6847e3bf524fdada28ff" + } } where bakerId = 2 @@ -113,11 +112,10 @@ testBB2 = bbNonce = computeBlockNonce genesisLEN 2 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "375fef64a251f353d608171d283d00fe00aa0bd77596ba7703c810f48056ef89", - bdhv0BlockStateHash = read "798d5089818bcc7b8873e2585fb4fbf3d4dceffca32531259f466e7c435c8817" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "375fef64a251f353d608171d283d00fe00aa0bd77596ba7703c810f48056ef89", + dbhv0BlockStateHash = read "798d5089818bcc7b8873e2585fb4fbf3d4dceffca32531259f466e7c435c8817" + } } where bakerId = 4 @@ -137,11 +135,10 @@ testBB3 = bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "375fef64a251f353d608171d283d00fe00aa0bd77596ba7703c810f48056ef89", - bdhv0BlockStateHash = read "4da0deab5b564cd77c617a2ac7dc8a6064f87e99b09e58c87b5f9e687db2197a" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "375fef64a251f353d608171d283d00fe00aa0bd77596ba7703c810f48056ef89", + dbhv0BlockStateHash = read "4da0deab5b564cd77c617a2ac7dc8a6064f87e99b09e58c87b5f9e687db2197a" + } } where bakerId = 4 @@ -179,11 +176,10 @@ testBB2' = bbNonce = computeBlockNonce genesisLEN 2 (bakerVRFKey bakerId), bbTransactions = Vec.fromList [credBi2], bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "abc4628869bb526115226dd01ad54bf33f54609fa770d50a9242aaf009f42fa1", - bdhv0BlockStateHash = read "e3cf3b280159bc20645738fb1343486d16104989a524fb5feb59ac1b0b7af9ad" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "abc4628869bb526115226dd01ad54bf33f54609fa770d50a9242aaf009f42fa1", + dbhv0BlockStateHash = read "e3cf3b280159bc20645738fb1343486d16104989a524fb5feb59ac1b0b7af9ad" + } } where bakerId = 4 @@ -203,11 +199,10 @@ testBB3' = bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.fromList [credBi3], bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "3af8504795a03353248be256f66366263f7484c814c5a26760210bbdfd609003", - bdhv0BlockStateHash = read "67eb8f778a4a43efa80c73a954110154ae417e21d43c33b857b962af36913e29" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "3af8504795a03353248be256f66366263f7484c814c5a26760210bbdfd609003", + dbhv0BlockStateHash = read "67eb8f778a4a43efa80c73a954110154ae417e21d43c33b857b962af36913e29" + } } where bakerId = 4 @@ -225,11 +220,10 @@ testBB4 = bbNonce = computeBlockNonce genesisLEN 4 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "b0972dd7af05ed6feaa40099fffa9c5c5e0ba9741938166cdb57584780688743", - bdhv0BlockStateHash = read "9e698b9c6425b382d8fda5584f530688c237ad013e8aaf848fea274e50244111" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "b0972dd7af05ed6feaa40099fffa9c5c5e0ba9741938166cdb57584780688743", + dbhv0BlockStateHash = read "9e698b9c6425b382d8fda5584f530688c237ad013e8aaf848fea274e50244111" + } } where bakerId = 3 @@ -247,11 +241,10 @@ testBB5 = bbNonce = computeBlockNonce genesisLEN 5 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "b0972dd7af05ed6feaa40099fffa9c5c5e0ba9741938166cdb57584780688743", - bdhv0BlockStateHash = read "d9dd62c227d1cbc0d42da0d90bfc11d61533d058cc54b0745d6a597039dbe0ec" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "b0972dd7af05ed6feaa40099fffa9c5c5e0ba9741938166cdb57584780688743", + dbhv0BlockStateHash = read "d9dd62c227d1cbc0d42da0d90bfc11d61533d058cc54b0745d6a597039dbe0ec" + } } where bakerId = 3 diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs index e8424be562..2b9671aaad 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs @@ -58,11 +58,10 @@ testBB1 = bbNonce = computeBlockNonce genesisLEN 1 (bakerVRFKey bakerId), bbTransactions = Vec.fromList [transfer1], bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "13907ff30e010398b3438b73a55f6fd02177d653527aafb6b77360a646cb938c", - bdhv0BlockStateHash = read "84d5b24177c60db5fb17f62a5cc93a500afc6565977f080cbd9260a68be66925" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "13907ff30e010398b3438b73a55f6fd02177d653527aafb6b77360a646cb938c", + dbhv0BlockStateHash = read "84d5b24177c60db5fb17f62a5cc93a500afc6565977f080cbd9260a68be66925" + } } where bakerId = 2 @@ -82,11 +81,10 @@ testBB2 = bbNonce = computeBlockNonce genesisLEN 2 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "f840ea702e095175b8c2fceacc2377d5d2d0be867350bc0bdd8c6d56ee14797c", - bdhv0BlockStateHash = read "0b286c7356d7c69717e42b39fc3cabf2fd82dbc4713f2e752084b1b9e2c5bdb8" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "f840ea702e095175b8c2fceacc2377d5d2d0be867350bc0bdd8c6d56ee14797c", + dbhv0BlockStateHash = read "0b286c7356d7c69717e42b39fc3cabf2fd82dbc4713f2e752084b1b9e2c5bdb8" + } } where bakerId = 4 @@ -106,11 +104,10 @@ testBB3 = bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "9bbf1ab9edd3744bc88dfc0a6aa87a89dc51765d9a4b57bc8c7c49b1fb151099", - bdhv0BlockStateHash = read "80d087748edeea46b7d0b8f25c8fb50bb015b498c11eeb03e8efe8b59e7d40f9" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "9bbf1ab9edd3744bc88dfc0a6aa87a89dc51765d9a4b57bc8c7c49b1fb151099", + dbhv0BlockStateHash = read "80d087748edeea46b7d0b8f25c8fb50bb015b498c11eeb03e8efe8b59e7d40f9" + } } where bakerId = 4 @@ -129,11 +126,10 @@ testBB4 = bbNonce = computeBlockNonce genesisLEN 4 (bakerVRFKey bakerId), bbTransactions = Vec.fromList [transfer2], bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "d46c011009b5315c7cd32bb1345bd2e73a3cd6111a7e4d06c33e863f16c8c8bd", - bdhv0BlockStateHash = read "a47ca3a8412ad577df94ae8ebc288f8972a499ce5315033bfc2f2c18ce00bfb8" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "d46c011009b5315c7cd32bb1345bd2e73a3cd6111a7e4d06c33e863f16c8c8bd", + dbhv0BlockStateHash = read "a47ca3a8412ad577df94ae8ebc288f8972a499ce5315033bfc2f2c18ce00bfb8" + } } where bakerId = 3 diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs index a891c40c0d..b44da0656b 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs @@ -369,11 +369,10 @@ catchupWithTwoBranchesResponse = runTest $ do bbNonce = computeBlockNonce genesisLEN 4 (TestBlocks.bakerVRFKey (3 :: Int)), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH 3, - bdhv0BlockStateHash = read "cdf730c1b3fdc6d07f404c6b95a4f3417c19653b1299b92f59fcaffcc9745910" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH 3, + dbhv0BlockStateHash = read "cdf730c1b3fdc6d07f404c6b95a4f3417c19653b1299b92f59fcaffcc9745910" + } } TestBlocks.succeedReceiveBlock b4 -- There is one current timeout message and one current quorum message @@ -478,11 +477,10 @@ testMakeCatchupStatus = runTest $ do bbNonce = computeBlockNonce genesisLEN 4 (TestBlocks.bakerVRFKey (3 :: Int)), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH 3, - bdhv0BlockStateHash = read "cdf730c1b3fdc6d07f404c6b95a4f3417c19653b1299b92f59fcaffcc9745910" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH 3, + dbhv0BlockStateHash = read "cdf730c1b3fdc6d07f404c6b95a4f3417c19653b1299b92f59fcaffcc9745910" + } } TestBlocks.succeedReceiveBlock b4 -- There is one current timeout message and one current quorum message diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs index 6801e64765..fd9850c0fb 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs @@ -52,11 +52,10 @@ someBlockPointer bh r e = bbNonce = dummyBlockNonce, bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyTransactionOutcomesHashV1, - bdhv0BlockStateHash = StateHashV0 $ Hash.hash "empty state hash" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyTransactionOutcomesHashV1, + dbhv0BlockStateHash = StateHashV0 $ Hash.hash "empty state hash" + } } -- | A block pointer with 'myBlockHash' as block hash. diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs index 6439f3781e..d037a829df 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs @@ -226,14 +226,8 @@ emptyBlockTOH bid = transactionOutcomesHash [] [BlockAccrueReward 0 0 0 0 0 0 bi setStateHash :: StateHash -> BakedBlock PV -> BakedBlock PV setStateHash newStateHash block = case bbDerivableHashes block of - DBHashesV0 hashes -> - block - { bbDerivableHashes = - DBHashesV0 $ - hashes - { bdhv0BlockStateHash = newStateHash - } - } + hashes@DerivableBlockHashesV0{} -> + block{bbDerivableHashes = hashes{dbhv0BlockStateHash = newStateHash}} -- | Valid block for round 1. testBB1 :: BakedBlock PV @@ -249,11 +243,10 @@ testBB1 = bbNonce = computeBlockNonce genesisLEN 1 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "dee89435dba1609a84fa62283d2f63ec50f85b9c22f8815daf348df5428ccb65" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "dee89435dba1609a84fa62283d2f63ec50f85b9c22f8815daf348df5428ccb65" + } } where bakerId = 2 @@ -272,11 +265,10 @@ testBB2 = bbNonce = computeBlockNonce genesisLEN 2 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "d36974d10f1331559e396be5f8e31ecedc2042ebf941bc2fad6050e9e082f206" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "d36974d10f1331559e396be5f8e31ecedc2042ebf941bc2fad6050e9e082f206" + } } where bakerId = 4 @@ -295,11 +287,10 @@ testBB3 = bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "50998f735737ce13b35715a173efb7a3ad20cba597ba540985cd562a0b7bed74" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "50998f735737ce13b35715a173efb7a3ad20cba597ba540985cd562a0b7bed74" + } } where bakerId = 4 @@ -339,11 +330,10 @@ testBB4' = bbNonce = computeBlockNonce genesisLEN 4 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "3bb5b307d7abc6fad2464455f604d63512fff93d7fdeb2aa08d5a8f2720340fe" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "3bb5b307d7abc6fad2464455f604d63512fff93d7fdeb2aa08d5a8f2720340fe" + } } where bakerId = 3 @@ -375,11 +365,10 @@ testBB1E = bbNonce = computeBlockNonce genesisLEN 1 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "3ce2fe0d538434fa7677549a4acbdecea606bd47a61fa39735de1dc144c95eab" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "3ce2fe0d538434fa7677549a4acbdecea606bd47a61fa39735de1dc144c95eab" + } } where bakerId = 2 @@ -398,11 +387,10 @@ testBB2E = bbNonce = computeBlockNonce genesisLEN 2 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "df5d25b8ffbad7be62be0ae2ce1a4730018062c3bda6d6caa02ea03545a263fd" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "df5d25b8ffbad7be62be0ae2ce1a4730018062c3bda6d6caa02ea03545a263fd" + } } where bakerId = 4 @@ -423,11 +411,10 @@ testBB3EX = bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "81e1b33e20088562fcb48c619ea16e800d7fba58995fa6487a6209cf448c7d08" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "81e1b33e20088562fcb48c619ea16e800d7fba58995fa6487a6209cf448c7d08" + } } where bakerId = 4 @@ -462,11 +449,10 @@ testBB3E = bbNonce = computeBlockNonce testEpochLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "dc31a663a0bd166507e21cc641759018651c716b3571531672956abf24b0f4bc" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "dc31a663a0bd166507e21cc641759018651c716b3571531672956abf24b0f4bc" + } } where bakerId = 5 @@ -496,11 +482,10 @@ testBB4E = bbNonce = computeBlockNonce testEpochLEN 4 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "daa799010a8b4acb47fa97b876abed73621db292029360734d9c8978b5859e7b" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "daa799010a8b4acb47fa97b876abed73621db292029360734d9c8978b5859e7b" + } } where bakerId = 1 @@ -532,11 +517,10 @@ testBB5E' = bbNonce = computeBlockNonce testEpochLEN rnd (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "ff8cd1198e3926f743e91a97484d75f1109534aaf9655e1c8c9507d4d0ebd8b3" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "ff8cd1198e3926f743e91a97484d75f1109534aaf9655e1c8c9507d4d0ebd8b3" + } } where bakerId = 2 @@ -594,11 +578,10 @@ testBB3Ex = bbNonce = computeBlockNonce testEpochLENx 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "dc31a663a0bd166507e21cc641759018651c716b3571531672956abf24b0f4bc" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "dc31a663a0bd166507e21cc641759018651c716b3571531672956abf24b0f4bc" + } } where bakerId = 2 @@ -617,11 +600,10 @@ testBB3EA = bbNonce = computeBlockNonce genesisLEN 3 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "df5d25b8ffbad7be62be0ae2ce1a4730018062c3bda6d6caa02ea03545a263fd" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "df5d25b8ffbad7be62be0ae2ce1a4730018062c3bda6d6caa02ea03545a263fd" + } } where bakerId = 4 @@ -641,11 +623,10 @@ testBB4EA = bbNonce = computeBlockNonce testEpochLEN 4 (bakerVRFKey bakerId), bbTransactions = Vec.empty, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = emptyBlockTOH bakerId, - bdhv0BlockStateHash = read "41b44dd4db52dae4021a0d71fbec00a423ffc9892cf97bf6e506d722cdaaeb0d" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId, + dbhv0BlockStateHash = read "41b44dd4db52dae4021a0d71fbec00a423ffc9892cf97bf6e506d722cdaaeb0d" + } } where bakerId = 1 @@ -1075,11 +1056,10 @@ testReceiveIncorrectTransactionOutcomesHash = runTestMonad noBaker testTime gene signedPB testBB1 { bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = read "0000000000000000000000000000000000000000000000000000000000000000", - bdhv0BlockStateHash = read "dee89435dba1609a84fa62283d2f63ec50f85b9c22f8815daf348df5428ccb65" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = read "0000000000000000000000000000000000000000000000000000000000000000", + dbhv0BlockStateHash = read "dee89435dba1609a84fa62283d2f63ec50f85b9c22f8815daf348df5428ccb65" + } } testReceiveIncorrectStateHash :: Assertion diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs index 4ce5d24465..ffd64e0e82 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs @@ -100,11 +100,10 @@ dummyBakedBlock n ts = bbNonce = dummyProof, bbTransactions = ts, bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = TransactionOutcomesHash dummyHash, - bdhv0BlockStateHash = StateHashV0 dummyHash - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = TransactionOutcomesHash dummyHash, + dbhv0BlockStateHash = StateHashV0 dummyHash + } } -- | A helper function for creating an account address given a seed. diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs index e751ac18af..5b7647ebc7 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs @@ -476,11 +476,10 @@ testProcessBlockItems = describe "processBlockItems" $ do -- But second transaction is not verifiable (i.e. 'NotOk') because of the chosen set of identity providers, bbTransactions = Vec.fromList txs bbDerivableHashes = - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = TransactionOutcomesHash minBound, - bdhv0BlockStateHash = StateHashV0 $ Hash.hash "DummyStateHash" - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = TransactionOutcomesHash minBound, + dbhv0BlockStateHash = StateHashV0 $ Hash.hash "DummyStateHash" + } in BakedBlock { bbQuorumCertificate = QuorumCertificate diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs index 536c4c8847..cdbe7d4d7c 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs @@ -187,16 +187,14 @@ dummyBakedBlock parentHash bbRound bbTimestamp = BakedBlock{..} bbTransactions = mempty bbDerivableHashes = case sBlockHashVersionFor (protocolVersion @pv) of SBlockHashVersion0 -> - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = TransactionOutcomesHash minBound, - bdhv0BlockStateHash = dummyStateHash - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = TransactionOutcomesHash minBound, + dbhv0BlockStateHash = dummyStateHash + } SBlockHashVersion1 -> - DBHashesV1 $ - BlockDerivableHashesV1 - { bdhv1BlockResultHash = dummyBlockResultHash - } + DerivableBlockHashesV1 + { dbhv1BlockResultHash = dummyBlockResultHash + } -- | Create a 'SignedBlock' by signing the -- 'dummyBakedBlock' with 'dummySignKeys' diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs index 69fb012cef..cb5affabc7 100644 --- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs +++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs @@ -240,18 +240,16 @@ genBakedBlock sProtocolVersion = do SBlockHashVersion0 -> do bbStateHash <- StateHashV0 . Hash.Hash . FBS.pack <$> vector 32 return $ - DBHashesV0 $ - BlockDerivableHashesV0 - { bdhv0TransactionOutcomesHash = Transactions.emptyTransactionOutcomesHashV1, - bdhv0BlockStateHash = bbStateHash - } + DerivableBlockHashesV0 + { dbhv0TransactionOutcomesHash = Transactions.emptyTransactionOutcomesHashV1, + dbhv0BlockStateHash = bbStateHash + } SBlockHashVersion1 -> do blockResultHash <- BlockResultHash . Hash.Hash . FBS.pack <$> vector 32 return $ - DBHashesV1 $ - BlockDerivableHashesV1 - { bdhv1BlockResultHash = blockResultHash - } + DerivableBlockHashesV1 + { dbhv1BlockResultHash = blockResultHash + } return BakedBlock