Include finalization committee and block height in block state hash

concordium-consensus/src/Concordium/GlobalState/BlockState.hs

@@ -567,7 +567,7 @@ class (ContractStateOperations m, AccountOperations m, ModuleQuery m) => BlockSt
     -- | Get the transactionOutcomesHash of a given block.
     getTransactionOutcomesHash :: BlockState m -> m TransactionOutcomesHash
 
-    -- | Get the stateHash of a given block.
+    -- | Get the StateHash of a given block.
     getStateHash :: BlockState m -> m StateHash
 
     -- | Get all transaction outcomes for this block.

concordium-consensus/src/Concordium/KonsensusV1/Consensus.hs

@@ -49,7 +49,7 @@ class MonadBroadcast m where
     sendQuorumMessage :: QuorumMessage -> m ()
 
     -- | Broadcast a 'SignedBlock'.
-    sendBlock :: SignedBlock -> m ()
+    sendBlock :: SignedBlock (MPV m) -> m ()
 
 -- | This class provides event handlers for consensus events. A runner should implement this to
 --  handle these events.

concordium-consensus/src/Concordium/KonsensusV1/Consensus/CatchUp.hs

@@ -76,7 +76,7 @@ data CatchUpPartialResponse m
     = -- | The next block in the stream.
       CatchUpPartialResponseBlock
         { -- | Next block.
-          cuprNextBlock :: SignedBlock,
+          cuprNextBlock :: SignedBlock (MPV m),
           -- | Continuation for getting any further blocks.
           cuprContinue :: m (CatchUpPartialResponse m),
           -- | Continuation that gets the terminal data in the case where there are no further

concordium-consensus/src/Concordium/KonsensusV1/Flag.hs

@@ -18,58 +18,58 @@ data FlaggableOffense (pv :: ProtocolVersion)
       DuplicateBlock !BlockSignatureWitness !BlockSignatureWitness
     | -- | The 'Round' of the 'QuorumCertificate' is not consistent with the
       --  'Round' of the parent block. Witnessed by the block received.
-      BlockQCRoundInconsistent !SignedBlock
+      BlockQCRoundInconsistent !(SignedBlock pv)
     | -- | The 'Epoch' of the 'QuorumCertificate' is not consistent with the
       --  'Epoch' of the parent block. Witnessed by the block received.
-      BlockQCEpochInconsistent !SignedBlock
+      BlockQCEpochInconsistent !(SignedBlock pv)
     | -- | The round is not greater than the parent block. Witnessed by
       --  the block received.
-      BlockRoundInconsistent !SignedBlock
+      BlockRoundInconsistent !(SignedBlock pv)
     | -- | The epoch is not the current or current + 1 epoch. Witnessed
       --  by the block received.
-      BlockEpochInconsistent !SignedBlock
+      BlockEpochInconsistent !(SignedBlock pv)
     | -- | The block received contains an invalid 'QuorumCertificate'.
       --  Witnessed by the block received.
-      BlockInvalidQC !SignedBlock
+      BlockInvalidQC !(SignedBlock pv)
     | -- | The 'TimeoutCertificate' is missing and the 'Round' of the block is
       --  not sequentially the next 'Round'. Witnessed by the block received.
-      BlockTCMissing !SignedBlock
+      BlockTCMissing !(SignedBlock pv)
     | -- | The 'Round' of the 'TimeoutCertificate' is inconsistent.
       --  Witnessed by the block received.
-      BlockTCRoundInconsistent !SignedBlock
+      BlockTCRoundInconsistent !(SignedBlock pv)
     | -- | The 'QuorumCertificate' is inconsistent
       --  with the 'TimeoutCertificate' of the block.
       --  Witnessed by the block received.
-      BlockQCInconsistentWithTC !SignedBlock
+      BlockQCInconsistentWithTC !(SignedBlock pv)
     | -- | The previous round did not timeout, but there is a
       --  'TimeoutCertificate' present in the block.
       --  Witnessed by the block received.
-      BlockUnexpectedTC !SignedBlock
+      BlockUnexpectedTC !(SignedBlock pv)
     | -- | The 'TimeoutCertificate' is invalid.
       --  Witnessed by the block received.
-      BlockInvalidTC !SignedBlock
+      BlockInvalidTC !(SignedBlock pv)
     | -- | The 'SignedBlock' is too close to its parent @Block pv@.
-      BlockTooFast !SignedBlock !(Block pv)
+      BlockTooFast !(SignedBlock pv) !(Block pv)
     | -- | The block nonce is invalid. Witnessed by the block received.
-      BlockNonceIncorrect !SignedBlock
+      BlockNonceIncorrect !(SignedBlock pv)
     | -- | The block is in a new 'Epoch', but it is missing the finalization entry.
       --  Witnessed by the block received.
-      BlockEpochFinalizationMissing !SignedBlock
+      BlockEpochFinalizationMissing !(SignedBlock pv)
     | -- | The block was not in a new 'Epoch', but a finalization entry is presnet.
       --  Witnessed by the block received.
-      BlockUnexpectedEpochFinalization !SignedBlock
+      BlockUnexpectedEpochFinalization !(SignedBlock pv)
     | -- | The block is in a new 'Epoch' but the finalization entry is deemed invalid.
       --  Witnessed by the block received.
-      BlockInvalidEpochFinalization !SignedBlock
+      BlockInvalidEpochFinalization !(SignedBlock pv)
     | -- | Execution of the block failed.
       --  Witnessed by the block received.
-      BlockExecutionFailure !SignedBlock
+      BlockExecutionFailure !(SignedBlock pv)
     | -- | Execution of the block resulted in an unexpected outcome.
       --  Witnessed by the block received and the parent block.
-      BlockInvalidTransactionOutcomesHash !SignedBlock !(Block pv)
+      BlockInvalidTransactionOutcomesHash !(SignedBlock pv) !(Block pv)
     | -- | Execution of the block resulted in an unexpected state.
       --  Witnessed by the block received and the parent block.
-      BlockInvalidStateHash !SignedBlock !(Block pv)
+      BlockInvalidStateHash !(SignedBlock pv) !(Block pv)
     | -- | An invalid block was signed by the 'QuorumMessage'.
       --  Witnessed by the 'QuorumMessage' received.
       SignedInvalidBlock !QuorumMessage

concordium-consensus/src/Concordium/KonsensusV1/SkovMonad.hs

@@ -149,7 +149,7 @@ data HandlerContext (pv :: ProtocolVersion) m = HandlerContext
       -- | Handler to broadcast a quorum message.
       _sendQuorumHandler :: QuorumMessage -> m (),
       -- | Handler to broadcast a block.
-      _sendBlockHandler :: SignedBlock -> m (),
+      _sendBlockHandler :: SignedBlock pv -> m (),
       -- | An event handler called when a block becomes live.
       _onBlockHandler :: BlockPointer pv -> m (),
       -- | An event handler called per finalization. It is called with the
@@ -491,12 +491,13 @@ instance LMDBAccountMap.HasDatabaseHandlers (LMDBDatabases pv) where
 initialiseExistingSkovV1 ::
     forall pv m.
     (IsProtocolVersion pv, IsConsensusV1 pv) =>
+    GenesisBlockHeightInfo ->
     BakerContext ->
     HandlerContext pv m ->
     (forall a. SkovV1T pv m a -> IO a) ->
     GlobalStateConfig ->
     LogIO (Maybe (ExistingSkov pv m))
-initialiseExistingSkovV1 bakerCtx handlerCtx unliftSkov gsc@GlobalStateConfig{..} = do
+initialiseExistingSkovV1 genesisBlockHeightInfo bakerCtx handlerCtx unliftSkov gsc@GlobalStateConfig{..} = do
     logEvent Skov LLDebug "Attempting to use existing global state."
     existingDB <- checkExistingDatabase gscTreeStateDirectory gscBlockStateFile gscAccountMapDirectory
     if existingDB
@@ -517,7 +518,7 @@ initialiseExistingSkovV1 bakerCtx handlerCtx unliftSkov gsc@GlobalStateConfig{..
                     let initContext = InitContext pbsc skovLldb
                     (initialSkovData, effectiveProtocolUpdate) <-
                         runInitMonad
-                            (loadSkovData gscRuntimeParameters (rbrCount > 0))
+                            (loadSkovData genesisBlockHeightInfo gscRuntimeParameters (rbrCount > 0))
                             initContext
                     let !es =
                             ExistingSkov
@@ -554,12 +555,13 @@ initialiseNewSkovV1 ::
     forall pv m.
     (IsProtocolVersion pv, IsConsensusV1 pv) =>
     GenesisData pv ->
+    GenesisBlockHeightInfo ->
     BakerContext ->
     HandlerContext pv m ->
     (forall a. SkovV1T pv m a -> IO a) ->
     GlobalStateConfig ->
     LogIO (SkovV1Context pv m, SkovV1State pv)
-initialiseNewSkovV1 genData bakerCtx handlerCtx unliftSkov gsConfig@GlobalStateConfig{..} = do
+initialiseNewSkovV1 genData genesisBlockHeightInfo bakerCtx handlerCtx unliftSkov gsConfig@GlobalStateConfig{..} = do
     logEvent Skov LLDebug "Creating new global state."
     pbsc@PersistentBlockStateContext{..} <- newPersistentBlockStateContext True gsConfig
     let
@@ -587,7 +589,7 @@ initialiseNewSkovV1 genData bakerCtx handlerCtx unliftSkov gsConfig@GlobalStateC
                     chainParams ^. cpConsensusParameters . cpTimeoutParameters . tpTimeoutBase
             genEpochBakers <- genesisEpochBakers pbs
             let !initSkovData =
-                    mkInitialSkovData gscRuntimeParameters genMeta pbs genTimeoutDuration genEpochBakers genTT emptyPendingTransactionTable
+                    mkInitialSkovData gscRuntimeParameters genMeta genesisBlockHeightInfo pbs genTimeoutDuration genEpochBakers genTT emptyPendingTransactionTable
             let storedGenesis =
                     LowLevel.StoredBlock
                         { stbStatePointer = stateRef,
@@ -673,6 +675,8 @@ migrateSkovV1 ::
       IsProtocolVersion pv,
       IsProtocolVersion lastpv
     ) =>
+    -- | Block height information for the genesis block.
+    GenesisBlockHeightInfo ->
     -- | The genesis for the protocol after the protocol update.
     Regenesis pv ->
     -- | The migration.
@@ -696,7 +700,7 @@ migrateSkovV1 ::
     PendingTransactionTable ->
     -- | Return back the 'SkovV1Context' and the migrated 'SkovV1State'
     LogIO (SkovV1Context pv m, SkovV1State pv)
-migrateSkovV1 regenesis migration gsConfig@GlobalStateConfig{..} oldPbsc oldBlockState bakerCtx handlerCtx unliftSkov migrateTT migratePTT = do
+migrateSkovV1 genesisBlockHeightInfo regenesis migration gsConfig@GlobalStateConfig{..} oldPbsc oldBlockState bakerCtx handlerCtx unliftSkov migrateTT migratePTT = do
     pbsc@PersistentBlockStateContext{..} <- newPersistentBlockStateContext True gsConfig
     logEvent GlobalState LLDebug "Migrating existing global state."
     let newInitialBlockState :: InitMonad pv (HashedPersistentBlockState pv)
@@ -714,7 +718,7 @@ migrateSkovV1 regenesis migration gsConfig@GlobalStateConfig{..} oldPbsc oldBloc
             let genTimeoutDuration =
                     chainParams ^. cpConsensusParameters . cpTimeoutParameters . tpTimeoutBase
             let !initSkovData =
-                    mkInitialSkovData gscRuntimeParameters genMeta newState genTimeoutDuration genEpochBakers migrateTT migratePTT
+                    mkInitialSkovData gscRuntimeParameters genMeta genesisBlockHeightInfo newState genTimeoutDuration genEpochBakers migrateTT migratePTT
             let storedGenesis =
                     LowLevel.StoredBlock
                         { stbStatePointer = stateRef,

concordium-consensus/src/Concordium/KonsensusV1/TestMonad.hs

@@ -101,7 +101,7 @@ data TestEvent (pv :: ProtocolVersion)
     | -- | Implements 'sendQuorumMessage' of 'MonadBroadcast'.
       SendQuorumMessage !QuorumMessage
     | -- | Implements 'sendBlock' of 'MonadBroadcast'.
-      SendBlock !SignedBlock
+      SendBlock !(SignedBlock pv)
     | -- | Implements 'onBlock' of 'MonadConsensusEvent'.
       OnBlock !(Block pv)
     | -- | Implements 'onFinalize' of 'MonadConsensusEvent'.
@@ -183,10 +183,16 @@ runTestMonad _tcBakerContext _tcCurrentTime genData (TestMonad a) =
                       gmFirstGenesisHash = genesisBlockHash genData,
                       gmStateHash = getHash genState
                     }
+        let genesisBlockHeightInfo =
+                GenesisBlockHeightInfo
+                    { gbhiAbsoluteHeight = 0,
+                      gbhiGenesisIndex = 0
+                    }
         let _tsSkovData =
                 mkInitialSkovData
                     defaultRuntimeParameters
                     genMetadata
+                    genesisBlockHeightInfo
                     genState
                     genTimeoutBase
                     genEpochBakers

concordium-consensus/src/Concordium/KonsensusV1/Transactions.hs

@@ -252,7 +252,7 @@ processBlockItems ::
       GSTypes.BlockState m ~ PBS.HashedPersistentBlockState (MPV m)
     ) =>
     -- | The baked block
-    BakedBlock ->
+    BakedBlock pv ->
     -- | Pointer to the parent block.
     BlockPointer pv ->
     -- | Return 'True' only if all transactions were

concordium-consensus/src/Concordium/KonsensusV1/TreeState/Implementation.hs

@@ -41,6 +41,7 @@ import qualified Data.Sequence as Seq
 
 import qualified Concordium.Genesis.Data.BaseV1 as Base
 import Concordium.Types
+import qualified Concordium.Types.Conditionally as Cond
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
 import Concordium.Types.Option
@@ -184,6 +185,8 @@ data SkovData (pv :: ProtocolVersion) = SkovData
       _roundExistingQCs :: !(Map.Map Round QuorumCertificateCheckedWitness),
       -- | Genesis metadata
       _genesisMetadata :: !GenesisMetadata,
+      -- | Block height information of the (current) genesis block.
+      _genesisBlockHeight :: !GenesisBlockHeightInfo,
       -- | Pointer to the last finalized block.
       _lastFinalized :: !(BlockPointer pv),
       -- | A finalization entry that finalizes the last finalized block, unless that is the
@@ -278,10 +281,14 @@ purgeRoundExistingQCs rnd = roundExistingQCs %=! snd . Map.split (rnd - 1)
 --   * The caller must make sure, that the supplied 'TransactionTable' does NOT contain any @Committed@ transactions
 --     and all transactions have their commit point set to 0.
 mkInitialSkovData ::
+    forall pv.
+    (IsProtocolVersion pv) =>
     -- | The 'RuntimeParameters'
     RuntimeParameters ->
     -- | Genesis metadata. State hash should match the hash of the state.
     GenesisMetadata ->
+    -- | Block height information for the genesis block.
+    GenesisBlockHeightInfo ->
     -- | Genesis state
     PBS.HashedPersistentBlockState pv ->
     -- | The base timeout
@@ -294,7 +301,7 @@ mkInitialSkovData ::
     PendingTransactionTable ->
     -- | The initial 'SkovData'
     SkovData pv
-mkInitialSkovData rp genMeta genState _currentTimeout _skovEpochBakers transactionTable' pendingTransactionTable' =
+mkInitialSkovData rp genMeta genesisBlockHeightInfo genState _currentTimeout _skovEpochBakers transactionTable' pendingTransactionTable' =
     let genesisBlock = GenesisBlock genMeta
         genesisTime = timestampToUTCTime $ Base.genesisTime (gmParameters genMeta)
         genesisBlockMetadata =
@@ -303,7 +310,13 @@ mkInitialSkovData rp genMeta genState _currentTimeout _skovEpochBakers transacti
                   bmReceiveTime = genesisTime,
                   bmArriveTime = genesisTime,
                   bmEnergyCost = 0,
-                  bmTransactionsSize = 0
+                  bmTransactionsSize = 0,
+                  bmBlockStateHash =
+                    Cond.conditionally
+                        ( sBlockStateHashInMetadata
+                            (sBlockHashVersionFor (protocolVersion @pv))
+                        )
+                        (getHash genState)
                 }
         genesisBlockPointer =
             BlockPointer
@@ -326,6 +339,7 @@ mkInitialSkovData rp genMeta genState _currentTimeout _skovEpochBakers transacti
         _roundExistingBlocks = Map.empty
         _roundExistingQCs = Map.empty
         _genesisMetadata = genMeta
+        _genesisBlockHeight = genesisBlockHeightInfo
         _lastFinalized = genesisBlockPointer
         _latestFinalizationEntry = Absent
         _statistics = Stats.initialConsensusStatistics
@@ -376,7 +390,7 @@ mkBlockPointer [email protected]{..} = do
   where
     mkHashedPersistentBlockState = do
         hpbsPointers <- newIORef $! BlobStore.blobRefToBufferedRef stbStatePointer
-        let hpbsHash = blockStateHash sb
+        let hpbsHash = LowLevel.stbBlockStateHash sb
         return $! PBS.HashedPersistentBlockState{..}
 
 -- | Get the 'BlockStatus' of a block based on the provided 'BlockHash'.
@@ -462,16 +476,17 @@ getFirstFinalizedBlockOfEpoch epochOrBlock sd
 --  The hash of the block state MUST match the block state hash of the block; this is not checked.
 --  [Note: this does not affect the '_branches' of the 'SkovData'.]
 makeLiveBlock ::
-    (MonadState (SkovData pv) m) =>
+    forall m.
+    (MonadState (SkovData (MPV m)) m, IsProtocolVersion (MPV m)) =>
     -- | Pending block to make live
-    PendingBlock ->
+    PendingBlock (MPV m) ->
     -- | Block state associated with the block
-    PBS.HashedPersistentBlockState pv ->
+    PBS.HashedPersistentBlockState (MPV m) ->
     BlockHeight ->
     UTCTime ->
     -- | Energy used in executing the block
     Energy ->
-    m (BlockPointer pv)
+    m (BlockPointer (MPV m))
 makeLiveBlock pb st height arriveTime energyCost = do
     let bp =
             BlockPointer
@@ -481,7 +496,11 @@ makeLiveBlock pb st height arriveTime energyCost = do
                           bmArriveTime = arriveTime,
                           bmHeight = height,
                           bmEnergyCost = energyCost,
-                          bmTransactionsSize = fromIntegral $ sum (biSize <$> blockTransactions pb)
+                          bmTransactionsSize = fromIntegral $ sum (biSize <$> blockTransactions pb),
+                          bmBlockStateHash =
+                            Cond.conditionally
+                                (sBlockStateHashInMetadata (sBlockHashVersionFor (protocolVersion @(MPV m))))
+                                (getHash st)
                         },
                   bpBlock = NormalBlock (pbBlock pb),
                   bpState = st

concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel.hs

@@ -8,6 +8,7 @@ module Concordium.KonsensusV1.TreeState.LowLevel where
 import Data.Serialize
 
 import Concordium.Types
+import qualified Concordium.Types.Conditionally as Cond
 
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.BlockState
@@ -23,13 +24,26 @@ type BlockStateRef (pv :: ProtocolVersion) = BlobRef (BlockStatePointers pv)
 --  stored.
 data StoredBlock (pv :: ProtocolVersion) = StoredBlock
     { -- | Metadata about the block.
-      stbInfo :: !BlockMetadata,
+      stbInfo :: !(BlockMetadata pv),
       -- | The block itself.
       stbBlock :: !(Block pv),
       -- | Pointer to the state in the block state storage.
       stbStatePointer :: !(BlockStateRef pv)
     }
 
+-- | Get the block state hash for a stored block.
+stbBlockStateHash :: StoredBlock pv -> StateHash
+stbBlockStateHash storedBlock =
+    -- Prior to P7, the block state hash is stored in the baked block, for P7 and onwards the block
+    -- state hash is stored in the block metadata.
+    case bmBlockStateHash $ blockMetadata $ stbInfo storedBlock of
+        Cond.CTrue cBlockStateHash -> cBlockStateHash
+        Cond.CFalse -> case stbBlock storedBlock of
+            GenesisBlock meta -> gmStateHash meta
+            NormalBlock signedBlock ->
+                case blockDerivableHashes signedBlock of
+                    DBHashesV0 hashes -> bdhv0BlockStateHash hashes
+
 instance (IsProtocolVersion pv) => Serialize (StoredBlock pv) where
     put StoredBlock{..} = do
         putWord8 0 -- Version byte
@@ -51,19 +65,19 @@ instance (IsProtocolVersion pv) => Serialize (StoredBlock pv) where
             v -> fail $ "Unsupported StoredBlock version: " ++ show v
 
 instance BlockData (StoredBlock pv) where
-    type BakedBlockDataType (StoredBlock pv) = BakedBlockDataType SignedBlock
+    type BakedBlockDataType (StoredBlock pv) = SignedBlock pv
     blockRound = blockRound . stbBlock
     blockEpoch = blockEpoch . stbBlock
     blockTimestamp = blockTimestamp . stbBlock
     blockBakedData = blockBakedData . stbBlock
     blockTransactions = blockTransactions . stbBlock
     blockTransactionCount = blockTransactionCount . stbBlock
-    blockStateHash = blockStateHash . stbBlock
 
 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.