diff --git a/concordium-base b/concordium-base
index 74a1b12682..290a4b7849 160000
--- a/concordium-base
+++ b/concordium-base
@@ -1 +1 @@
-Subproject commit 74a1b12682ed9fae900b8b6ba452a7de15e5f906
+Subproject commit 290a4b78496abaab2ce90c49442dc9e369b2b354
diff --git a/concordium-consensus/package.yaml b/concordium-consensus/package.yaml
index b836542d9b..a6f2091a8c 100644
--- a/concordium-consensus/package.yaml
+++ b/concordium-consensus/package.yaml
@@ -257,7 +257,6 @@ executables:
     - concordium-consensus
     - clock
 
-
   database-exporter:
     main:         Main.hs
     source-dirs:  tools/database-exporter
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/LFMBTree.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/LFMBTree.hs
index 3e321f7cff..87906fc473 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/LFMBTree.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/LFMBTree.hs
@@ -1,5 +1,8 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -13,6 +16,12 @@ module Concordium.GlobalState.Basic.BlockState.LFMBTree (
     LFMBTree,
     size,
 
+    -- * Hash types
+    LFMBTreeHash' (..),
+    LFMBTreeHash,
+    LFMBTreeHashV0,
+    LFMBTreeHashV1,
+
     -- * Construction
     empty,
 
@@ -31,8 +40,11 @@ module Concordium.GlobalState.Basic.BlockState.LFMBTree (
     toAscList,
     toAscPairList,
     fromListChoosingFirst,
-    hashFromFoldable,
-    hashAsLFMBT,
+    hashP1FromFoldable,
+    hashAsLFMBTV0,
+    hashAsLFMBTV1,
+    lfmbtHash,
+    lfmbtHash',
 
     -- * Specialized functions for @Maybe@
     lookupMaybe,
@@ -46,6 +58,9 @@ module Concordium.GlobalState.Basic.BlockState.LFMBTree (
     -- * Helpers
     setBits,
 
+    -- * Auxiliary definitions
+    emptyTreeHashV0,
+
     -- * Structure specification
     -- $specification
 )
@@ -57,12 +72,16 @@ import Control.Monad (join)
 import Data.Bits
 import Data.Coerce (Coercible, coerce)
 import Data.Foldable (foldl', toList)
+import Data.Hashable (Hashable)
 import Data.Maybe (fromJust)
+import qualified Data.Serialize as S
 import Data.Word
 import Lens.Micro ((<&>))
 import Lens.Micro.Internal (Index, IxValue, Ixed (..))
 import Prelude hiding (lookup)
 
+import Concordium.Types
+
 {-
 -------------------------------------------------------------------------------
                                     Helpers
@@ -100,6 +119,33 @@ data T v
     | Leaf !v
     deriving (Eq, Show)
 
+-- | Hash representation type for an LFMBTree. This is parametrised by the block hash version.
+--
+--  * At 'BlockHashVersion0', the tree is hashed as a Merkle tree where each leaf is a hash
+--    (defined by the hashing scheme for the values) and inner nodes are hashed as the hash of
+--    the concatenation of the hashes of the two children. The empty tree is represented as the
+--    hash of the string "EmptyLFMBTree".
+--
+--  * At 'BlockHashVersion1', the tree hash is defined as the hash of the concatenation of the
+--    size (as a 64-bit big-endian) and the 'BlockHashVersion0' hash of the tree. The size of the
+--   tree fully determines its structure. Knowing the structure has two important benefits.
+--   First, it avoids the possibility of a leaf being mis-interpreted as an inner node, in case
+--   it is structurally similar. Second, it allows a verifier of a Merkle proof to know what
+--   index a path corresponds to. (In particular, the first index of a right branch depends on
+--   the size of the left branch, and that cannot be determined from the right branch alone, but
+--   does follow from knowing the size of the tree.)
+newtype LFMBTreeHash' (bhv :: BlockHashVersion) = LFMBTreeHash {theLFMBTreeHash :: H.Hash}
+    deriving newtype (Eq, Ord, Show, Read, Hashable, S.Serialize)
+
+-- | Hash of an LFMBTree parametrised by the protocol version.
+type LFMBTreeHash (pv :: ProtocolVersion) = LFMBTreeHash' (BlockHashVersionFor pv)
+
+-- | Alias for version 0 hash of an LFMBTree.
+type LFMBTreeHashV0 = LFMBTreeHash' 'BlockHashVersion0
+
+-- | Alias for version 1 hash of an LFMBTree.
+type LFMBTreeHashV1 = LFMBTreeHash' 'BlockHashVersion1
+
 {-
 -------------------------------------------------------------------------------
                                 Instances
@@ -110,11 +156,28 @@ instance (HashableTo H.Hash v) => HashableTo H.Hash (T v) where
     getHash (Leaf v) = getHash v
     getHash (Node _ l r) = H.hashOfHashes (getHash l) (getHash r)
 
--- | The hash of a LFMBTree is defined as the hash of the string "EmptyLFMBTree" if it
+-- | The hash used to represent an empty LFMBTree. Defined as the hash of the
+-- string "EmptyLFMBTree".
+emptyTreeHashV0 :: LFMBTreeHashV0
+emptyTreeHashV0 = LFMBTreeHash $ H.hash "EmptyLFMBTree"
+
+-- | The (P1) hash of an LFMBTree is defined as the hash of the string "EmptyLFMBTree" if it
 -- is empty or the hash of the tree otherwise.
-instance (HashableTo H.Hash v) => HashableTo H.Hash (LFMBTree k v) where
-    getHash Empty = H.hash "EmptyLFMBTree"
-    getHash (NonEmpty _ v) = getHash v
+instance (HashableTo H.Hash v) => HashableTo LFMBTreeHashV0 (LFMBTree k v) where
+    getHash Empty = emptyTreeHashV0
+    getHash (NonEmpty _ v) = LFMBTreeHash $ getHash v
+
+-- | The P7 hash of an LFMBTree is the hash of concatenation of the size of the tree (Word64,
+--  big-endian) and the P1 hash of the LFMBTree. This hash is more suitable for Merkle proofs,
+--  since the size is encoded.
+instance (HashableTo H.Hash v) => HashableTo LFMBTreeHashV1 (LFMBTree k v) where
+    getHash t = LFMBTreeHash $ H.hashLazy $ S.runPutLazy $ do
+        S.putWord64be sz
+        S.put $ getHash @(LFMBTreeHashV0) t
+      where
+        sz = case t of
+            Empty -> 0
+            NonEmpty s _ -> s
 
 type instance Index (LFMBTree k v) = k
 type instance IxValue (LFMBTree k v) = v
@@ -284,21 +347,23 @@ fromAscListMaybes l = fromList $ go l 0
 
 -- | Get the hash of an LFMBTree constructed from a 'Foldable' by inserting each item sequentially
 -- from index 0.
--- prop> hashFromFoldable l == getHash (fromFoldable @Word64 l)
+-- prop> hashP1FromFoldable l == getHash (fromFoldable @Word64 l)
 --
 -- TODO: Optimise this implementation.
-hashFromFoldable :: (Foldable f, HashableTo H.Hash v) => f v -> H.Hash
-hashFromFoldable = getHash . fromFoldable @Word64
+hashP1FromFoldable :: (Foldable f, HashableTo H.Hash v) => f v -> LFMBTreeHashV0
+hashP1FromFoldable = getHash . fromFoldable @Word64
 
 -- | Hash a list of hashes in the LFMBTree format, using the specified hash for the empty tree.
 --  This avoids building the full tree.
-hashAsLFMBT ::
+--  This uses the V0 hashing scheme, where the hash of a node is the hash of the concatenated
+--  hashes of its children.
+hashAsLFMBTV0 ::
     -- | Hash to use for empty list
     H.Hash ->
     -- | List of hashes to construct into Merkle tree
     [H.Hash] ->
     H.Hash
-hashAsLFMBT e = go
+hashAsLFMBTV0 e = go
   where
     go [] = e
     go [x] = x
@@ -306,6 +371,61 @@ hashAsLFMBT e = go
     f (x : y : xs) = H.hashOfHashes x y : f xs
     f other = other
 
+-- | Get the hash of an LFMBTree constructed from a 'Foldable'.
+--
+-- prop> lfmbtV0Hash l == getHash (fromFoldable @Word64 l)
+lfmbtV0Hash :: (Foldable f, HashableTo H.Hash v) => f v -> LFMBTreeHashV0
+{-# INLINE lfmbtV0Hash #-}
+lfmbtV0Hash = lfmbtV0Hash' getHash
+
+-- | Get the hash of an LFMBTree constructed from a 'Foldable' by applying the given hashing
+--  function to each element.
+lfmbtV0Hash' :: (Foldable f) => (v -> H.Hash) -> f v -> LFMBTreeHashV0
+{-# INLINE lfmbtV0Hash' #-}
+lfmbtV0Hash' hsh = LFMBTreeHash . hashAsLFMBTV0 (theLFMBTreeHash emptyTreeHashV0) . map hsh . toList
+
+-- | Hash a list of hashes in the LFMBTree format, using the specified hash for the empty tree.
+--  This avoids building the full tree.
+--  This uses the V1 hashing scheme, where the top level hash is the hash of the concatenation of
+--  the number of leaves in the tree and the V0 hash.
+hashAsLFMBTV1 ::
+    -- | Hash to use for empty list
+    H.Hash ->
+    -- | List of hashes to construct into Merkle tree
+    [H.Hash] ->
+    H.Hash
+hashAsLFMBTV1 e l = H.hashLazy $! S.runPutLazy $ do
+    S.putWord64be (fromIntegral $ length l)
+    S.put $ hashAsLFMBTV0 e l
+
+-- | Get the hash of an LFMBTree constructed from a 'Foldable'.
+--
+-- prop> lfmbtV1Hash l == getHash (fromFoldable @Word64 l)
+lfmbtV1Hash :: (Foldable f, HashableTo H.Hash v) => f v -> LFMBTreeHashV1
+{-# INLINE lfmbtV1Hash #-}
+lfmbtV1Hash = lfmbtV1Hash' getHash
+
+-- | Get the hash of an LFMBTree constructed from a 'Foldable' by applying the given hashing
+--  function to each element.
+lfmbtV1Hash' :: (Foldable f) => (v -> H.Hash) -> f v -> LFMBTreeHashV1
+{-# INLINE lfmbtV1Hash' #-}
+lfmbtV1Hash' hsh = LFMBTreeHash . hashAsLFMBTV1 (theLFMBTreeHash emptyTreeHashV0) . map hsh . toList
+
+-- | Get the hash of an LFMBTree constructed from a 'Foldable'.
+lfmbtHash :: (Foldable f, HashableTo H.Hash v) => SBlockHashVersion bhv -> f v -> LFMBTreeHash' bhv
+{-# INLINE lfmbtHash #-}
+lfmbtHash sbhv = case sbhv of
+    SBlockHashVersion0 -> lfmbtV0Hash
+    SBlockHashVersion1 -> lfmbtV1Hash
+
+-- | Get the hash of an LFMBTree constructed from a 'Foldable' by applying the given hashing
+--  function to each element.
+lfmbtHash' :: (Foldable f) => SBlockHashVersion bhv -> (v -> H.Hash) -> f v -> LFMBTreeHash' bhv
+{-# INLINE lfmbtHash' #-}
+lfmbtHash' sbhv = case sbhv of
+    SBlockHashVersion0 -> lfmbtV0Hash'
+    SBlockHashVersion1 -> lfmbtV1Hash'
+
 {-
 -------------------------------------------------------------------------------
                                 Specification
diff --git a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/PoolRewards.hs b/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/PoolRewards.hs
deleted file mode 100644
index 62525285d4..0000000000
--- a/concordium-consensus/src/Concordium/GlobalState/Basic/BlockState/PoolRewards.hs
+++ /dev/null
@@ -1,255 +0,0 @@
-{-# LANGUAGE RankNTypes #-}
-
-module Concordium.GlobalState.Basic.BlockState.PoolRewards where
-
-import Control.Exception
-import Control.Monad
-import qualified Data.Map.Strict as Map
-import Data.Serialize
-import qualified Data.Vector as Vec
-import Data.Word
-import Lens.Micro.Platform
-
-import Concordium.Crypto.SHA256 as Hash
-import Concordium.Types
-import Concordium.Types.HashableTo
-import Concordium.Utils.BinarySearch
-import Concordium.Utils.Serialization
-
-import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMBT
-import Concordium.GlobalState.CapitalDistribution
-import Concordium.GlobalState.Rewards
-import Concordium.Utils
-
--- | 'BakerPoolRewardDetails' tracks the rewards that have been earned by a baker pool in the current
---  reward period. These are used to pay out the rewards at the payday.
-data BakerPoolRewardDetails = BakerPoolRewardDetails
-    { -- | The number of blocks baked by this baker in the reward period
-      blockCount :: !Word64,
-      -- | The total transaction fees accrued to this pool in the reward period
-      transactionFeesAccrued :: !Amount,
-      -- | Whether the pool contributed to a finalization proof in the reward period
-      finalizationAwake :: !Bool
-    }
-    deriving (Eq, Show)
-
-instance Serialize BakerPoolRewardDetails where
-    put BakerPoolRewardDetails{..} = do
-        putWord64be blockCount
-        put transactionFeesAccrued
-        putBool finalizationAwake
-
-    get = BakerPoolRewardDetails <$> getWord64be <*> get <*> getBool
-
-instance HashableTo Hash.Hash BakerPoolRewardDetails where
-    getHash = Hash.hash . encode
-
--- | Baker pool reward details with no rewards accrued to the baker.
-emptyBakerPoolRewardDetails :: BakerPoolRewardDetails
-emptyBakerPoolRewardDetails =
-    BakerPoolRewardDetails
-        { blockCount = 0,
-          transactionFeesAccrued = 0,
-          finalizationAwake = False
-        }
-
-instance (Monad m) => MHashableTo m Hash.Hash BakerPoolRewardDetails
-
--- | Details of rewards accruing over the course of a reward period, and details about the capital
---  distribution for this reward period and (possibly) the next.
-data PoolRewards = PoolRewards
-    { -- | The capital distribution for the next reward period.
-      --  This is updated the epoch before a payday.
-      nextCapital :: !(Hashed CapitalDistribution),
-      -- | The capital distribution for the current reward period.
-      currentCapital :: !(Hashed CapitalDistribution),
-      -- | The details of rewards accruing to baker pools.
-      --  These are indexed by the index of the baker in the capital distribution (_not_ the BakerId).
-      --  There must be an entry for each baker in 'currentCapital'.
-      bakerPoolRewardDetails :: !(LFMBT.LFMBTree Word64 BakerPoolRewardDetails),
-      -- | The transaction reward amount accruing to the passive delegators.
-      passiveDelegationTransactionRewards :: !Amount,
-      -- | The transaction reward fraction accruing to the foundation.
-      foundationTransactionRewards :: !Amount,
-      -- | The next payday occurs at the start of this epoch.
-      nextPaydayEpoch :: !Epoch,
-      -- | The rate at which tokens are minted for the current reward period.
-      nextPaydayMintRate :: !MintRate
-    }
-    deriving (Show)
-
--- | Traversal for accessing the reward details for a particular baker ID.
-rewardDetails :: BakerId -> Traversal' PoolRewards BakerPoolRewardDetails
-rewardDetails bid f pr
-    | Just (index, _) <- mindex =
-        (\bprd -> pr{bakerPoolRewardDetails = bprd})
-            <$> ix (fromIntegral index) f (bakerPoolRewardDetails pr)
-    | otherwise = pure pr
-  where
-    mindex = binarySearchI bcBakerId (bakerPoolCapital $ _unhashed $ currentCapital pr) bid
-
--- | Look up the baker capital and reward details for a baker ID.
-lookupBakerCapitalAndRewardDetails :: BakerId -> PoolRewards -> Maybe (BakerCapital, BakerPoolRewardDetails)
-lookupBakerCapitalAndRewardDetails bid PoolRewards{..} = do
-    (index, capital) <- binarySearchI bcBakerId (bakerPoolCapital $ _unhashed currentCapital) bid
-    rds <- bakerPoolRewardDetails ^? ix (fromIntegral index)
-    return (capital, rds)
-
-instance HashableTo PoolRewardsHash PoolRewards where
-    getHash PoolRewards{..} =
-        PoolRewardsHash . Hash.hashOfHashes (getHash nextCapital) $
-            Hash.hashOfHashes (getHash currentCapital) $
-                Hash.hashOfHashes (getHash bakerPoolRewardDetails) $
-                    getHash $
-                        runPut $
-                            put passiveDelegationTransactionRewards
-                                <> put foundationTransactionRewards
-                                <> put nextPaydayEpoch
-                                <> put nextPaydayMintRate
-
--- | The empty 'PoolRewards', where there are no bakers, delegators or rewards.
---  This is generally not used except as a dummy value for testing.
-emptyPoolRewards :: PoolRewards
-emptyPoolRewards =
-    PoolRewards
-        { nextCapital = makeHashed emptyCapitalDistribution,
-          currentCapital = makeHashed emptyCapitalDistribution,
-          bakerPoolRewardDetails = LFMBT.empty,
-          passiveDelegationTransactionRewards = 0,
-          foundationTransactionRewards = 0,
-          nextPaydayEpoch = 0,
-          nextPaydayMintRate = MintRate 0 0
-        }
-
--- | A 'Putter' for 'PoolRewards'.
---  The 'bakerPoolRewardDetails' is serialized as a flat list, with the length implied by the
---  length of @bakerPoolCapital (_unhashed currentCapital)@.
-putPoolRewards :: Putter PoolRewards
-putPoolRewards PoolRewards{..} = do
-    put (_unhashed nextCapital)
-    put (_unhashed currentCapital)
-    let bprdList = LFMBT.toAscList bakerPoolRewardDetails
-    assert (Vec.length (bakerPoolCapital (_unhashed currentCapital)) == length bprdList) $
-        mapM_ put $
-            LFMBT.toAscList bakerPoolRewardDetails
-    put passiveDelegationTransactionRewards
-    put foundationTransactionRewards
-    put nextPaydayEpoch
-    put nextPaydayMintRate
-
--- | Deserialize 'PoolRewards'.
---  The 'bakerPoolRewardDetails' is serialized as a flat list, with the length implied by the
---  length of @bakerPoolCapital (_unhashed currentCapital)@.
-getPoolRewards :: Get PoolRewards
-getPoolRewards = do
-    nextCapital <- makeHashed <$> get
-    currentCapital <- makeHashed <$> get
-    bakerPoolRewardDetails <-
-        LFMBT.fromList
-            <$> replicateM
-                (Vec.length (bakerPoolCapital (_unhashed currentCapital)))
-                get
-    passiveDelegationTransactionRewards <- get
-    foundationTransactionRewards <- get
-    nextPaydayEpoch <- get
-    nextPaydayMintRate <- get
-    return PoolRewards{..}
-
--- | List of baker and number of blocks baked by this baker in the reward period.
-bakerBlockCounts :: PoolRewards -> [(BakerId, Word64)]
-bakerBlockCounts PoolRewards{..} =
-    zipWith
-        bc
-        (Vec.toList (bakerPoolCapital (_unhashed currentCapital)))
-        (LFMBT.toAscPairList bakerPoolRewardDetails)
-  where
-    bc BakerCapital{..} (_, BakerPoolRewardDetails{..}) = (bcBakerId, blockCount)
-
--- | Rotate the capital distribution, so that the current capital distribution is replaced by the
---  next one, and set up empty pool rewards.
-rotateCapitalDistribution :: PoolRewards -> PoolRewards
-rotateCapitalDistribution pr =
-    pr
-        { currentCapital = nextCapital pr,
-          bakerPoolRewardDetails =
-            LFMBT.fromList $
-                replicate
-                    (Vec.length (bakerPoolCapital (_unhashed (nextCapital pr))))
-                    emptyBakerPoolRewardDetails
-        }
-
--- | Set the next 'CapitalDistribution'.
-setNextCapitalDistribution ::
-    CapitalDistribution ->
-    PoolRewards ->
-    PoolRewards
-setNextCapitalDistribution cd pr =
-    pr{nextCapital = makeHashed cd}
-
--- | Construct 'PoolRewards' for migrating from 'P3' to 'P4'.
---  This is used to construct the state of the genesis block.
-makePoolRewardsForMigration ::
-    -- | Current epoch bakers and stakes, in ascending order of 'BakerId'.
-    Vec.Vector (BakerId, Amount) ->
-    -- | Next epoch bakers and stakes, in ascending order of 'BakerId'.
-    Vec.Vector (BakerId, Amount) ->
-    -- | 'BakerId's of baked blocks
-    [BakerId] ->
-    -- | Epoch of next payday
-    Epoch ->
-    -- | Mint rate for the next payday
-    MintRate ->
-    PoolRewards
-makePoolRewardsForMigration curBakers nextBakers bakedBlocks npEpoch npMintRate =
-    PoolRewards
-        { nextCapital = makeCD nextBakers,
-          currentCapital = makeCD curBakers,
-          bakerPoolRewardDetails = LFMBT.fromFoldable (makePRD <$> curBakers),
-          passiveDelegationTransactionRewards = 0,
-          foundationTransactionRewards = 0,
-          nextPaydayEpoch = npEpoch,
-          nextPaydayMintRate = npMintRate
-        }
-  where
-    makeCD bkrs =
-        makeHashed $
-            CapitalDistribution
-                { bakerPoolCapital = makeBakerCapital <$> bkrs,
-                  passiveDelegatorsCapital = Vec.empty
-                }
-    makeBakerCapital (bid, amt) = BakerCapital bid amt Vec.empty
-    blockCounts = foldr (\bid -> at' bid . non 0 %~ (+ 1)) Map.empty bakedBlocks
-    makePRD (bid, _) =
-        BakerPoolRewardDetails
-            { blockCount = Map.findWithDefault 0 bid blockCounts,
-              transactionFeesAccrued = 0,
-              finalizationAwake = False
-            }
-
--- | Make initial pool rewards for a genesis block state.
-makeInitialPoolRewards ::
-    -- | Genesis capital distribution
-    CapitalDistribution ->
-    -- | Epoch of next payday
-    Epoch ->
-    -- | Mint rate
-    MintRate ->
-    PoolRewards
-makeInitialPoolRewards cdist npEpoch npMintRate =
-    PoolRewards
-        { nextCapital = initCD,
-          currentCapital = initCD,
-          bakerPoolRewardDetails = bprd,
-          passiveDelegationTransactionRewards = 0,
-          foundationTransactionRewards = 0,
-          nextPaydayEpoch = npEpoch,
-          nextPaydayMintRate = npMintRate
-        }
-  where
-    initCD = makeHashed cdist
-    bprd = LFMBT.fromList (replicate (length (bakerPoolCapital cdist)) emptyBakerPoolRewardDetails)
-
--- | The total capital passively delegated in the current reward period's capital distribution.
-currentPassiveDelegationCapital :: PoolRewards -> Amount
-currentPassiveDelegationCapital =
-    Vec.sum . fmap dcDelegatorCapital . passiveDelegatorsCapital . _unhashed . currentCapital
diff --git a/concordium-consensus/src/Concordium/GlobalState/Block.hs b/concordium-consensus/src/Concordium/GlobalState/Block.hs
index af5a120a8a..b3d9f83e54 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Block.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Block.hs
@@ -23,6 +23,7 @@ import Concordium.Crypto.SHA256 as Hash
 import Concordium.GlobalState.Parameters
 import Concordium.Types
 import Concordium.Types.HashableTo
+import Concordium.Types.TransactionOutcomes
 import Concordium.Types.Transactions
 
 import Concordium.GlobalState.Finalization
@@ -334,9 +335,9 @@ instance forall pv. (IsProtocolVersion pv) => BlockData (Block pv) where
 
     -- move into gendata?
     blockTransactionOutcomesHash GenesisBlock{} =
-        case transactionOutcomesVersion @(TransactionOutcomesVersionFor pv) of
-            STOV0 -> getHash emptyTransactionOutcomesV0
-            STOV1 -> emptyTransactionOutcomesHashV1
+        toTransactionOutcomesHash $
+            emptyTransactionOutcomesHashV $
+                transactionOutcomesVersion @(TransactionOutcomesVersionFor pv)
     blockTransactionOutcomesHash (NormalBlock bb) = blockTransactionOutcomesHash bb
 
     blockSignature GenesisBlock{} = Nothing
diff --git a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
index 289a668393..7a648d1487 100644
--- a/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/BlockState.hs
@@ -71,10 +71,10 @@ import Concordium.Utils.Serialization
 import qualified Concordium.Wasm as Wasm
 
 import Concordium.GlobalState.BakerInfo
-import Concordium.GlobalState.Basic.BlockState.PoolRewards
 import Concordium.GlobalState.CapitalDistribution
 import Concordium.GlobalState.Instance
 import Concordium.GlobalState.Parameters hiding (getChainParameters)
+import Concordium.GlobalState.Persistent.PoolRewards
 import Concordium.GlobalState.Rewards
 import Concordium.GlobalState.Types
 import Concordium.Types.Accounts
@@ -94,11 +94,24 @@ import Concordium.GlobalState.TransactionTable (TransactionTable)
 import Concordium.ID.Parameters (GlobalContext)
 import Concordium.ID.Types (AccountCredential)
 import qualified Concordium.ID.Types as ID
+import Concordium.Types.TransactionOutcomes
 
 -- | Hash associated with birk parameters.
 newtype BirkParametersHash (pv :: ProtocolVersion) = BirkParametersHash {birkParamHash :: H.Hash}
     deriving newtype (Eq, Ord, Show, Serialize)
 
+-- | Hash associated with the accounts table.
+newtype AccountsHash (pv :: ProtocolVersion) = AccountsHash {theAccountsHash :: H.Hash}
+    deriving newtype (Eq, Ord, Show, Serialize)
+
+-- | Hash associated with the modules table.
+newtype ModulesHash (pv :: ProtocolVersion) = ModulesHash {theModulesHash :: H.Hash}
+    deriving newtype (Eq, Ord, Show, Serialize)
+
+-- | Hash associated with the instances table.
+newtype InstancesHash (pv :: ProtocolVersion) = InstancesHash {theInstancesHash :: H.Hash}
+    deriving newtype (Eq, Ord, Show, Serialize)
+
 -- | The hashes of the block state components, which are combined
 --  to produce a 'StateHash'.
 data BlockStateHashInputs (pv :: ProtocolVersion) = BlockStateHashInputs
@@ -106,12 +119,12 @@ data BlockStateHashInputs (pv :: ProtocolVersion) = BlockStateHashInputs
       bshCryptographicParameters :: H.Hash,
       bshIdentityProviders :: H.Hash,
       bshAnonymityRevokers :: H.Hash,
-      bshModules :: H.Hash,
+      bshModules :: ModulesHash pv,
       bshBankStatus :: H.Hash,
-      bshAccounts :: H.Hash,
-      bshInstances :: H.Hash,
+      bshAccounts :: AccountsHash pv,
+      bshInstances :: InstancesHash pv,
       bshUpdates :: H.Hash,
-      bshBlockRewardDetails :: BlockRewardDetailsHash (AccountVersionFor pv)
+      bshBlockRewardDetails :: BlockRewardDetailsHash pv
     }
     deriving (Show)
 
@@ -126,8 +139,8 @@ makeBlockStateHash BlockStateHashInputs{..} =
                     (H.hashOfHashes bshIdentityProviders bshAnonymityRevokers)
                 )
                 ( H.hashOfHashes
-                    (H.hashOfHashes bshModules bshBankStatus)
-                    (H.hashOfHashes bshAccounts bshInstances)
+                    (H.hashOfHashes (theModulesHash bshModules) bshBankStatus)
+                    (H.hashOfHashes (theAccountsHash bshAccounts) (theInstancesHash bshInstances))
                 )
             )
             ( H.hashOfHashes
diff --git a/concordium-consensus/src/Concordium/GlobalState/CapitalDistribution.hs b/concordium-consensus/src/Concordium/GlobalState/CapitalDistribution.hs
index fbb37547dc..4a95aca2d8 100644
--- a/concordium-consensus/src/Concordium/GlobalState/CapitalDistribution.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/CapitalDistribution.hs
@@ -1,3 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
 -- | This module contains common types for representing the capital distribution of bakers and
 --  delegators.  A snapshot of the capital distribution is taken when the bakers for a payday are
 --  calculated.  This is then used to determine how rewards are distributed among the bakers and
@@ -5,6 +11,7 @@
 module Concordium.GlobalState.CapitalDistribution where
 
 import Data.Serialize
+import Data.Singletons
 import qualified Data.Vector as Vec
 
 import qualified Concordium.Crypto.SHA256 as Hash
@@ -61,14 +68,21 @@ instance Serialize BakerCapital where
         bcDelegatorCapital <- flip Vec.generateM (const get) =<< getLength
         return BakerCapital{..}
 
-instance HashableTo Hash.Hash BakerCapital where
-    getHash BakerCapital{..} = Hash.hash $
-        runPut $ do
-            put bcBakerId
-            put bcBakerEquityCapital
-            put $ LFMBT.hashFromFoldable bcDelegatorCapital
+newtype BakerCapitalHash' (bhv :: BlockHashVersion) = BakerCapitalHash
+    { theBakerCapitalHash :: Hash.Hash
+    }
+    deriving newtype (Eq, Ord, Show, Read, Serialize)
+
+type BakerCapitalHash (pv :: ProtocolVersion) =
+    BakerCapitalHash' (BlockHashVersionFor pv)
+
+instance (IsBlockHashVersion bhv) => HashableTo (BakerCapitalHash' bhv) BakerCapital where
+    getHash BakerCapital{..} = BakerCapitalHash . Hash.hash . runPut $ do
+        put bcBakerId
+        put bcBakerEquityCapital
+        put $ LFMBT.lfmbtHash (sing @bhv) bcDelegatorCapital
 
-instance (Monad m) => MHashableTo m Hash.Hash BakerCapital
+instance (IsBlockHashVersion bhv, Monad m) => MHashableTo m (BakerCapitalHash' bhv) BakerCapital
 
 -- | The total capital delegated to the baker.
 bcTotalDelegatorCapital :: BakerCapital -> Amount
@@ -93,13 +107,30 @@ instance Serialize CapitalDistribution where
         passiveDelegatorsCapital <- flip Vec.generateM (const get) =<< getLength
         return CapitalDistribution{..}
 
-instance HashableTo Hash.Hash CapitalDistribution where
-    getHash CapitalDistribution{..} =
-        Hash.hashOfHashes
-            (LFMBT.hashFromFoldable bakerPoolCapital)
-            (LFMBT.hashFromFoldable passiveDelegatorsCapital)
+newtype CapitalDistributionHash' (bhv :: BlockHashVersion) = CapitalDistributionHash
+    { theCapitalDistributionHash :: Hash.Hash
+    }
+    deriving newtype (Eq, Ord, Show, Read, Serialize)
 
-instance (Monad m) => MHashableTo m Hash.Hash CapitalDistribution
+type CapitalDistributionHash (pv :: ProtocolVersion) =
+    CapitalDistributionHash' (BlockHashVersionFor pv)
+
+instance
+    (IsBlockHashVersion bhv) =>
+    HashableTo (CapitalDistributionHash' bhv) CapitalDistribution
+    where
+    getHash CapitalDistribution{..} =
+        CapitalDistributionHash $
+            Hash.hashOfHashes
+                (lfmbtHash (theBakerCapitalHash @bhv . getHash) bakerPoolCapital)
+                (lfmbtHash getHash passiveDelegatorsCapital)
+      where
+        lfmbtHash :: (a -> Hash.Hash) -> Vec.Vector a -> Hash.Hash
+        lfmbtHash gHash = LFMBT.theLFMBTreeHash . LFMBT.lfmbtHash' (sing @bhv) gHash
+
+instance
+    (IsBlockHashVersion bhv, Monad m) =>
+    MHashableTo m (CapitalDistributionHash' bhv) CapitalDistribution
 
 -- | The empty 'CapitalDistribution', with no bakers or passive delegators.
 emptyCapitalDistribution :: CapitalDistribution
diff --git a/concordium-consensus/src/Concordium/GlobalState/Instance.hs b/concordium-consensus/src/Concordium/GlobalState/Instance.hs
index a9846bc0be..7dcac93de6 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Instance.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Instance.hs
@@ -1,43 +1,14 @@
-{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveFunctor #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 
--- |
---  The "basic" implementation of contract state, which keeps the state in memory.
---  This module contains both some common abstractions (e.g., HasInstanceAddress)
---  as well as the basic implementation which should ideally be in Concordium.GlobalState.Basic.Instance.
---  At some future point we should consider splitting this module into two as outlined above.
-module Concordium.GlobalState.Instance where
+-- | Basic interface definitions for smart contract instances.
+module Concordium.GlobalState.Instance (InstanceParameters (..), HasInstanceAddress (..)) where
 
-import qualified Concordium.Crypto.SHA256 as H
-import qualified Concordium.Crypto.SHA256 as SHA256
-import qualified Concordium.GlobalState.ContractStateV1 as StateV1
-import qualified Concordium.GlobalState.Wasm as GSWasm
-import Concordium.Types
-import Concordium.Types.HashableTo
-import qualified Concordium.Wasm as Wasm
-import Data.Maybe
-import Data.Serialize
 import qualified Data.Set as Set
 
--- | State of a smart contract parametrized by the contract version. This is the
---  "basic" version which keeps the state in memory. The persistent version is
---  defined in Concordium.GlobalState.Persistent.Instance.
-data InstanceStateV (v :: Wasm.WasmVersion) where
-    InstanceStateV0 :: !Wasm.ContractState -> InstanceStateV GSWasm.V0
-    InstanceStateV1 :: !StateV1.InMemoryPersistentState -> InstanceStateV GSWasm.V1
-
--- There is no versioning added to this. Contract state is always serialized in
--- the context of an instance, which gives it a version.
-instance Serialize (InstanceStateV GSWasm.V0) where
-    put (InstanceStateV0 model) = put model
-    get = InstanceStateV0 <$> get
+import Concordium.Types
+import qualified Concordium.Wasm as Wasm
 
-instance Serialize (InstanceStateV GSWasm.V1) where
-    put (InstanceStateV1 model) = put model
-    get = InstanceStateV1 <$> get
+import qualified Concordium.GlobalState.Wasm as GSWasm
 
 -- | The fixed parameters associated with a smart contract instance, parametrized by the type
 --  of the instrumented module.
@@ -66,244 +37,3 @@ instance Show (InstanceParameters im) where
     show InstanceParameters{..} = show _instanceAddress ++ " :: " ++ show instanceContractModule ++ "." ++ show instanceInitName
       where
         instanceContractModule = GSWasm.miModuleRef instanceModuleInterface
-
-instance HashableTo H.Hash (InstanceParameters im) where
-    getHash InstanceParameters{..} =
-        makeInstanceParameterHash
-            _instanceAddress
-            instanceOwner
-            (GSWasm.miModuleRef instanceModuleInterface)
-            instanceInitName
-
--- | A versioned basic in-memory instance, parametrized by the version of the
---  Wasm module that is associated with it.
-data InstanceV instrumentedModule (v :: Wasm.WasmVersion) = InstanceV
-    { -- | The fixed parameters of the instance
-      --  These can be changed with the 'Upgrade' feature introduced in PV5.
-      _instanceVParameters :: !(InstanceParameters instrumentedModule),
-      -- | The current local state of the instance
-      _instanceVModel :: !(InstanceStateV v),
-      -- | The current amount of GTU owned by the instance
-      _instanceVAmount :: !Amount,
-      -- | Hash of the smart contract instance
-      _instanceVHash :: !H.Hash
-    }
-
-class HasInstanceFields a where
-    instanceAmount :: a -> Amount
-    instanceHash :: a -> H.Hash
-
-instance HasInstanceFields (InstanceV im v) where
-    {-# INLINE instanceAmount #-}
-    instanceAmount = _instanceVAmount
-    {-# INLINE instanceHash #-}
-    instanceHash = _instanceVHash
-
-instance HasInstanceFields (Instance im) where
-    instanceAmount (InstanceV0 i) = instanceAmount i
-    instanceAmount (InstanceV1 i) = instanceAmount i
-    instanceHash (InstanceV0 i) = instanceHash i
-    instanceHash (InstanceV1 i) = instanceHash i
-
-instance HasInstanceAddress (InstanceV im v) where
-    instanceAddress = instanceAddress . _instanceVParameters
-
-instance HasInstanceAddress (Instance im) where
-    instanceAddress (InstanceV0 i) = instanceAddress i
-    instanceAddress (InstanceV1 i) = instanceAddress i
-
--- | An instance of a smart contract.
-data Instance im
-    = InstanceV0 (InstanceV (im GSWasm.V0) GSWasm.V0)
-    | InstanceV1 (InstanceV (im GSWasm.V1) GSWasm.V1)
-
-type BasicInstance = Instance GSWasm.InstrumentedModuleV
-
-instance Show (Instance im) where
-    show (InstanceV0 InstanceV{..}) = show _instanceVParameters ++ " {balance=" ++ show _instanceVAmount ++ ", hash = " ++ show _instanceVHash ++ "}"
-    show (InstanceV1 InstanceV{..}) = show _instanceVParameters ++ " {balance=" ++ show _instanceVAmount ++ ", hash =" ++ show _instanceVHash ++ "}"
-
-instance HashableTo H.Hash (Instance im) where
-    getHash (InstanceV0 InstanceV{..}) = _instanceVHash
-    getHash (InstanceV1 InstanceV{..}) = _instanceVHash
-
--- | Compute the hash of the instance parameters.
-makeInstanceParameterHash :: ContractAddress -> AccountAddress -> ModuleRef -> Wasm.InitName -> H.Hash
-makeInstanceParameterHash ca aa modRef conName = H.hashLazy $ runPutLazy $ do
-    put ca
-    put aa
-    put modRef
-    put conName
-
--- | Construct the hash of a basic instance from the __hash of the parameters__, the state, and amount for a V0 instance.
-makeInstanceHashV0' :: H.Hash -> InstanceStateV GSWasm.V0 -> Amount -> H.Hash
-makeInstanceHashV0' paramHash (InstanceStateV0 conState) a = H.hashLazy $ runPutLazy $ do
-    put paramHash
-    putByteString (H.hashToByteString (getHash conState))
-    put a
-
--- | Construct the hash of a basic instance from the instance parameters, the state, and amount for a V0 instance.
-makeInstanceHashV0 :: InstanceParameters v -> InstanceStateV GSWasm.V0 -> Amount -> H.Hash
-makeInstanceHashV0 = makeInstanceHashV0' . getHash
-
--- | Construct the hash of a basic instance from the __hash of the parameters__,
---  the state, and amount for a V1 instance. Note that V1 and V0 instance hashes
---  will be different assuming no hash collisions since 'ModuleRef's for V0 and
---  V1 are distinct (because the version is included in the hash), and
---  'ModuleRef' is included in the parameter hash.
-makeInstanceHashV1' :: H.Hash -> InstanceStateV GSWasm.V1 -> Amount -> H.Hash
-makeInstanceHashV1' paramHash (InstanceStateV1 conState) a = H.hashLazy $ runPutLazy $ do
-    put paramHash
-    put (getHash conState :: SHA256.Hash)
-    put a
-
--- | Construct the hash of a basic instance from the instance parameters, the state, and amount for a V1 instance.
-makeInstanceHashV1 :: InstanceParameters im -> InstanceStateV GSWasm.V1 -> Amount -> H.Hash
-makeInstanceHashV1 = makeInstanceHashV1' . getHash
-
--- | Compute the hash of either a V0 or V1 instance. The version is determined by the type parameter.
-makeInstanceHash :: InstanceParameters im -> InstanceStateV v -> Amount -> H.Hash
-makeInstanceHash params state =
-    case state of
-        InstanceStateV0 _ -> makeInstanceHashV0' (getHash params) state
-        InstanceStateV1 _ -> makeInstanceHashV1' (getHash params) state
-
-makeInstanceV ::
-    -- | Name of the init method used to initialize the contract.
-    Wasm.InitName ->
-    -- | Receive functions suitable for this instance.
-    Set.Set Wasm.ReceiveName ->
-    -- | Module interface
-    GSWasm.ModuleInterfaceA im ->
-    -- | Initial state
-    InstanceStateV v ->
-    -- | Initial balance
-    Amount ->
-    -- | Owner/creator of the instance.
-    AccountAddress ->
-    -- | Address for the instance
-    ContractAddress ->
-    InstanceV im v
-makeInstanceV instanceInitName instanceReceiveFuns instanceModuleInterface _instanceVModel _instanceVAmount instanceOwner _instanceAddress =
-    InstanceV
-        { _instanceVHash = makeInstanceHash _instanceVParameters _instanceVModel _instanceVAmount,
-          ..
-        }
-  where
-    _instanceVParameters = InstanceParameters{..}
-
-makeInstance ::
-    -- | Name of the init method used to initialize the contract.
-    Wasm.InitName ->
-    -- | Receive functions suitable for this instance.
-    Set.Set Wasm.ReceiveName ->
-    -- | Module interface
-    GSWasm.ModuleInterfaceA (im v) ->
-    -- | Initial state
-    InstanceStateV v ->
-    -- | Initial balance
-    Amount ->
-    -- | Owner/creator of the instance.
-    AccountAddress ->
-    -- | Address for the instance
-    ContractAddress ->
-    Instance im
-makeInstance instanceInitName instanceReceiveFuns instanceModuleInterface _instanceVModel _instanceVAmount instanceOwner _instanceAddress =
-    case _instanceVModel of
-        InstanceStateV0{} -> InstanceV0 instanceV
-        InstanceStateV1{} -> InstanceV1 instanceV
-  where
-    instanceV = makeInstanceV instanceInitName instanceReceiveFuns instanceModuleInterface _instanceVModel _instanceVAmount instanceOwner _instanceAddress
-
--- | Update a given smart contract instance.
-updateInstanceV :: AmountDelta -> Maybe (InstanceStateV v) -> Maybe (GSWasm.ModuleInterfaceA im, Set.Set Wasm.ReceiveName) -> InstanceV im v -> InstanceV im v
-updateInstanceV delta val maybeNewModule i = updateInstanceV' amnt val maybeNewModule i
-  where
-    amnt = applyAmountDelta delta (_instanceVAmount i)
-
--- | Update a given smart contract instance with exactly the given amount, state and possibly upgrade the module.
-updateInstanceV' :: Amount -> Maybe (InstanceStateV v) -> Maybe (GSWasm.ModuleInterfaceA im, Set.Set Wasm.ReceiveName) -> InstanceV im v -> InstanceV im v
-updateInstanceV' amnt val maybeNewMod i =
-    i
-        { _instanceVModel = newVal,
-          _instanceVAmount = amnt,
-          _instanceVParameters = newParams,
-          _instanceVHash = makeInstanceHash newParams newVal amnt
-        }
-  where
-    newVal = fromMaybe (_instanceVModel i) val
-    newParams = maybe (_instanceVParameters i) (\(nm, newEntrypoints) -> (_instanceVParameters i){instanceModuleInterface = nm, instanceReceiveFuns = newEntrypoints}) maybeNewMod
-
--- | Serialize a V0 smart contract instance in V0 format.
-putV0InstanceV0 :: Putter (InstanceV im GSWasm.V0)
-putV0InstanceV0 InstanceV{_instanceVParameters = InstanceParameters{..}, ..} = do
-    -- InstanceParameters
-    -- Only put the Subindex part of the address
-    put (contractSubindex _instanceAddress)
-    put instanceOwner
-    put (GSWasm.miModuleRef instanceModuleInterface)
-    put instanceInitName
-    -- instanceReceiveFuns, instanceModuleInterface and instanceParameterHash
-    -- are not included, since they can be derived from context.
-    put _instanceVModel
-    put _instanceVAmount
-
--- | Serialize a V1 smart contract instance in V0 format.
-putV1InstanceV0 :: Putter (InstanceV im GSWasm.V1)
-putV1InstanceV0 InstanceV{_instanceVParameters = InstanceParameters{..}, ..} = do
-    -- InstanceParameters
-    -- Only put the Subindex part of the address
-    put (contractSubindex _instanceAddress)
-    put instanceOwner
-    put (GSWasm.miModuleRef instanceModuleInterface)
-    put instanceInitName
-    -- instanceReceiveFuns, instanceModuleInterface and instanceParameterHash
-    -- are not included, since they can be derived from context.
-    put _instanceVModel
-    put _instanceVAmount
-
--- | Deserialize a V0 smart contract instance in V0 format.
-getV0InstanceV0 ::
-    -- | Function for resolving the receive functions and module interface.
-    (ModuleRef -> Wasm.InitName -> Maybe (Set.Set Wasm.ReceiveName, GSWasm.ModuleInterface im)) ->
-    -- | Index of the contract
-    ContractIndex ->
-    Get (InstanceV (im GSWasm.V0) GSWasm.V0)
-getV0InstanceV0 resolve idx = do
-    -- InstanceParameters
-    subindex <- get
-    let _instanceAddress = ContractAddress idx subindex
-    instanceOwner <- get
-    instanceContractModule <- get
-    instanceInitName <- get
-    (instanceReceiveFuns, instanceModuleInterface) <-
-        case resolve instanceContractModule instanceInitName of
-            Just (r, GSWasm.ModuleInterfaceV0 iface) -> return (r, iface)
-            Just (_, GSWasm.ModuleInterfaceV1 _) -> fail "Expected module version 0, but module version 1 encountered."
-            Nothing -> fail "Unable to resolve smart contract"
-    _instanceVModel <- get
-    _instanceVAmount <- get
-    return $ makeInstanceV instanceInitName instanceReceiveFuns instanceModuleInterface _instanceVModel _instanceVAmount instanceOwner _instanceAddress
-
--- | Deserialize a V1 smart contract instance in V0 format.
-getV1InstanceV0 ::
-    -- | Function for resolving the receive functions and module interface.
-    (ModuleRef -> Wasm.InitName -> Maybe (Set.Set Wasm.ReceiveName, GSWasm.ModuleInterface im)) ->
-    -- | Index of the contract
-    ContractIndex ->
-    Get (InstanceV (im GSWasm.V1) GSWasm.V1)
-getV1InstanceV0 resolve idx = do
-    -- InstanceParameters
-    subindex <- get
-    let _instanceAddress = ContractAddress idx subindex
-    instanceOwner <- get
-    instanceContractModule <- get
-    instanceInitName <- get
-    (instanceReceiveFuns, instanceModuleInterface) <-
-        case resolve instanceContractModule instanceInitName of
-            Just (_, GSWasm.ModuleInterfaceV0 _) -> fail "Expected module version 1, but module version 0 encountered."
-            Just (r, GSWasm.ModuleInterfaceV1 iface) -> return (r, iface)
-            Nothing -> fail "Unable to resolve smart contract"
-    _instanceVModel <- get
-    _instanceVAmount <- get
-    return $ makeInstanceV instanceInitName instanceReceiveFuns instanceModuleInterface _instanceVModel _instanceVAmount instanceOwner _instanceAddress
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
index cb385b38ab..e5bb621e7f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Accounts.hs
@@ -61,16 +61,16 @@
 --  for keeping track of non persisted accounts for supporting e.g. queries via the ‘AccountAddress'.
 module Concordium.GlobalState.Persistent.Accounts where
 
-import qualified Concordium.Crypto.SHA256 as H
 import qualified Concordium.GlobalState.AccountMap as OldMap
 import qualified Concordium.GlobalState.AccountMap.DifferenceMap as DiffMap
 import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
+import Concordium.GlobalState.BlockState (AccountsHash (..))
 import Concordium.GlobalState.Parameters
 import Concordium.GlobalState.Persistent.Account
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
-import Concordium.GlobalState.Persistent.LFMBTree (LFMBTree')
+import Concordium.GlobalState.Persistent.LFMBTree (LFMBTree', LFMBTreeHash, LFMBTreeHash' (..))
 import qualified Concordium.GlobalState.Persistent.LFMBTree as L
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
 import Concordium.ID.Parameters
@@ -144,8 +144,10 @@ type SupportsPersistentAccount pv m =
       LMDBAccountMap.MonadAccountMapStore m
     )
 
-instance (SupportsPersistentAccount pv m) => MHashableTo m H.Hash (Accounts pv) where
-    getHashM Accounts{..} = getHashM accountTable
+instance (SupportsPersistentAccount pv m) => MHashableTo m (AccountsHash pv) (Accounts pv) where
+    getHashM Accounts{..} =
+        AccountsHash . theLFMBTreeHash
+            <$> getHashM @m @(LFMBTreeHash pv) accountTable
 
 -- | Write accounts created for this block or any non-persisted parent block.
 --  Note that this also empties the difference map for this block.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs
index a2937541e8..8428f409e4 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlobStore.hs
@@ -157,9 +157,9 @@ import Concordium.GlobalState.Persistent.MonadicRecursive
 -- Imports for providing instances
 import Concordium.Common.Time
 import Concordium.GlobalState.Account
-import Concordium.GlobalState.Basic.BlockState.PoolRewards
 import Concordium.GlobalState.CapitalDistribution
 import qualified Concordium.GlobalState.Parameters as Parameters
+import Concordium.GlobalState.PoolRewards
 import Concordium.Logger (MonadLogger)
 import Concordium.Types
 import Concordium.Types.Accounts
@@ -1610,11 +1610,13 @@ migrateHashedBufferedRefKeepHash hb = do
 -- | Migrate a 'HashedBufferedRef'. The returned reference has a hash computed
 --  already. The input reference is uncached, and the new references is flushed
 --  to disk, as well as cached in memory.
+--  The hash for the new reference is computed afresh, allowing for a change of
+--  hashing scheme and/or a modification of the underlying data.
 migrateHashedBufferedRef ::
-    (MonadTrans t, MHashableTo (t m) h b, BlobStorable m a, BlobStorable (t m) b) =>
+    (MonadTrans t, MHashableTo (t m) h2 b, BlobStorable m a, BlobStorable (t m) b) =>
     (a -> t m b) ->
-    HashedBufferedRef' h a ->
-    t m (HashedBufferedRef' h b)
+    HashedBufferedRef' h1 a ->
+    t m (HashedBufferedRef' h2 b)
 migrateHashedBufferedRef f hb = do
     !newRef <- refMake =<< f =<< lift (refLoad (bufferedReference hb))
     -- compute the hash while the data is in memory.
@@ -1629,7 +1631,7 @@ migrateHashedBufferedRef f hb = do
 type HashedBufferedRef = HashedBufferedRef' H.Hash
 
 -- | Created a 'HashedBufferedRef' value from a 'Hashed' value, retaining the hash.
-bufferHashed :: (MonadIO m) => Hashed a -> m (HashedBufferedRef a)
+bufferHashed :: (MonadIO m) => Hashed' h a -> m (HashedBufferedRef' h a)
 bufferHashed (Hashed !val !h) = do
     br <- makeBufferedRef val
     hashRef <- liftIO $ newIORef (Some h)
@@ -1652,7 +1654,7 @@ instance (DirectBlobStorable m a, MHashableTo m h a) => MHashableTo m h (HashedB
                 return h
             Some h -> return h
 
-instance (Show a) => Show (HashedBufferedRef a) where
+instance (Show a) => Show (HashedBufferedRef' h a) where
     show ref = show (bufferedReference ref)
 
 instance (DirectBlobStorable m a) => BlobStorable m (HashedBufferedRef' h a) where
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
index 82c3587ace..d6764145b5 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState.hs
@@ -29,7 +29,8 @@ module Concordium.GlobalState.Persistent.BlockState (
     emptyPersistentTransactionOutcomes,
     PersistentBlockStateContext (..),
     PersistentState,
-    BlockRewardDetails (..),
+    BlockRewardDetails' (..),
+    BlockRewardDetails,
     PersistentBlockStateMonad (..),
     withNewAccountCacheAndLMDBAccountMap,
     cacheState,
@@ -81,6 +82,7 @@ import Concordium.Types.HashableTo
 import qualified Concordium.Types.IdentityProviders as IPS
 import Concordium.Types.Queries (CurrentPaydayBakerPoolStatus (..), PoolStatus (..), RewardStatus' (..), makePoolPendingChange)
 import Concordium.Types.SeedState
+import qualified Concordium.Types.TransactionOutcomes as TransactionOutcomes
 import qualified Concordium.Types.Transactions as Transactions
 import qualified Concordium.Types.UpdateQueues as UQ
 import Concordium.Types.Updates
@@ -558,9 +560,11 @@ putHashedEpochBlocksV0 HashedEpochBlocks{..} = do
         EpochBlock{..} <- refLoad ebref
         loadEB (s Seq.|> ebBakerId) ebPrevious
 
-data BlockRewardDetails (av :: AccountVersion) where
-    BlockRewardDetailsV0 :: !HashedEpochBlocks -> BlockRewardDetails 'AccountV0
-    BlockRewardDetailsV1 :: (AVSupportsDelegation av) => !(HashedBufferedRef' Rewards.PoolRewardsHash PoolRewards) -> BlockRewardDetails av
+data BlockRewardDetails' (av :: AccountVersion) (bhv :: BlockHashVersion) where
+    BlockRewardDetailsV0 :: !HashedEpochBlocks -> BlockRewardDetails' 'AccountV0 bhv
+    BlockRewardDetailsV1 :: (AVSupportsDelegation av) => !(HashedBufferedRef' (Rewards.PoolRewardsHash bhv) (PoolRewards bhv)) -> BlockRewardDetails' av bhv
+
+type BlockRewardDetails pv = BlockRewardDetails' (AccountVersionFor pv) (BlockHashVersionFor pv)
 
 -- | Migrate the block reward details.
 --  When migrating to a 'P4' or later, this sets the 'nextPaydayEpoch' to the reward period length.
@@ -579,8 +583,8 @@ migrateBlockRewardDetails ::
     OParam 'PTTimeParameters (ChainParametersVersionFor pv) TimeParameters ->
     -- | The epoch number before the protocol update.
     Epoch ->
-    BlockRewardDetails (AccountVersionFor oldpv) ->
-    t m (BlockRewardDetails (AccountVersionFor pv))
+    BlockRewardDetails oldpv ->
+    t m (BlockRewardDetails pv)
 migrateBlockRewardDetails StateMigrationParametersTrivial _ _ tp oldEpoch = \case
     (BlockRewardDetailsV0 heb) -> BlockRewardDetailsV0 <$> migrateHashedEpochBlocks heb
     (BlockRewardDetailsV1 hbr) -> case tp of
@@ -616,22 +620,28 @@ migrateBlockRewardDetails StateMigrationParametersP6ToP7{} _ _ (SomeParam TimePa
         BlockRewardDetailsV1
             <$> migrateHashedBufferedRef (migratePoolRewards (rewardPeriodEpochs _tpRewardPeriodLength)) hbr
 
-instance (MonadBlobStore m) => MHashableTo m (Rewards.BlockRewardDetailsHash av) (BlockRewardDetails av) where
+instance
+    (MonadBlobStore m, IsBlockHashVersion bhv) =>
+    MHashableTo m (Rewards.BlockRewardDetailsHash' av bhv) (BlockRewardDetails' av bhv)
+    where
     getHashM (BlockRewardDetailsV0 heb) = return $ Rewards.BlockRewardDetailsHashV0 (getHash heb)
     getHashM (BlockRewardDetailsV1 pr) = Rewards.BlockRewardDetailsHashV1 <$> getHashM pr
 
-instance (IsAccountVersion av, MonadBlobStore m) => BlobStorable m (BlockRewardDetails av) where
+instance (IsAccountVersion av, MonadBlobStore m) => BlobStorable m (BlockRewardDetails' av bhv) where
     storeUpdate (BlockRewardDetailsV0 heb) = fmap (fmap BlockRewardDetailsV0) $ storeUpdate heb
     storeUpdate (BlockRewardDetailsV1 hpr) = fmap (fmap BlockRewardDetailsV1) $ storeUpdate hpr
     load = case delegationSupport @av of
         SAVDelegationNotSupported -> fmap (fmap BlockRewardDetailsV0) load
         SAVDelegationSupported -> fmap (fmap BlockRewardDetailsV1) load
 
-instance (MonadBlobStore m) => Cacheable m (BlockRewardDetails av) where
+instance (MonadBlobStore m, IsBlockHashVersion bhv) => Cacheable m (BlockRewardDetails' av bhv) where
     cache (BlockRewardDetailsV0 heb) = BlockRewardDetailsV0 <$> cache heb
     cache (BlockRewardDetailsV1 hpr) = BlockRewardDetailsV1 <$> cache hpr
 
-putBlockRewardDetails :: (MonadBlobStore m, MonadPut m) => BlockRewardDetails av -> m ()
+putBlockRewardDetails ::
+    (MonadBlobStore m, MonadPut m, IsBlockHashVersion bhv) =>
+    BlockRewardDetails' av bhv ->
+    m ()
 putBlockRewardDetails (BlockRewardDetailsV0 heb) = putHashedEpochBlocksV0 heb
 putBlockRewardDetails (BlockRewardDetailsV1 hpr) = refLoad hpr >>= putPoolRewards
 
@@ -639,16 +649,16 @@ putBlockRewardDetails (BlockRewardDetailsV1 hpr) = refLoad hpr >>= putPoolReward
 consBlockRewardDetails ::
     (MonadBlobStore m) =>
     BakerId ->
-    BlockRewardDetails 'AccountV0 ->
-    m (BlockRewardDetails 'AccountV0)
+    BlockRewardDetails' 'AccountV0 bhv ->
+    m (BlockRewardDetails' 'AccountV0 bhv)
 consBlockRewardDetails bid (BlockRewardDetailsV0 heb) = do
     BlockRewardDetailsV0 <$> consEpochBlock bid heb
 
 -- | The empty 'BlockRewardDetails'.
 emptyBlockRewardDetails ::
-    forall av m.
-    (MonadBlobStore m, IsAccountVersion av) =>
-    m (BlockRewardDetails av)
+    forall av bhv m.
+    (MonadBlobStore m, IsAccountVersion av, IsBlockHashVersion bhv) =>
+    m (BlockRewardDetails' av bhv)
 emptyBlockRewardDetails =
     case delegationSupport @av of
         SAVDelegationNotSupported -> return $ BlockRewardDetailsV0 emptyHashedEpochBlocks
@@ -689,21 +699,36 @@ emptyMerkleTransactionOutcomes =
 --  the hashing scheme is not a hash list but a merkle tree, so it is the root hash that is
 --  used in the final 'BlockHash'.
 data PersistentTransactionOutcomes (tov :: TransactionOutcomesVersion) where
-    PTOV0 :: Transactions.TransactionOutcomes -> PersistentTransactionOutcomes 'TOV0
+    PTOV0 :: TransactionOutcomes.TransactionOutcomes -> PersistentTransactionOutcomes 'TOV0
     PTOV1 :: MerkleTransactionOutcomes -> PersistentTransactionOutcomes 'TOV1
+    PTOV2 :: MerkleTransactionOutcomes -> PersistentTransactionOutcomes 'TOV2
 
 -- | Create an empty persistent transaction outcome
 emptyPersistentTransactionOutcomes :: forall tov. (IsTransactionOutcomesVersion tov) => PersistentTransactionOutcomes tov
 emptyPersistentTransactionOutcomes = case transactionOutcomesVersion @tov of
-    STOV0 -> PTOV0 Transactions.emptyTransactionOutcomesV0
+    STOV0 -> PTOV0 TransactionOutcomes.emptyTransactionOutcomesV0
     STOV1 -> PTOV1 emptyMerkleTransactionOutcomes
+    STOV2 -> PTOV2 emptyMerkleTransactionOutcomes
 
-instance (BlobStorable m TransactionSummaryV1) => MHashableTo m Transactions.TransactionOutcomesHash (PersistentTransactionOutcomes tov) where
+instance
+    (BlobStorable m TransactionSummaryV1) =>
+    MHashableTo m (TransactionOutcomes.TransactionOutcomesHashV tov) (PersistentTransactionOutcomes tov)
+    where
     getHashM (PTOV0 bto) = return (getHash bto)
     getHashM (PTOV1 MerkleTransactionOutcomes{..}) = do
-        out <- getHashM mtoOutcomes
-        special <- getHashM mtoSpecials
-        return $! Transactions.TransactionOutcomesHash (H.hashShort ("TransactionOutcomesHashV1" <> H.hashToShortByteString out <> H.hashToShortByteString special))
+        out <- getHashM @_ @(LFMBT.LFMBTreeHash' 'BlockHashVersion0) mtoOutcomes
+        special <- getHashM @_ @(LFMBT.LFMBTreeHash' 'BlockHashVersion0) mtoSpecials
+        return $!
+            TransactionOutcomes.TransactionOutcomesHashV . H.hashLazy . runPutLazy $ do
+                putShortByteString "TransactionOutcomesHashV1"
+                put out
+                put special
+    getHashM (PTOV2 MerkleTransactionOutcomes{..}) = do
+        out <- getHashM @_ @(LFMBT.LFMBTreeHash' 'BlockHashVersion1) mtoOutcomes
+        special <- getHashM @_ @(LFMBT.LFMBTreeHash' 'BlockHashVersion1) mtoSpecials
+        return $!
+            TransactionOutcomes.TransactionOutcomesHashV $
+                H.hashOfHashes (LFMBT.theLFMBTreeHash out) (LFMBT.theLFMBTreeHash special)
 
 instance
     ( TransactionOutcomesVersionFor (MPV m) ~ tov,
@@ -712,16 +737,20 @@ instance
     ) =>
     BlobStorable m (PersistentTransactionOutcomes tov)
     where
-    storeUpdate out@(PTOV0 bto) = return (Transactions.putTransactionOutcomes bto, out)
-    storeUpdate (PTOV1 MerkleTransactionOutcomes{..}) = do
-        (pout, mtoOutcomes') <- storeUpdate mtoOutcomes
-        (pspecial, mtoSpecials') <- storeUpdate mtoSpecials
-        return (pout <> pspecial, PTOV1 MerkleTransactionOutcomes{mtoOutcomes = mtoOutcomes', mtoSpecials = mtoSpecials'})
+    storeUpdate out@(PTOV0 bto) = return (TransactionOutcomes.putTransactionOutcomes bto, out)
+    storeUpdate out = case out of
+        PTOV1 mto -> (_2 %~ PTOV1) <$> inner mto
+        PTOV2 mto -> (_2 %~ PTOV2) <$> inner mto
+      where
+        inner MerkleTransactionOutcomes{..} = do
+            (pout, mtoOutcomes') <- storeUpdate mtoOutcomes
+            (pspecial, mtoSpecials') <- storeUpdate mtoSpecials
+            return (pout <> pspecial, MerkleTransactionOutcomes{mtoOutcomes = mtoOutcomes', mtoSpecials = mtoSpecials'})
 
     load = do
         case transactionOutcomesVersion @(TransactionOutcomesVersionFor (MPV m)) of
             STOV0 -> do
-                out <- PTOV0 <$!> Transactions.getTransactionOutcomes (protocolVersion @(MPV m))
+                out <- PTOV0 <$!> TransactionOutcomes.getTransactionOutcomes (protocolVersion @(MPV m))
                 pure . pure $! out
             STOV1 -> do
                 mout <- load
@@ -730,6 +759,13 @@ instance
                     mtoOutcomes <- mout
                     mtoSpecials <- mspecials
                     return $! PTOV1 MerkleTransactionOutcomes{..}
+            STOV2 -> do
+                mout <- load
+                mspecials <- load
+                return $! do
+                    mtoOutcomes <- mout
+                    mtoSpecials <- mspecials
+                    return $! PTOV2 MerkleTransactionOutcomes{..}
 
 -- | Create an empty 'PersistentTransactionOutcomes' based on the 'ProtocolVersion'.
 emptyTransactionOutcomes ::
@@ -738,8 +774,9 @@ emptyTransactionOutcomes ::
     Proxy pv ->
     PersistentTransactionOutcomes (TransactionOutcomesVersionFor pv)
 emptyTransactionOutcomes Proxy = case transactionOutcomesVersion @(TransactionOutcomesVersionFor pv) of
-    STOV0 -> PTOV0 Transactions.emptyTransactionOutcomesV0
+    STOV0 -> PTOV0 TransactionOutcomes.emptyTransactionOutcomesV0
     STOV1 -> PTOV1 emptyMerkleTransactionOutcomes
+    STOV2 -> PTOV2 emptyMerkleTransactionOutcomes
 
 -- | References to the components that make up the block state.
 --
@@ -751,7 +788,7 @@ emptyTransactionOutcomes Proxy = case transactionOutcomesVersion @(TransactionOu
 data BlockStatePointers (pv :: ProtocolVersion) = BlockStatePointers
     { bspAccounts :: !(Accounts.Accounts pv),
       bspInstances :: !(Instances.Instances pv),
-      bspModules :: !(HashedBufferedRef Modules.Modules),
+      bspModules :: !(HashedBufferedRef' (ModulesHash pv) Modules.Modules),
       bspBank :: !(Hashed Rewards.BankStatus),
       bspIdentityProviders :: !(HashedBufferedRef IPS.IdentityProviders),
       bspAnonymityRevokers :: !(HashedBufferedRef ARS.AnonymityRevokers),
@@ -762,7 +799,7 @@ data BlockStatePointers (pv :: ProtocolVersion) = BlockStatePointers
       bspTransactionOutcomes :: !(PersistentTransactionOutcomes (TransactionOutcomesVersionFor pv)),
       -- | Details of bakers that baked blocks in the current epoch. This is
       --  used for rewarding bakers at the end of epochs.
-      bspRewardDetails :: !(BlockRewardDetails (AccountVersionFor pv))
+      bspRewardDetails :: !(BlockRewardDetails pv)
     }
 
 -- | Lens for accessing the birk parameters of a 'BlockStatePointers' structure.
@@ -877,13 +914,17 @@ instance (SupportsPersistentState pv m) => BlobStorable m (BlockStatePointers pv
             return $! BlockStatePointers{..}
 
 -- | Accessor for getting the pool rewards when supported by the protocol version.
-bspPoolRewards :: (PVSupportsDelegation pv) => BlockStatePointers pv -> HashedBufferedRef' Rewards.PoolRewardsHash PoolRewards
+bspPoolRewards ::
+    (PVSupportsDelegation pv, bhv ~ BlockHashVersionFor pv) =>
+    BlockStatePointers pv ->
+    HashedBufferedRef' (Rewards.PoolRewardsHash bhv) (PoolRewards bhv)
 bspPoolRewards bsp = case bspRewardDetails bsp of
     BlockRewardDetailsV1 pr -> pr
 
 -- | An initial 'HashedPersistentBlockState', which may be used for testing purposes.
 {-# WARNING initialPersistentState "should only be used for testing" #-}
 initialPersistentState ::
+    forall pv m.
     (SupportsPersistentState pv m) =>
     SeedState (SeedStateVersionFor pv) ->
     CryptographicParameters ->
@@ -2709,24 +2750,41 @@ doGetTransactionOutcome pbs transHash = do
     bsp <- loadPBS pbs
     case bspTransactionOutcomes bsp of
         PTOV0 bto -> return $! bto ^? ix transHash
-        PTOV1 bto -> do
-            fmap _transactionSummaryV1 <$> LFMBT.lookup transHash (mtoOutcomes bto)
+        PTOV1 bto -> fmap _transactionSummaryV1 <$> LFMBT.lookup transHash (mtoOutcomes bto)
+        PTOV2 bto -> fmap _transactionSummaryV1 <$> LFMBT.lookup transHash (mtoOutcomes bto)
 
-doGetTransactionOutcomesHash :: forall pv m. (SupportsPersistentState pv m) => PersistentBlockState pv -> m Transactions.TransactionOutcomesHash
+doGetTransactionOutcomesHash ::
+    forall pv m.
+    (SupportsPersistentState pv m) =>
+    PersistentBlockState pv ->
+    m TransactionOutcomes.TransactionOutcomesHash
 doGetTransactionOutcomesHash pbs = do
     bsp <- loadPBS pbs
-    getHashM (bspTransactionOutcomes bsp)
+    TransactionOutcomes.toTransactionOutcomesHash @(TransactionOutcomesVersionFor pv)
+        <$> getHashM (bspTransactionOutcomes bsp)
 
 doSetTransactionOutcomes :: forall pv m. (SupportsPersistentState pv m) => PersistentBlockState pv -> [TransactionSummary] -> m (PersistentBlockState pv)
 doSetTransactionOutcomes pbs transList = do
     bsp <- loadPBS pbs
     case bspTransactionOutcomes bsp of
         PTOV0 _ ->
-            storePBS pbs bsp{bspTransactionOutcomes = PTOV0 (Transactions.transactionOutcomesV0FromList transList)}
+            storePBS
+                pbs
+                bsp
+                    { bspTransactionOutcomes =
+                        PTOV0 (TransactionOutcomes.transactionOutcomesV0FromList transList)
+                    }
         PTOV1 _ -> do
-            mtoOutcomes <- LFMBT.fromAscList . map TransactionSummaryV1 $ transList
-            let mtoSpecials = LFMBT.empty
-            storePBS pbs bsp{bspTransactionOutcomes = PTOV1 MerkleTransactionOutcomes{..}}
+            mto <- makeMTO
+            storePBS pbs bsp{bspTransactionOutcomes = PTOV1 mto}
+        PTOV2 _ -> do
+            mto <- makeMTO
+            storePBS pbs bsp{bspTransactionOutcomes = PTOV2 mto}
+  where
+    makeMTO :: m MerkleTransactionOutcomes
+    makeMTO = do
+        mtoOutcomes <- LFMBT.fromAscList . map TransactionSummaryV1 $ transList
+        return MerkleTransactionOutcomes{mtoSpecials = LFMBT.empty, ..}
 
 doNotifyEncryptedBalanceChange :: (SupportsPersistentState pv m) => PersistentBlockState pv -> AmountDelta -> m (PersistentBlockState pv)
 doNotifyEncryptedBalanceChange pbs amntDiff = do
@@ -2737,25 +2795,34 @@ doGetSpecialOutcomes :: (SupportsPersistentState pv m, MonadProtocolVersion m) =
 doGetSpecialOutcomes pbs = do
     bsp <- loadPBS pbs
     case bspTransactionOutcomes bsp of
-        PTOV0 bto -> return (bto ^. Transactions.outcomeSpecial)
+        PTOV0 bto -> return (bto ^. TransactionOutcomes.outcomeSpecial)
         PTOV1 bto -> Seq.fromList <$> LFMBT.toAscList (mtoSpecials bto)
+        PTOV2 bto -> Seq.fromList <$> LFMBT.toAscList (mtoSpecials bto)
 
 doGetOutcomes :: (SupportsPersistentState pv m, MonadProtocolVersion m) => PersistentBlockState pv -> m (Vec.Vector TransactionSummary)
 doGetOutcomes pbs = do
     bsp <- loadPBS pbs
     case bspTransactionOutcomes bsp of
-        PTOV0 bto -> return (Transactions.outcomeValues bto)
+        PTOV0 bto -> return (TransactionOutcomes.outcomeValues bto)
         PTOV1 bto -> Vec.fromList . map _transactionSummaryV1 <$> LFMBT.toAscList (mtoOutcomes bto)
+        PTOV2 bto -> Vec.fromList . map _transactionSummaryV1 <$> LFMBT.toAscList (mtoOutcomes bto)
 
 doAddSpecialTransactionOutcome :: (SupportsPersistentState pv m, MonadProtocolVersion m) => PersistentBlockState pv -> Transactions.SpecialTransactionOutcome -> m (PersistentBlockState pv)
 doAddSpecialTransactionOutcome pbs !o = do
     bsp <- loadPBS pbs
     case bspTransactionOutcomes bsp of
         PTOV0 bto ->
-            storePBS pbs $! bsp{bspTransactionOutcomes = PTOV0 (bto & Transactions.outcomeSpecial %~ (Seq.|> o))}
+            storePBS pbs $!
+                bsp
+                    { bspTransactionOutcomes =
+                        PTOV0 (bto & TransactionOutcomes.outcomeSpecial %~ (Seq.|> o))
+                    }
         PTOV1 bto -> do
             (_, newSpecials) <- LFMBT.append o (mtoSpecials bto)
             storePBS pbs $! bsp{bspTransactionOutcomes = PTOV1 (bto{mtoSpecials = newSpecials})}
+        PTOV2 bto -> do
+            (_, newSpecials) <- LFMBT.append o (mtoSpecials bto)
+            storePBS pbs $! bsp{bspTransactionOutcomes = PTOV2 (bto{mtoSpecials = newSpecials})}
 
 doGetElectionDifficulty ::
     ( SupportsPersistentState pv m,
@@ -3005,7 +3072,7 @@ doMarkFinalizationAwakeBakers pbs bids = do
     bpc <- bakerPoolCapital <$> refLoad (currentCapital pr)
     newBPRs <- foldM (markFinalizerAwake bpc) bprs bids
     newBlockRewardDetails <- BlockRewardDetailsV1 <$> refMake pr{bakerPoolRewardDetails = newBPRs}
-    newHash :: (Rewards.BlockRewardDetailsHash (AccountVersionFor pv)) <-
+    newHash :: (Rewards.BlockRewardDetailsHash pv) <-
         getHashM newBlockRewardDetails
     oldHash <- getHashM (bspRewardDetails bsp)
     if newHash == oldHash
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Modules.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Modules.hs
index b2812d6846..21adcb1ad0 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Modules.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/BlockState/Modules.hs
@@ -17,6 +17,7 @@ module Concordium.GlobalState.Persistent.BlockState.Modules (
     SupportsPersistentModule,
     getModuleInterface,
     PersistentInstrumentedModuleV,
+    makePersistentInstrumentedModuleV,
     loadInstrumentedModuleV,
     emptyModules,
     getInterface,
@@ -33,6 +34,7 @@ module Concordium.GlobalState.Persistent.BlockState.Modules (
 ) where
 
 import Concordium.Crypto.SHA256
+import Concordium.GlobalState.BlockState (ModulesHash (..))
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.Cache
 import Concordium.GlobalState.Persistent.CachedRef
@@ -74,6 +76,11 @@ data PersistentInstrumentedModuleV (v :: WasmVersion)
       PIMVPtr !(BlobPtr (GSWasm.InstrumentedModuleV v))
     deriving (Show)
 
+-- | Make a 'PersistentInstrumentedModuleV' from a 'GSWasm.InstrumentedModuleV', retaining it in
+-- memory only.
+makePersistentInstrumentedModuleV :: GSWasm.InstrumentedModuleV v -> PersistentInstrumentedModuleV v
+makePersistentInstrumentedModuleV = PIMVMem
+
 -- | Load a 'PersistentInstrumentedModuleV', retrieving the artifact.
 --  If the artifact has been persisted to the blob store, the artifact will wrap a pointer into
 --  the memory-mapped blob store.
@@ -282,8 +289,11 @@ data Modules = Modules
 makeLenses ''Modules
 
 -- | The hash of the collection of modules is the hash of the tree.
-instance (SupportsPersistentModule m) => MHashableTo m Hash Modules where
-    getHashM = getHashM . _modulesTable
+instance (SupportsPersistentModule m, IsBlockHashVersion (BlockHashVersionFor pv)) => MHashableTo m (ModulesHash pv) Modules where
+    getHashM =
+        fmap (ModulesHash . LFMB.theLFMBTreeHash @(BlockHashVersionFor pv))
+            . getHashM
+            . _modulesTable
 
 instance (SupportsPersistentModule m) => BlobStorable m Modules where
     load = do
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
index 469e545d16..6139f2861c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Genesis.hs
@@ -18,7 +18,6 @@ import qualified Concordium.Genesis.Data.P4 as P4
 import qualified Concordium.Genesis.Data.P5 as P5
 import qualified Concordium.Genesis.Data.P6 as P6
 import qualified Concordium.Genesis.Data.P7 as P7
-import qualified Concordium.GlobalState.Basic.BlockState.PoolRewards as Basic
 import qualified Concordium.GlobalState.CapitalDistribution as CapDist
 import qualified Concordium.GlobalState.Persistent.Account as Account
 import qualified Concordium.GlobalState.Persistent.Accounts as Accounts
@@ -32,6 +31,7 @@ import qualified Concordium.GlobalState.Persistent.LFMBTree as LFMBT
 import qualified Concordium.GlobalState.Persistent.PoolRewards as Rewards
 import qualified Concordium.GlobalState.Persistent.ReleaseSchedule as ReleaseSchedule
 import qualified Concordium.GlobalState.Persistent.Trie as Trie
+import qualified Concordium.GlobalState.PoolRewards as PoolRewards
 import qualified Concordium.GlobalState.Rewards as Rewards
 import qualified Concordium.GlobalState.TransactionTable as TransactionTable
 import qualified Concordium.ID.Types as Types
@@ -188,7 +188,7 @@ buildGenesisBlockState vcgp GenesisData.GenesisState{..} = do
         Types.SAVDelegationSupported ->
             case Types.delegationChainParameters @pv of
                 Types.DelegationChainParameters -> do
-                    capRef :: Blob.HashedBufferedRef CapDist.CapitalDistribution <-
+                    capRef :: Blob.HashedBufferedRef' (CapDist.CapitalDistributionHash pv) CapDist.CapitalDistribution <-
                         Blob.refMakeFlushed
                             CapDist.CapitalDistribution
                                 { bakerPoolCapital = agsBakerCapitals,
@@ -196,7 +196,7 @@ buildGenesisBlockState vcgp GenesisData.GenesisState{..} = do
                                 }
                     bakerPoolRewardDetails <-
                         LFMBT.fromAscList $
-                            replicate (Vec.length agsBakerCapitals) Basic.emptyBakerPoolRewardDetails
+                            replicate (Vec.length agsBakerCapitals) PoolRewards.emptyBakerPoolRewardDetails
                     BS.BlockRewardDetailsV1
                         <$> Blob.refMakeFlushed
                             Rewards.PoolRewards
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/Instances.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/Instances.hs
index aa9544cd3c..249685b88f 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/Instances.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/Instances.hs
@@ -29,7 +29,11 @@ import Concordium.Utils.Serialization (putByteStringLen)
 import Concordium.Utils.Serialization.Put
 import qualified Concordium.Wasm as Wasm
 
-import Concordium.GlobalState.BlockState (InstanceInfoType (..), InstanceInfoTypeV (..))
+import Concordium.GlobalState.BlockState (
+    InstanceInfoType (..),
+    InstanceInfoTypeV (..),
+    InstancesHash (..),
+ )
 import qualified Concordium.GlobalState.ContractStateV1 as StateV1
 import qualified Concordium.GlobalState.Instance as Instance
 import Concordium.GlobalState.Persistent.BlobStore
@@ -74,6 +78,7 @@ data PersistentInstanceParameters = PersistentInstanceParameters
       -- | Hash of the fixed parameters
       pinstanceParameterHash :: !H.Hash
     }
+    deriving (Eq)
 
 instance Show PersistentInstanceParameters where
     show PersistentInstanceParameters{..} = show pinstanceAddress ++ " :: " ++ show pinstanceContractModule ++ "." ++ show pinstanceInitName
@@ -549,12 +554,12 @@ newContractInstanceIT mk t0 = (\(res, v) -> (res,) <$> membed v) =<< nci 0 t0 =<
     nci offset _ (Branch h f True _ l r) = do
         projl <- mproject l
         projr <- mproject r
-        if branchHasVacancies projl
+        if hasVacancies projl
             then do
                 (res, projl') <- nci offset l projl
                 l' <- membed projl'
                 return (res, makeBranch h f projl' projr l' r)
-            else assert (branchHasVacancies projr) $ do
+            else assert (hasVacancies projr) $ do
                 (res, projr') <- nci (setBit offset (fromIntegral h)) r projr
                 r' <- membed projr'
                 return (res, makeBranch h f projl projr' l r')
@@ -610,7 +615,7 @@ migrateIT modules (BufferedFix bf) = BufferedFix <$> migrateReference go bf
 data Instances pv
     = -- | The empty instance table
       InstancesEmpty
-    | -- | A non-empty instance table (recording the size)
+    | -- | A non-empty instance table, recording the number of leaf nodes, including vacancies
       InstancesTree !Word64 !(BufferedFix (IT pv))
 
 migrateInstances ::
@@ -632,9 +637,23 @@ instance Show (Instances pv) where
     show InstancesEmpty = "Empty"
     show (InstancesTree _ t) = showFix showITString t
 
-instance (IsProtocolVersion pv, SupportsPersistentModule m) => MHashableTo m H.Hash (Instances pv) where
-    getHashM InstancesEmpty = return $ H.hash "EmptyInstances"
-    getHashM (InstancesTree _ t) = getHash <$> mproject t
+-- | Compute an @'InstancesHash' pv@ given the size and root hash of the instances table.
+--  The behaviour is dependent on the block hashing version associated with the protocol version,
+--  namely @BlockHashVersionFor pv@. For @BlockHashVersion0@, only the root hash is used.
+--  for @BlockHashVersion1@, the size is concatenated with the root hash and then hashed.
+makeInstancesHash :: forall pv. (IsProtocolVersion pv) => Word64 -> H.Hash -> InstancesHash pv
+makeInstancesHash size inner = case sBlockHashVersionFor (protocolVersion @pv) of
+    SBlockHashVersion0 -> InstancesHash inner
+    SBlockHashVersion1 -> InstancesHash . H.hashLazy . runPutLazy $ do
+        putWord64be size
+        put inner
+
+instance
+    (IsProtocolVersion pv, SupportsPersistentModule m) =>
+    MHashableTo m (InstancesHash pv) (Instances pv)
+    where
+    getHashM InstancesEmpty = return $ makeInstancesHash 0 $ H.hash "EmptyInstances"
+    getHashM (InstancesTree size t) = makeInstancesHash size . getHash <$> mproject t
 
 instance (IsProtocolVersion pv, SupportsPersistentModule m) => BlobStorable m (Instances pv) where
     storeUpdate i@InstancesEmpty = return (putWord8 0, i)
@@ -665,15 +684,25 @@ emptyInstances :: Instances pv
 emptyInstances = InstancesEmpty
 
 newContractInstance :: forall m pv a. (IsProtocolVersion pv, SupportsPersistentModule m) => (ContractAddress -> m (a, PersistentInstance pv)) -> Instances pv -> m (a, Instances pv)
-newContractInstance fnew InstancesEmpty = do
+newContractInstance createInstanceFn InstancesEmpty = do
     let ca = ContractAddress 0 0
-    (res, newInst) <- fnew ca
+    (res, newInst) <- createInstanceFn ca
     (res,) . InstancesTree 1 <$> membed (Leaf newInst)
-newContractInstance fnew (InstancesTree s it) = (\(res, it') -> (res, InstancesTree (s + 1) it')) <$> newContractInstanceIT fnew it
+newContractInstance createInstanceFn (InstancesTree size tree) = do
+    ((isFreshIndex, !result), !nextTree) <- newContractInstanceIT createFnWithFreshness tree
+    let !nextSize = if isFreshIndex then size + 1 else size
+        nextInstancesTree = InstancesTree nextSize nextTree
+    return (result, nextInstancesTree)
+  where
+    createFnWithFreshness newContractAddress = do
+        (result, createdInstance) <- createInstanceFn newContractAddress
+        -- The size of the tree grows exactly when the new subindex is 0.
+        -- Otherwise, a vacancy is filled, and the size does not grow.
+        return ((contractSubindex newContractAddress == 0, result), createdInstance)
 
 deleteContractInstance :: forall m pv. (IsProtocolVersion pv, SupportsPersistentModule m) => ContractAddress -> Instances pv -> m (Instances pv)
 deleteContractInstance _ InstancesEmpty = return InstancesEmpty
-deleteContractInstance addr t0@(InstancesTree s it0) = dci (fmap (InstancesTree (s - 1)) . membed) (contractIndex addr) =<< mproject it0
+deleteContractInstance addr t0@(InstancesTree s it0) = dci (fmap (InstancesTree s) . membed) (contractIndex addr) =<< mproject it0
   where
     dci succCont i (Leaf inst)
         | i == 0 = do
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs
index 882a0e2ca0..b619659265 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/LFMBTree.hs
@@ -1,8 +1,10 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 {-# LANGUAGE UndecidableInstances #-}
 
@@ -12,6 +14,12 @@
 --
 --    An implementation of a Left-full Merkle Binary Tree.
 module Concordium.GlobalState.Persistent.LFMBTree (
+    -- * Hash types
+    LFMBTreeHash' (..),
+    LFMBTreeHash,
+    LFMBTreeHashV0,
+    LFMBTreeHashV1,
+
     -- * Tree type
     LFMBTree,
     LFMBTree',
@@ -57,8 +65,16 @@ module Concordium.GlobalState.Persistent.LFMBTree (
 where
 
 import qualified Concordium.Crypto.SHA256 as H
-import Concordium.GlobalState.Basic.BlockState.LFMBTree (setBits)
+import Concordium.GlobalState.Basic.BlockState.LFMBTree (
+    LFMBTreeHash,
+    LFMBTreeHash' (..),
+    LFMBTreeHashV0,
+    LFMBTreeHashV1,
+    emptyTreeHashV0,
+    setBits,
+ )
 import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.Types
 import Concordium.Types.HashableTo
 import Control.Monad
 import Control.Monad.Trans
@@ -66,6 +82,7 @@ import Data.Bits
 import Data.Coerce (Coercible, coerce)
 import Data.Kind
 import Data.Serialize
+import Data.Singletons
 import Data.Word
 import Prelude hiding (lookup)
 
@@ -133,16 +150,38 @@ instance
         hr <- getHashM r
         return $ H.hashOfHashes hl hr
 
--- | The hash of a LFMBTree is defined as the hash of the string "EmptyLFMBTree" if it
--- is empty or the hash of the tree otherwise.
+-- | Compute the version 0 hash of an LFMBTree.
+toHashV0 ::
+    (MHashableTo m H.Hash v, MHashableTo m H.Hash (ref (T ref v))) =>
+    LFMBTree' k ref v ->
+    m LFMBTreeHashV0
+toHashV0 Empty = return emptyTreeHashV0
+toHashV0 (NonEmpty _ v) = LFMBTreeHash <$> getHashM v
+
+-- | Compute the version 1 hash of an LFMBTree.
+toHashV1 ::
+    (MHashableTo m H.Hash v, MHashableTo m H.Hash (ref (T ref v))) =>
+    LFMBTree' k ref v ->
+    m LFMBTreeHashV1
+toHashV1 t = do
+    preHash <- toHashV0 t
+    let sz = case t of
+            Empty -> 0
+            NonEmpty s _ -> s
+    return $ LFMBTreeHash $ H.hashLazy $ runPutLazy $ do
+        putWord64be sz
+        put preHash
+
 instance
     ( MHashableTo m H.Hash v, -- values must be hashable
-      MHashableTo m H.Hash (ref (T ref v)) -- references to nodes must be hashable
+      MHashableTo m H.Hash (ref (T ref v)), -- references to nodes must be hashable
+      IsBlockHashVersion bhv
     ) =>
-    MHashableTo m H.Hash (LFMBTree' k ref v)
+    MHashableTo m (LFMBTreeHash' bhv) (LFMBTree' k ref v)
     where
-    getHashM Empty = return $ H.hash "EmptyLFMBTree"
-    getHashM (NonEmpty _ v) = getHashM v
+    getHashM = case sing @bhv of
+        SBlockHashVersion0 -> toHashV0
+        SBlockHashVersion1 -> toHashV1
 
 -- | Constraints that ensures a monad @m@ can store an LFMBTree (that holds references
 -- of type @ref@ to values of type @v@) in references of type @ref@.
diff --git a/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs b/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs
index d5d44d19f4..53520bcab7 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Persistent/PoolRewards.hs
@@ -1,11 +1,14 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
 
 module Concordium.GlobalState.Persistent.PoolRewards (
-    module Concordium.GlobalState.Basic.BlockState.PoolRewards,
+    BakerPoolRewardDetails (..),
+    CapitalDistributionRef,
     PoolRewards (..),
     emptyPoolRewards,
-    makerPersistentPoolRewards,
     putPoolRewards,
     bakerBlockCounts,
     rotateCapitalDistribution,
@@ -27,31 +30,27 @@ import Concordium.Crypto.SHA256 as Hash
 import Concordium.Types
 import Concordium.Types.HashableTo
 import Concordium.Utils.BinarySearch
+import Concordium.Utils.Serialization.Put (MonadPut (..))
 
-import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as BasicLFMBT
-import Concordium.GlobalState.Rewards
-
-import Concordium.GlobalState.Basic.BlockState.PoolRewards (
-    BakerPoolRewardDetails (..),
- )
-import qualified Concordium.GlobalState.Basic.BlockState.PoolRewards as BasicPoolRewards
 import Concordium.GlobalState.CapitalDistribution
-
 import Concordium.GlobalState.Persistent.BlobStore
 import qualified Concordium.GlobalState.Persistent.LFMBTree as LFMBT
+import Concordium.GlobalState.PoolRewards
+import Concordium.GlobalState.Rewards
 
-import Concordium.Utils.Serialization.Put
+type CapitalDistributionRef (bhv :: BlockHashVersion) =
+    HashedBufferedRef' (CapitalDistributionHash' bhv) CapitalDistribution
 
 -- | Details of rewards accruing over the course of a reward period, and details about the capital
 --  distribution for this reward period and (possibly) the next. Note, 'currentCapital' and
 --  'nextCapital' are the same except in the epoch before a payday, where 'nextCapital' is updated
 --  to record the capital distribution for the next reward period.
-data PoolRewards = PoolRewards
+data PoolRewards (bhv :: BlockHashVersion) = PoolRewards
     { -- | The capital distribution for the next reward period.
       --  This is updated the epoch before a payday.
-      nextCapital :: !(HashedBufferedRef CapitalDistribution),
+      nextCapital :: !(CapitalDistributionRef bhv),
       -- | The capital distribution for the current reward period.
-      currentCapital :: !(HashedBufferedRef CapitalDistribution),
+      currentCapital :: !(CapitalDistributionRef bhv),
       -- | The details of rewards accruing to baker pools.
       --  These are indexed by the index of the baker in the capital distribution (_not_ the BakerId).
       bakerPoolRewardDetails :: !(LFMBT.LFMBTree Word64 BufferedRef BakerPoolRewardDetails),
@@ -68,15 +67,15 @@ data PoolRewards = PoolRewards
 
 -- | Migrate pool rewards from @m@ to the new backing store @t m@.
 --  This takes the new next payday epoch as a parameter, since this should always be updated on
---  a protocol update.
+--  a protocol update. The hashes for the
 migratePoolRewards ::
-    (SupportMigration m t) =>
+    (SupportMigration m t, IsBlockHashVersion bhv1) =>
     Epoch ->
-    PoolRewards ->
-    t m PoolRewards
+    PoolRewards bhv0 ->
+    t m (PoolRewards bhv1)
 migratePoolRewards newNextPayday PoolRewards{..} = do
-    nextCapital' <- migrateHashedBufferedRefKeepHash nextCapital
-    currentCapital' <- migrateHashedBufferedRefKeepHash currentCapital
+    nextCapital' <- migrateHashedBufferedRef return nextCapital
+    currentCapital' <- migrateHashedBufferedRef return currentCapital
     bakerPoolRewardDetails' <- LFMBT.migrateLFMBTree (migrateReference return) bakerPoolRewardDetails
     return
         PoolRewards
@@ -91,8 +90,8 @@ migratePoolRewards newNextPayday PoolRewards{..} = do
 
 -- | Migrate pool rewards from the format before delegation to the P4 format.
 migratePoolRewardsP1 ::
-    forall m.
-    (MonadBlobStore m) =>
+    forall m bhv.
+    (MonadBlobStore m, IsBlockHashVersion bhv) =>
     -- | Current epoch bakers and stakes, in ascending order of 'BakerId'.
     [(BakerId, Amount)] ->
     -- | Next epoch bakers and stakes, in ascending order of 'BakerId'.
@@ -103,7 +102,7 @@ migratePoolRewardsP1 ::
     Epoch ->
     -- | Mint rate for the next payday
     MintRate ->
-    m PoolRewards
+    m (PoolRewards bhv)
 migratePoolRewardsP1 curBakers nextBakers blockCounts npEpoch npMintRate = do
     (nextCapital, _) <- refFlush =<< bufferHashed (makeCD nextBakers)
     (currentCapital, _) <- refFlush =<< bufferHashed (makeCD curBakers)
@@ -135,9 +134,9 @@ migratePoolRewardsP1 curBakers nextBakers blockCounts npEpoch npMintRate = do
 
 -- | Look up the baker capital and reward details for a baker ID.
 lookupBakerCapitalAndRewardDetails ::
-    (MonadBlobStore m) =>
+    (MonadBlobStore m, IsBlockHashVersion bhv) =>
     BakerId ->
-    PoolRewards ->
+    PoolRewards bhv ->
     m (Maybe (BakerCapital, BakerPoolRewardDetails))
 lookupBakerCapitalAndRewardDetails bid PoolRewards{..} = do
     cdistr <- refLoad currentCapital
@@ -146,7 +145,7 @@ lookupBakerCapitalAndRewardDetails bid PoolRewards{..} = do
         Just (index, capital) ->
             fmap (capital,) <$> LFMBT.lookup (fromIntegral index) bakerPoolRewardDetails
 
-instance (MonadBlobStore m) => BlobStorable m PoolRewards where
+instance (MonadBlobStore m) => BlobStorable m (PoolRewards bhv) where
     storeUpdate pr0 = do
         (pNextCapital, nextCapital) <- storeUpdate (nextCapital pr0)
         (pCurrentCapital, currentCapital) <- storeUpdate (currentCapital pr0)
@@ -188,7 +187,7 @@ instance (MonadBlobStore m) => BlobStorable m PoolRewards where
 -- | Serialize 'PoolRewards'.
 --  The 'bakerPoolRewardDetails' is serialized as a flat list, with the length implied by the
 --  length of 'bakerPoolCapital' of 'currentCapital'.
-putPoolRewards :: (MonadBlobStore m, MonadPut m) => PoolRewards -> m ()
+putPoolRewards :: (MonadBlobStore m, MonadPut m, IsBlockHashVersion bhv) => PoolRewards bhv -> m ()
 putPoolRewards PoolRewards{..} = do
     nxtCapital <- refLoad nextCapital
     curCapital <- refLoad currentCapital
@@ -203,15 +202,15 @@ putPoolRewards PoolRewards{..} = do
             put nextPaydayEpoch
             put nextPaydayMintRate
 
-instance (MonadBlobStore m) => MHashableTo m PoolRewardsHash PoolRewards where
+instance (MonadBlobStore m, IsBlockHashVersion bhv) => MHashableTo m (PoolRewardsHash bhv) (PoolRewards bhv) where
     getHashM PoolRewards{..} = do
         hNextCapital <- getHashM nextCapital
         hCurrentCapital <- getHashM currentCapital
         hBakerPoolRewardDetails <- getHashM bakerPoolRewardDetails
         return $!
-            PoolRewardsHash . Hash.hashOfHashes hNextCapital $
-                Hash.hashOfHashes hCurrentCapital $
-                    Hash.hashOfHashes hBakerPoolRewardDetails $
+            PoolRewardsHash . Hash.hashOfHashes (theCapitalDistributionHash @bhv hNextCapital) $
+                Hash.hashOfHashes (theCapitalDistributionHash @bhv hCurrentCapital) $
+                    Hash.hashOfHashes (LFMBT.theLFMBTreeHash @bhv hBakerPoolRewardDetails) $
                         getHash $
                             runPut $
                                 put passiveDelegationTransactionRewards
@@ -219,7 +218,7 @@ instance (MonadBlobStore m) => MHashableTo m PoolRewardsHash PoolRewards where
                                     <> put nextPaydayEpoch
                                     <> put nextPaydayMintRate
 
-instance (MonadBlobStore m) => Cacheable m PoolRewards where
+instance (MonadBlobStore m, IsBlockHashVersion bhv) => Cacheable m (PoolRewards bhv) where
     cache pr@PoolRewards{nextPaydayEpoch = nextPaydayEpoch, nextPaydayMintRate = nextPaydayMintRate} = do
         nextCapital <- cache (nextCapital pr)
         currentCapital <- cache (currentCapital pr)
@@ -228,28 +227,23 @@ instance (MonadBlobStore m) => Cacheable m PoolRewards where
         foundationTransactionRewards <- cache (foundationTransactionRewards pr)
         return PoolRewards{..}
 
-makerPersistentPoolRewards :: (MonadBlobStore m) => BasicPoolRewards.PoolRewards -> m PoolRewards
-makerPersistentPoolRewards bpr = do
-    nc <- refMake (_unhashed (BasicPoolRewards.nextCapital bpr))
-    cc <- refMake (_unhashed (BasicPoolRewards.currentCapital bpr))
-    bprd <- LFMBT.fromAscList $ BasicLFMBT.toAscList $ BasicPoolRewards.bakerPoolRewardDetails bpr
+-- | The empty 'PoolRewards'.
+emptyPoolRewards :: (MonadBlobStore m, IsBlockHashVersion bhv) => m (PoolRewards bhv)
+emptyPoolRewards = do
+    emptyCDRef <- refMake emptyCapitalDistribution
     return
         PoolRewards
-            { nextCapital = nc,
-              currentCapital = cc,
-              bakerPoolRewardDetails = bprd,
-              passiveDelegationTransactionRewards = BasicPoolRewards.passiveDelegationTransactionRewards bpr,
-              foundationTransactionRewards = BasicPoolRewards.foundationTransactionRewards bpr,
-              nextPaydayEpoch = BasicPoolRewards.nextPaydayEpoch bpr,
-              nextPaydayMintRate = BasicPoolRewards.nextPaydayMintRate bpr
+            { nextCapital = emptyCDRef,
+              currentCapital = emptyCDRef,
+              bakerPoolRewardDetails = LFMBT.empty,
+              passiveDelegationTransactionRewards = 0,
+              foundationTransactionRewards = 0,
+              nextPaydayEpoch = 0,
+              nextPaydayMintRate = MintRate 0 0
             }
 
--- | The empty 'PoolRewards'.
-emptyPoolRewards :: (MonadBlobStore m) => m PoolRewards
-emptyPoolRewards = makerPersistentPoolRewards BasicPoolRewards.emptyPoolRewards
-
 -- | List of baker and number of blocks baked by this baker in the reward period.
-bakerBlockCounts :: (MonadBlobStore m) => PoolRewards -> m [(BakerId, Word64)]
+bakerBlockCounts :: (MonadBlobStore m, IsBlockHashVersion bhv) => PoolRewards bhv -> m [(BakerId, Word64)]
 bakerBlockCounts PoolRewards{..} = do
     cc <- refLoad currentCapital
     rds <- LFMBT.toAscPairList bakerPoolRewardDetails
@@ -264,9 +258,9 @@ bakerBlockCounts PoolRewards{..} = do
 -- | Rotate the capital distribution, so that the current capital distribution is replaced by the
 --  next one, and set up empty pool rewards.
 rotateCapitalDistribution ::
-    (MonadBlobStore m, Reference m ref PoolRewards) =>
-    ref PoolRewards ->
-    m (ref PoolRewards)
+    (MonadBlobStore m, Reference m ref (PoolRewards bhv), IsBlockHashVersion bhv) =>
+    ref (PoolRewards bhv) ->
+    m (ref (PoolRewards bhv))
 rotateCapitalDistribution oldPoolRewards = do
     pr <- refLoad oldPoolRewards
     nextCap <- refLoad (nextCapital pr)
@@ -274,7 +268,7 @@ rotateCapitalDistribution oldPoolRewards = do
         LFMBT.fromAscList $
             replicate
                 (Vec.length (bakerPoolCapital nextCap))
-                BasicPoolRewards.emptyBakerPoolRewardDetails
+                emptyBakerPoolRewardDetails
     refMake $
         pr
             { currentCapital = nextCapital pr,
@@ -282,11 +276,11 @@ rotateCapitalDistribution oldPoolRewards = do
             }
 
 setNextCapitalDistribution ::
-    (MonadBlobStore m, Reference m ref PoolRewards) =>
+    (MonadBlobStore m, Reference m ref (PoolRewards bhv), IsBlockHashVersion bhv) =>
     [(BakerId, Amount, [(DelegatorId, Amount)])] ->
     [(DelegatorId, Amount)] ->
-    ref PoolRewards ->
-    m (ref PoolRewards)
+    ref (PoolRewards bhv) ->
+    m (ref (PoolRewards bhv))
 setNextCapitalDistribution bakers passive oldPoolRewards = do
     let bakerPoolCapital = Vec.fromList $ map mkBakCap bakers
     let passiveDelegatorsCapital = Vec.fromList $ map mkDelCap passive
@@ -302,8 +296,8 @@ setNextCapitalDistribution bakers passive oldPoolRewards = do
 
 -- | The total capital passively delegated in the current reward period capital distribution.
 currentPassiveDelegationCapital ::
-    (MonadBlobStore m) =>
-    PoolRewards ->
+    (MonadBlobStore m, IsBlockHashVersion bhv) =>
+    PoolRewards bhv ->
     m Amount
 currentPassiveDelegationCapital PoolRewards{..} =
     Vec.sum . fmap dcDelegatorCapital . passiveDelegatorsCapital <$> refLoad currentCapital
diff --git a/concordium-consensus/src/Concordium/GlobalState/PoolRewards.hs b/concordium-consensus/src/Concordium/GlobalState/PoolRewards.hs
new file mode 100644
index 0000000000..330fbe638b
--- /dev/null
+++ b/concordium-consensus/src/Concordium/GlobalState/PoolRewards.hs
@@ -0,0 +1,48 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Concordium.GlobalState.PoolRewards where
+
+import Data.Serialize
+import Data.Word
+
+import Concordium.Crypto.SHA256 as Hash
+import Concordium.Types
+import Concordium.Types.HashableTo
+import Concordium.Utils.Serialization
+
+-- | 'BakerPoolRewardDetails' tracks the rewards that have been earned by a baker pool in the current
+--  reward period. These are used to pay out the rewards at the payday.
+data BakerPoolRewardDetails = BakerPoolRewardDetails
+    { -- | The number of blocks baked by this baker in the reward period
+      blockCount :: !Word64,
+      -- | The total transaction fees accrued to this pool in the reward period
+      transactionFeesAccrued :: !Amount,
+      -- | Whether the pool contributed to a finalization proof in the reward period
+      finalizationAwake :: !Bool
+    }
+    deriving (Eq, Show)
+
+instance Serialize BakerPoolRewardDetails where
+    put BakerPoolRewardDetails{..} = do
+        putWord64be blockCount
+        put transactionFeesAccrued
+        putBool finalizationAwake
+
+    get = BakerPoolRewardDetails <$> getWord64be <*> get <*> getBool
+
+instance HashableTo Hash.Hash BakerPoolRewardDetails where
+    getHash = Hash.hash . encode
+
+instance (Monad m) => MHashableTo m Hash.Hash BakerPoolRewardDetails
+
+-- | Baker pool reward details with no rewards accrued to the baker.
+emptyBakerPoolRewardDetails :: BakerPoolRewardDetails
+emptyBakerPoolRewardDetails =
+    BakerPoolRewardDetails
+        { blockCount = 0,
+          transactionFeesAccrued = 0,
+          finalizationAwake = False
+        }
diff --git a/concordium-consensus/src/Concordium/GlobalState/Rewards.hs b/concordium-consensus/src/Concordium/GlobalState/Rewards.hs
index 40ecaffae7..9aca165ad6 100644
--- a/concordium-consensus/src/Concordium/GlobalState/Rewards.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/Rewards.hs
@@ -114,21 +114,24 @@ epochBlockHash bid h =
                 <> encode bid
                 <> H.hashToByteString (ebHash h)
 
-newtype PoolRewardsHash = PoolRewardsHash {prHash :: H.Hash}
+newtype PoolRewardsHash (bhv :: BlockHashVersion) = PoolRewardsHash {prHash :: H.Hash}
     deriving newtype (Eq, Ord, Show, Serialize)
 
 -- | Hash of block reward details.
-data BlockRewardDetailsHash (av :: AccountVersion) where
-    BlockRewardDetailsHashV0 :: !EpochBlocksHash -> BlockRewardDetailsHash 'AccountV0
+data BlockRewardDetailsHash' (av :: AccountVersion) (bhv :: BlockHashVersion) where
+    BlockRewardDetailsHashV0 :: !EpochBlocksHash -> BlockRewardDetailsHash' 'AccountV0 bhv
     BlockRewardDetailsHashV1 ::
         (AVSupportsDelegation av) =>
-        !PoolRewardsHash ->
-        BlockRewardDetailsHash av
+        !(PoolRewardsHash bhv) ->
+        BlockRewardDetailsHash' av bhv
 
-deriving instance Show (BlockRewardDetailsHash av)
-deriving instance Eq (BlockRewardDetailsHash av)
+deriving instance Show (BlockRewardDetailsHash' av bhv)
+deriving instance Eq (BlockRewardDetailsHash' av bhv)
+
+type BlockRewardDetailsHash (pv :: ProtocolVersion) =
+    BlockRewardDetailsHash' (AccountVersionFor pv) (BlockHashVersionFor pv)
 
 -- | SHA256 hash of 'BlockRewardDetailsHash'.
-brdHash :: BlockRewardDetailsHash av -> H.Hash
+brdHash :: BlockRewardDetailsHash' av bhv -> H.Hash
 brdHash (BlockRewardDetailsHashV0 eb) = ebHash eb
 brdHash (BlockRewardDetailsHashV1 ha) = prHash ha
diff --git a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs
index d0323d934d..e98fd2086c 100644
--- a/concordium-consensus/src/Concordium/GlobalState/TreeState.hs
+++ b/concordium-consensus/src/Concordium/GlobalState/TreeState.hs
@@ -38,6 +38,7 @@ import Concordium.Types.Updates hiding (getUpdateKeysCollection)
 import qualified Concordium.GlobalState.Block as B
 import Concordium.Scheduler.Types (FilteredTransactions)
 import qualified Concordium.TransactionVerification as TVer
+import Concordium.Types.TransactionOutcomes
 
 data BlockStatus bp pb
     = BlockAlive !bp
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Finality.hs b/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Finality.hs
index 2744fb1e5f..144b9f78b0 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Finality.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Finality.hs
@@ -1,5 +1,6 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -46,6 +47,7 @@ import Concordium.Types.Option
 --
 --  This function incorporates the functionality of @checkFinality@ from the bluepaper.
 processCertifiedBlock ::
+    forall m.
     ( MonadState (SkovData (MPV m)) m,
       TimeMonad m,
       MonadIO m,
@@ -55,6 +57,7 @@ processCertifiedBlock ::
       MonadThrow m,
       MonadConsensusEvent m,
       MonadLogger m,
+      MonadProtocolVersion m,
       IsConsensusV1 (MPV m),
       HasCallStack
     ) =>
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Quorum.hs b/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Quorum.hs
index 92251434b1..f3d50d42a1 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Quorum.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Consensus/Quorum.hs
@@ -270,6 +270,7 @@ makeQuorumCertificate qcBlockPointer sd@SkovData{..} = do
 --  'Concordium.KonsensusV1.Consensus.Blocks'.)
 processQuorumMessage ::
     ( IsConsensusV1 (MPV m),
+      MonadProtocolVersion m,
       MonadThrow m,
       MonadIO m,
       BlockStateStorage m,
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Flag.hs b/concordium-consensus/src/Concordium/KonsensusV1/Flag.hs
index fc888d6dd0..9e0db1d5f1 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Flag.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Flag.hs
@@ -55,7 +55,7 @@ data FlaggableOffense (pv :: ProtocolVersion)
     | -- | The block is in a new 'Epoch', but it is missing the finalization entry.
       --  Witnessed by the block received.
       BlockEpochFinalizationMissing !(SignedBlock pv)
-    | -- | The block was not in a new 'Epoch', but a finalization entry is presnet.
+    | -- | The block was not in a new 'Epoch', but a finalization entry is present.
       --  Witnessed by the block received.
       BlockUnexpectedEpochFinalization !(SignedBlock pv)
     | -- | The block is in a new 'Epoch' but the finalization entry is deemed invalid.
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
index 3416a09c65..e86508bd2d 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Scheduler.hs
@@ -16,10 +16,10 @@ import Concordium.Types
 import Concordium.Types.SeedState
 
 import Concordium.GlobalState.BakerInfo
-import Concordium.GlobalState.Basic.BlockState.PoolRewards (BakerPoolRewardDetails)
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.CapitalDistribution
 import qualified Concordium.GlobalState.Persistent.BlockState as PBS
+import Concordium.GlobalState.PoolRewards (BakerPoolRewardDetails)
 import Concordium.GlobalState.TransactionTable
 import Concordium.GlobalState.Types
 import Concordium.KonsensusV1.LeaderElection
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel/LMDB.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel/LMDB.hs
index 4b1b271100..0675d914cd 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel/LMDB.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/LowLevel/LMDB.hs
@@ -880,7 +880,9 @@ rollBackBlocksUntil checkState = do
                                                 { feFinalizedQuorumCertificate =
                                                     blockQuorumCertificate block,
                                                   feSuccessorQuorumCertificate = finQC,
-                                                  feSuccessorProof = getHash (sbBlock block)
+                                                  feSuccessorProof =
+                                                    makeSuccessorProof @(BlockHashVersionFor pv) $
+                                                        getHash (sbBlock block)
                                                 }
                                         return (c + 1, finHash : hashes, parent)
             loadRecord txn (dbh ^. latestFinalizationEntryStore) CSKLatestFinalizationEntry
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs
index 78826c7323..c7a64fc9be 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/TreeState/Types.hs
@@ -207,9 +207,13 @@ instance BakedBlockData (PendingBlock pv) where
     blockSignature = blockSignature . pbBlock
     blockDerivableHashes = blockDerivableHashes . pbBlock
 
-deserializeExactVersionedPendingBlock :: SProtocolVersion pv -> BS.ByteString -> UTCTime -> Either String (PendingBlock pv)
-deserializeExactVersionedPendingBlock spv blockBS recTime =
-    case runGet (getSignedBlock spv (utcTimeToTransactionTime recTime)) blockBS of
+deserializeExactVersionedPendingBlock ::
+    (IsProtocolVersion pv) =>
+    BS.ByteString ->
+    UTCTime ->
+    Either String (PendingBlock pv)
+deserializeExactVersionedPendingBlock blockBS recTime =
+    case runGet (getSignedBlock (utcTimeToTransactionTime recTime)) blockBS of
         Left err -> Left $ "Block deserialization failed: " ++ err
         Right signedBlock -> Right $ PendingBlock signedBlock recTime
 
diff --git a/concordium-consensus/src/Concordium/KonsensusV1/Types.hs b/concordium-consensus/src/Concordium/KonsensusV1/Types.hs
index ff71600581..85345de56c 100644
--- a/concordium-consensus/src/Concordium/KonsensusV1/Types.hs
+++ b/concordium-consensus/src/Concordium/KonsensusV1/Types.hs
@@ -19,6 +19,7 @@ import qualified Data.Map.Strict as Map
 import Data.Maybe
 import Data.Serialize
 import qualified Data.Set as Set
+import Data.Singletons
 import qualified Data.Vector as Vector
 import Data.Word
 import Numeric.Natural
@@ -30,11 +31,13 @@ import qualified Concordium.Crypto.VRF as VRF
 import Concordium.Genesis.Data (Regenesis, firstGenesisBlockHash, regenesisBlockHash, regenesisCoreParametersV1)
 import Concordium.Genesis.Data.BaseV1
 import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMBT
+import qualified Concordium.MerkleProofs as Merkle
 import Concordium.Types
 import Concordium.Types.Block (AbsoluteBlockHeight)
 import Concordium.Types.HashableTo
 import Concordium.Types.Option
 import Concordium.Types.Parameters (IsConsensusV1)
+import Concordium.Types.TransactionOutcomes
 import Concordium.Types.Transactions
 import Concordium.Utils.BinarySearch
 import Concordium.Utils.Serialization
@@ -198,7 +201,7 @@ newtype FinalizationCommitteeHash = FinalizationCommitteeHash
 computeFinalizationCommitteeHash :: FinalizationCommittee -> FinalizationCommitteeHash
 computeFinalizationCommitteeHash FinalizationCommittee{..} =
     FinalizationCommitteeHash $
-        LFMBT.hashAsLFMBT emptyCommitteeHash $
+        LFMBT.hashAsLFMBTV1 emptyCommitteeHash $
             computeFinalizerInfoHash <$> Vector.toList committeeFinalizers
   where
     emptyCommitteeHash = Hash.hash "EmptyFinalizationCommittee"
@@ -315,6 +318,9 @@ instance Serialize QuorumCertificate where
 instance HashableTo Hash.Hash QuorumCertificate where
     getHash = Hash.hash . encode
 
+instance (Monad m) => Merkle.MerkleProvable m QuorumCertificate where
+    buildMerkleProof _ qc = return [Merkle.RawData $ encode qc]
+
 -- | Check that the quorum certificate has:
 --
 --   * Valid signatures from members of the finalization committee.
@@ -368,7 +374,12 @@ quorumCertificateSigningBakers finalizers qc =
             <$> committeeFinalizers finalizers Vector.!? fromIntegral (theFinalizerIndex finIndex)
 
 -- | A Merkle proof that one block is the successor of another.
-type SuccessorProof = BlockQuasiHash
+newtype SuccessorProof = SuccessorProof {theSuccessorProof :: Hash.Hash}
+    deriving (Eq, Ord, Show, Serialize)
+
+-- | Construct a 'SuccessorProof' from a 'BlockQuasiHash'.
+makeSuccessorProof :: BlockQuasiHash' bhv -> SuccessorProof
+makeSuccessorProof (BlockQuasiHash hsh) = SuccessorProof hsh
 
 -- | Compute the 'BlockHash' of a block that is the successor of another block.
 successorBlockHash ::
@@ -377,7 +388,7 @@ successorBlockHash ::
     -- | Successor proof
     SuccessorProof ->
     BlockHash
-successorBlockHash bh = computeBlockHash bhh
+successorBlockHash bh = computeBlockHash' bhh . theSuccessorProof
   where
     bhh = getHash bh
 
@@ -437,6 +448,10 @@ instance HashableTo Hash.Hash (Option FinalizationEntry) where
         putWord8 1
         put fe
 
+instance (Monad m) => Merkle.MerkleProvable m (Option FinalizationEntry) where
+    buildMerkleProof _ Absent = return [Merkle.RawData (encode (0 :: Word8))]
+    buildMerkleProof _ (Present fe) = return [Merkle.RawData . runPut $ putWord8 1 >> put fe]
+
 -- | Check that a finalization entry is valid. This checks the validity of the two quorum
 --  certificates. Note that the structural invariants on 'FinalizationEntry' enforce the other
 --  conditions in the definition of validity.
@@ -590,6 +605,10 @@ instance HashableTo Hash.Hash (Option TimeoutCertificate) where
         putWord8 1
         put tc
 
+instance (Monad m) => Merkle.MerkleProvable m (Option TimeoutCertificate) where
+    buildMerkleProof _ Absent = return [Merkle.RawData (encode (0 :: Word8))]
+    buildMerkleProof _ (Present tc) = return [Merkle.RawData . runPut $ putWord8 1 >> put tc]
+
 -- | Check that the signature on a timeout certificate is correct and that it contains a sufficient
 --  weight of signatures with respect to the finalization committee of a given epoch (the epoch of
 --  the quorum certificate that the timeout certificate should be valid with respect to).
@@ -1075,9 +1094,9 @@ putSignedBlock SignedBlock{..} = do
 
 -- | Deserialize a 'SignedBlock'. The protocol version is used to determine which transactions types
 --  are permitted.
-getSignedBlock :: SProtocolVersion pv -> TransactionTime -> Get (SignedBlock pv)
-getSignedBlock spv tt = do
-    sbBlock <- getBakedBlock spv tt
+getSignedBlock :: forall pv. (IsProtocolVersion pv) => TransactionTime -> Get (SignedBlock pv)
+getSignedBlock tt = do
+    sbBlock <- getBakedBlock (protocolVersion @pv) tt
     let sbHash = getHash sbBlock
     sbSignature <- get
     return SignedBlock{..}
@@ -1128,6 +1147,7 @@ signBlockHash privKey genesisHash bh = BlockSig.sign privKey (blockSignatureMess
 
 -- | Sign a block as a baker.
 signBlock ::
+    (IsProtocolVersion pv) =>
     -- | The key to use for signing
     BakerSignPrivateKey ->
     -- | The genesis hash
@@ -1193,17 +1213,21 @@ instance HashableTo BlockHeaderHash (BakedBlock pv) where
 
 -- | Hash of a block's contents. This is combined with the 'BlockHeaderHash' to produce a
 --  'BlockHash'.
-newtype BlockQuasiHash = BlockQuasiHash {theBlockQuasiHash :: Hash.Hash}
+newtype BlockQuasiHash' (bhv :: BlockHashVersion) = BlockQuasiHash {theBlockQuasiHash :: Hash.Hash}
     deriving (Eq, Ord, Show, Serialize)
 
--- | Compute the hash from a list of transactions.
-computeTransactionsHash :: Vector.Vector BlockItem -> Hash.Hash
-computeTransactionsHash bis =
-    LFMBT.hashAsLFMBT
-        (Hash.hash "")
-        (v0TransactionHash . getHash <$> Vector.toList bis)
+type BlockQuasiHash (pv :: ProtocolVersion) = BlockQuasiHash' (BlockHashVersionFor pv)
 
-instance HashableTo BlockQuasiHash (BakedBlock pv) where
+-- | Compute the hash from a list of transactions.
+computeTransactionsHash :: SBlockHashVersion bhv -> Vector.Vector BlockItem -> Hash.Hash
+computeTransactionsHash sbhv bis = case sbhv of
+    SBlockHashVersion0 ->
+        LFMBT.hashAsLFMBTV0
+            (Hash.hash "")
+            (v0TransactionHash . getHash <$> Vector.toList bis)
+    SBlockHashVersion1 -> LFMBT.theLFMBTreeHash $ LFMBT.lfmbtHash' SBlockHashVersion1 (v0TransactionHash . getHash) bis
+
+instance (IsBlockHashVersion bhv) => HashableTo (BlockQuasiHash' bhv) (BakedBlock pv) where
     getHash BakedBlock{..} = BlockQuasiHash $ Hash.hashOfHashes metaHash dataHash
       where
         metaHash = Hash.hashOfHashes bakerInfoHash certificatesHash
@@ -1226,24 +1250,73 @@ instance HashableTo BlockQuasiHash (BakedBlock pv) where
               where
                 transactionsAndOutcomesHash = Hash.hashOfHashes transactionsHash outcomesHash
                   where
-                    transactionsHash = computeTransactionsHash bbTransactions
+                    transactionsHash = computeTransactionsHash (sing @bhv) bbTransactions
                     outcomesHash = tohGet dbhv0TransactionOutcomesHash
                 stateHash = v0StateHash dbhv0BlockStateHash
             DerivableBlockHashesV1{..} -> Hash.hashOfHashes transactionsHash blockResultHash
               where
-                transactionsHash = computeTransactionsHash bbTransactions
+                transactionsHash = computeTransactionsHash (sing @bhv) bbTransactions
                 blockResultHash = theBlockResultHash dbhv1BlockResultHash
 
+instance (IsProtocolVersion pv) => HashableTo SuccessorProof (BakedBlock pv) where
+    getHash = makeSuccessorProof @(BlockHashVersionFor pv) . getHash
+
 -- | Compute the block hash from the header hash and quasi-hash.
-computeBlockHash :: BlockHeaderHash -> BlockQuasiHash -> BlockHash
-computeBlockHash bhh bqh =
+computeBlockHash' :: BlockHeaderHash -> Hash.Hash -> BlockHash
+{-# INLINE computeBlockHash' #-}
+computeBlockHash' bhh bqh =
     BlockHash $
         Hash.hashOfHashes
             (theBlockHeaderHash bhh)
-            (theBlockQuasiHash bqh)
+            bqh
 
-instance HashableTo BlockHash (BakedBlock pv) where
-    getHash bb = computeBlockHash (getHash bb) (getHash bb)
+-- | Compute the block hash from the header hash and quasi-hash.
+computeBlockHash :: BlockHeaderHash -> BlockQuasiHash' bhv -> BlockHash
+computeBlockHash bhh bqh = computeBlockHash' bhh (theBlockQuasiHash bqh)
+
+instance (IsProtocolVersion pv) => HashableTo BlockHash (BakedBlock pv) where
+    getHash bb = computeBlockHash @(BlockHashVersionFor pv) (getHash bb) (getHash bb)
+
+instance (Monad m, BlockHashVersionFor pv ~ 'BlockHashVersion1) => Merkle.MerkleProvable m (BakedBlock pv) where
+    buildMerkleProof open BakedBlock{..} = do
+        let blockHeader = optProof ["header"] . rawMerkle . runPut $ do
+                put bbRound
+                put bbEpoch
+                put (qcBlock bbQuorumCertificate)
+        let biPath = ["quasi", "meta", "bakerInfo"]
+        let timestampBaker = optProof (biPath ++ ["timestampBaker"]) . rawMerkle . runPut $ do
+                put bbTimestamp
+                put bbBaker
+        let nonce = optProof (biPath ++ ["nonce"]) . rawMerkle . encode $ bbNonce
+        let bakerInfo = optProof biPath [timestampBaker, nonce]
+        let chPath = ["quasi", "meta", "certificatesHash"]
+        let qcPath = chPath ++ ["quorumCertificate"]
+        qcMerkleProof <- Merkle.buildMerkleProof (open . (qcPath ++)) bbQuorumCertificate
+        let qcHash = optProof qcPath qcMerkleProof
+        let tfPath = chPath ++ ["timeoutFinalization"]
+        let tcPath = tfPath ++ ["timeoutCertificate"]
+        tcMerkleProof <- Merkle.buildMerkleProof (open . (tcPath ++)) bbTimeoutCertificate
+        let tcHash = optProof tcPath tcMerkleProof
+        let efePath = tfPath ++ ["epochFinalizationEntry"]
+        efeMerkleProof <- Merkle.buildMerkleProof (open . (efePath ++)) bbEpochFinalizationEntry
+        let efeHash = optProof efePath efeMerkleProof
+        let tfHash = optProof tfPath [tcHash, efeHash]
+        let certificatesHash = optProof chPath [qcHash, tfHash]
+        let blockMeta = optProof ["quasi", "meta"] [bakerInfo, certificatesHash]
+        let blockData = case bbDerivableHashes of
+                DerivableBlockHashesV1{..} ->
+                    optProof ["quasi", "data"] [transactions, Merkle.RawData (encode dbhv1BlockResultHash)]
+                  where
+                    transactions =
+                        Merkle.RawData . encode . computeTransactionsHash SBlockHashVersion1 $
+                            bbTransactions
+        let blockQuasi = optProof ["quasi"] [blockMeta, blockData]
+        return [blockHeader, blockQuasi]
+      where
+        rawMerkle = (: []) . Merkle.RawData
+        optProof path proof
+            | open path = Merkle.SubProof proof
+            | otherwise = Merkle.RawData . Hash.hashToByteString . Merkle.toRootHash $ proof
 
 -- | Configuration information stored for the genesis block.
 data GenesisMetadata = GenesisMetadata
@@ -1354,7 +1427,7 @@ getBlock ts = do
             (_ :: Round) <- get
             GenesisBlock <$> get
         _ -> do
-            NormalBlock <$> getSignedBlock (protocolVersion @pv) ts
+            NormalBlock <$> getSignedBlock ts
 
 -- | Deserialize a 'Block' where we already know the block hash. This behaves the same as 'getBlock',
 --  but avoids having to recompute the block hash.
diff --git a/concordium-consensus/src/Concordium/MultiVersion.hs b/concordium-consensus/src/Concordium/MultiVersion.hs
index 2a53ba5240..3676399b88 100644
--- a/concordium-consensus/src/Concordium/MultiVersion.hs
+++ b/concordium-consensus/src/Concordium/MultiVersion.hs
@@ -1691,7 +1691,7 @@ receiveBlock gi blockBS = withLatestExpectedVersion gi $ \case
     (EVersionedConfigurationV1 (vc :: VersionedConfigurationV1 finconf pv)) -> do
         MVR $ \mvr -> do
             now <- currentTime
-            case SkovV1.deserializeExactVersionedPendingBlock (protocolVersion @pv) blockBS now of
+            case SkovV1.deserializeExactVersionedPendingBlock @pv blockBS now of
                 Left err -> do
                     mvLog mvr Runner LLDebug err
                     return (Skov.ResultSerializationFail, Nothing)
@@ -2066,7 +2066,7 @@ receiveExecuteBlock gi blockBS = withLatestExpectedVersion_ gi $ \case
             Right block -> runSkovV0Transaction vc (Skov.receiveExecuteBlock block)
     EVersionedConfigurationV1 (vc :: VersionedConfigurationV1 finconf pv) -> do
         now <- currentTime
-        case SkovV1.deserializeExactVersionedPendingBlock (protocolVersion @pv) blockBS now of
+        case SkovV1.deserializeExactVersionedPendingBlock @pv blockBS now of
             Left err -> do
                 logEvent Runner LLDebug err
                 return Skov.ResultSerializationFail
diff --git a/concordium-consensus/src/Concordium/Queries.hs b/concordium-consensus/src/Concordium/Queries.hs
index c2d9350622..426acfa2c6 100644
--- a/concordium-consensus/src/Concordium/Queries.hs
+++ b/concordium-consensus/src/Concordium/Queries.hs
@@ -1630,7 +1630,7 @@ getBlockCertificates = liftSkovQueryBHI (\_ -> return $ Left BlockCertificatesIn
             QueriesKonsensusV1.EpochFinalizationEntry
                 { efeFinalizedQC = mkQuorumCertificateOut committee feFinalizedQuorumCertificate,
                   efeSuccessorQC = mkQuorumCertificateOut committee feSuccessorQuorumCertificate,
-                  efeSuccessorProof = QueriesKonsensusV1.SuccessorProof $ SkovV1.theBlockQuasiHash feSuccessorProof
+                  efeSuccessorProof = QueriesKonsensusV1.SuccessorProof $ SkovV1.theSuccessorProof feSuccessorProof
                 }
 
 -- | Error type for querying 'BakerRewardPeriodInfo' for some block.
diff --git a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
index d3b47f0217..6c5403d87e 100644
--- a/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
+++ b/concordium-consensus/src/Concordium/Scheduler/TreeStateEnvironment.hs
@@ -26,12 +26,12 @@ import Data.Word
 import Lens.Micro.Platform
 
 import qualified Concordium.GlobalState.BakerInfo as BI
-import Concordium.GlobalState.Basic.BlockState.PoolRewards
 import Concordium.GlobalState.BlockMonads
 import Concordium.GlobalState.BlockPointer
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.CapitalDistribution
 import Concordium.GlobalState.Parameters
+import Concordium.GlobalState.Persistent.PoolRewards (BakerPoolRewardDetails (..))
 import Concordium.GlobalState.Rewards
 import Concordium.GlobalState.TreeState
 import Concordium.Kontrol.Bakers
diff --git a/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs b/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs
new file mode 100644
index 0000000000..b1c13db00a
--- /dev/null
+++ b/concordium-consensus/src/Concordium/Types/TransactionOutcomes.hs
@@ -0,0 +1,146 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Concordium.Types.TransactionOutcomes where
+
+import Data.Hashable
+import qualified Data.Sequence as Seq
+import qualified Data.Serialize as S
+import qualified Data.Vector as Vec
+import Lens.Micro.Internal
+import Lens.Micro.Platform
+
+import qualified Concordium.Crypto.SHA256 as H
+import Concordium.Types
+import Concordium.Types.Execution
+import Concordium.Types.HashableTo
+import Concordium.Types.Transactions
+import Concordium.Utils.Serialization
+
+-- | Outcomes of transactions. The vector of outcomes must have the same size as the
+--  number of transactions in the block, and ordered in the same way.
+data TransactionOutcomes = TransactionOutcomes
+    { outcomeValues :: !(Vec.Vector TransactionSummary),
+      _outcomeSpecial :: !(Seq.Seq SpecialTransactionOutcome)
+    }
+
+makeLenses ''TransactionOutcomes
+
+instance Show TransactionOutcomes where
+    show (TransactionOutcomes v s) = "Normal transactions: " ++ show (Vec.toList v) ++ ", special transactions: " ++ show s
+
+putTransactionOutcomes :: S.Putter TransactionOutcomes
+putTransactionOutcomes TransactionOutcomes{..} = do
+    putListOf putTransactionSummary (Vec.toList outcomeValues)
+    S.put _outcomeSpecial
+
+getTransactionOutcomes :: SProtocolVersion pv -> S.Get TransactionOutcomes
+getTransactionOutcomes spv = TransactionOutcomes <$> (Vec.fromList <$> getListOf (getTransactionSummary spv)) <*> S.get
+
+instance HashableTo (TransactionOutcomesHashV 'TOV0) TransactionOutcomes where
+    getHash transactionoutcomes =
+        TransactionOutcomesHashV . H.hash . S.runPut $
+            putTransactionOutcomes transactionoutcomes
+
+-- | A simple wrapper around a 'H.Hash', that represents the hash of transaction outcomes in a
+--  block. The type does not indicate how the hash is derived, which varies over versions.
+-- (See 'TransactionOutcomesHashV'.)
+--
+--   * If the 'TransactionOutcomesVersion' is 'TOV0', then the hash is the hash of a serialized
+--     'TransactionOutcomes' structure. (The 'BlockHashVersion' is irrelevant in this case.)
+--
+--   * If the 'TransactionOutcomesVersion' is 'TOV1', then the hash is the hash of the string
+--     @("TransactionOutcomesHashV1" <> outcomes <> special)@, where @outcomes@ and @special@
+--     are the version 0 LFMBTree hashes of the normal and special transaction outcomes
+--     respectively.
+--
+--   * If the 'TransactionOutcomesVersion' is 'TOV2', then the hash is the hash of the string
+--     @(outcomes <> special)@, where @outcomes@ and @special@ are the version 1 LFMBTree hashes
+--     of the normal and special transaction outcomes respectively.
+newtype TransactionOutcomesHash = TransactionOutcomesHash {tohGet :: H.Hash}
+    deriving newtype (Eq, Ord, Show, S.Serialize, Read, Hashable)
+
+-- | A wrapper around a 'H.Hash', representing the hash of transaction outcomes in
+--  a block. The type parameter indicates the hashing scheme used to derive the hash.
+--
+--   * If the 'TransactionOutcomesVersion' is 'TOV0', then the hash is the hash of a serialized
+--     'TransactionOutcomes' structure. (The 'BlockHashVersion' is irrelevant in this case.)
+--
+--   * If the 'TransactionOutcomesVersion' is 'TOV1', then the hash is the hash of the string
+--     @("TransactionOutcomesHashV1" <> outcomes <> special)@, where @outcomes@ and @special@
+--     are the version 0 LFMBTree hashes of the normal and special transaction outcomes
+--     respectively.
+--
+--   * If the 'TransactionOutcomesVersion' is 'TOV2', then the hash is the hash of the string
+--     @(outcomes <> special)@, where @outcomes@ and @special@ are the version 1 LFMBTree hashes
+--     of the normal and special transaction outcomes respectively.
+newtype TransactionOutcomesHashV (tov :: TransactionOutcomesVersion) = TransactionOutcomesHashV
+    { theTransactionOutcomesHashV :: H.Hash
+    }
+    deriving newtype (Eq, Ord, Show, S.Serialize, Read, Hashable)
+
+-- | Convert a 'TransactionOutcomesHashV' to a 'TransactionOutcomesHash'. This erases the
+--  type-level information about the transaction outcomes hashing version used.
+toTransactionOutcomesHash :: TransactionOutcomesHashV tov -> TransactionOutcomesHash
+toTransactionOutcomesHash = TransactionOutcomesHash . theTransactionOutcomesHashV
+
+emptyTransactionOutcomesV0 :: TransactionOutcomes
+emptyTransactionOutcomesV0 = TransactionOutcomes Vec.empty Seq.empty
+
+-- | Hash of the empty V0 transaction outcomes structure. This transaction outcomes
+--  structure is used in protocol versions 1-5.
+emptyTransactionOutcomesHashV0 :: TransactionOutcomesHashV 'TOV0
+emptyTransactionOutcomesHashV0 = getHash emptyTransactionOutcomesV0
+
+-- | Hash of the empty V1 transaction outcomes structure. This transaction outcomes
+--  structure is used in protocol versions 5 and 6.
+emptyTransactionOutcomesHashV1 :: TransactionOutcomesHashV 'TOV1
+{-# NOINLINE emptyTransactionOutcomesHashV1 #-}
+emptyTransactionOutcomesHashV1 =
+    TransactionOutcomesHashV $
+        H.hashShort
+            ( "TransactionOutcomesHashV1"
+                <> H.hashToShortByteString (H.hash "EmptyLFMBTree")
+                <> H.hashToShortByteString (H.hash "EmptyLFMBTree")
+            )
+
+-- | Hash of the empty V2 transaction outcomes structure. This transaction outcomes
+--  structure is used starting in protocol version 7.
+emptyTransactionOutcomesHashV2 :: TransactionOutcomesHashV 'TOV2
+{-# NOINLINE emptyTransactionOutcomesHashV2 #-}
+emptyTransactionOutcomesHashV2 =
+    TransactionOutcomesHashV $ H.hashOfHashes emptyHash emptyHash
+  where
+    emptyHash = H.hash $ S.runPut $ do
+        S.putWord64be 0
+        S.put (H.hash "EmptyLFMBTree")
+
+emptyTransactionOutcomesHashV :: STransactionOutcomesVersion tov -> TransactionOutcomesHashV tov
+emptyTransactionOutcomesHashV stov = case stov of
+    STOV0 -> emptyTransactionOutcomesHashV0
+    STOV1 -> emptyTransactionOutcomesHashV1
+    STOV2 -> emptyTransactionOutcomesHashV2
+
+transactionOutcomesV0FromList :: [TransactionSummary] -> TransactionOutcomes
+transactionOutcomesV0FromList l =
+    let outcomeValues = Vec.fromList l
+        _outcomeSpecial = Seq.empty
+    in  TransactionOutcomes{..}
+
+type instance Index TransactionOutcomes = TransactionIndex
+type instance IxValue TransactionOutcomes = TransactionSummary
+
+instance Ixed TransactionOutcomes where
+    ix idx f outcomes@TransactionOutcomes{..} =
+        let x = fromIntegral idx
+        in  if x >= length outcomeValues
+                then pure outcomes
+                else ix x f outcomeValues <&> (\ov -> TransactionOutcomes{outcomeValues = ov, ..})
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs
index bfad7a0b82..b6ce180dc9 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/CredentialDeploymentTests.hs
@@ -101,7 +101,7 @@ testBB1 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "4afb7f50e89b6ae3fb04fbb3854a70cf31bff01dfcbbd65d22f5d20032f4bce0"
+                    { dbhv1BlockResultHash = read "57ab8075b87956bad7767e9960b2b0e8d8bd597c50499b0fbfc89c92116840d3"
                     }
         }
   where
@@ -130,7 +130,7 @@ testBB2 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "612cb7a13a9cb8d403f2b4992321f3919debd923c9fdaadd68153a417064b1d7"
+                    { dbhv1BlockResultHash = read "dc98aba2252459fc70c6394ed0d4202648f2fc5bb67c05f7c29dcca94f978038"
                     }
         }
   where
@@ -159,7 +159,7 @@ testBB3 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "83d2d20e5836df6dddbbfc65bbc13f67f8117cc871bbd4eeb635efe528571397"
+                    { dbhv1BlockResultHash = read "5c1da92dc09daaaa134a8db43ea20b9775c4b9e4ddd9180b813f0f8c0b15f7a5"
                     }
         }
   where
@@ -212,7 +212,7 @@ testBB2' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "04225271b518f16c0cb63282d08bff365d6236ff6c1e63e0da5c40fc3af96136"
+                    { dbhv1BlockResultHash = read "68180f7b9fe640da0c75f1de766546e0389c6601dc2a41fc95f78d4c4347c4d4"
                     }
         }
   where
@@ -241,7 +241,7 @@ testBB3' =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "ca469c03bae422c5059e40f5ea683bd7be0d4bae0b8295021a674af78ef04f37"
+                    { dbhv1BlockResultHash = read "7275b0a832fa0a524dbe9a26b38d06f742780210cccb728844cc6cf0957cbb66"
                     }
         }
   where
@@ -268,7 +268,7 @@ testBB4 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "3f2846dfe9e52dd9537831df434e876ae029f43e7855fe5eba0212b7df4b2645"
+                    { dbhv1BlockResultHash = read "3792722cd91d9e29c281cd6c157824c9362e44e736581a9b537796ab57e964a0"
                     }
         }
   where
@@ -295,7 +295,7 @@ testBB5 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "7bafef3db7a89a0475c4132a71fda2fa67d6e9ace01d02aaf9fd8cdc05c4e4ad"
+                    { dbhv1BlockResultHash = read "2565abee4b11eced3b166264d8b407253d51803c461006b8884c55da688aee82"
                     }
         }
   where
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs
index d7910dc1db..0d7faba47a 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/EndToEnd/TransactionTableIntegrationTest.hs
@@ -70,7 +70,7 @@ testBB1 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "2265bb2759ce64984122dae6df3ee505e92bbca35d334802cbfbb8d4eaba7d4b"
+                    { dbhv1BlockResultHash = read "49be5d6a7044cbd517973bfba332b88ab00c8762b3f4a550abcf50bf85a40963"
                     }
         }
   where
@@ -99,7 +99,7 @@ testBB2 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "a5e6a885a642a94deeccf8df29aa55062b4ae32423bc8dd9ed5ce3c076928cf9"
+                    { dbhv1BlockResultHash = read "ed353b43ea7bfe91106f3588f422493cf3c0ae8843dddabb4b978ee6f7331c0e"
                     }
         }
   where
@@ -128,7 +128,7 @@ testBB3 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "8202d3d2b8ddb55e355dd53f0d8206abf0c48e773f9b49de8e261fb3a050d858"
+                    { dbhv1BlockResultHash = read "cae9e6fb2880e53becd10b47541ceaf6412d0ff96211d7dcc6d7b45d295e7c46"
                     }
         }
   where
@@ -156,7 +156,7 @@ testBB4 =
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "b3eb61d1b5a821e7ad9f2ba4b5b10071f106093d6bd2d9ebeb4fcb58e1fdb97d"
+                    { dbhv1BlockResultHash = read "fbda331e363078f51313bc7ab4d54ed9f9c542afd48867f67467420b4172e099"
                     }
         }
   where
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs
index df0fb96c75..1663b5b951 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/CatchUp.hs
@@ -446,12 +446,12 @@ catchupWithTwoBranchesResponse sProtocolVersion =
                               bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
                                 SBlockHashVersion0 ->
                                     DerivableBlockHashesV0
-                                        { dbhv0TransactionOutcomesHash = emptyBlockTOH 3,
+                                        { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 3,
                                           dbhv0BlockStateHash = read "cdf730c1b3fdc6d07f404c6b95a4f3417c19653b1299b92f59fcaffcc9745910"
                                         }
                                 SBlockHashVersion1 ->
                                     DerivableBlockHashesV1
-                                        { dbhv1BlockResultHash = read "f36a049939054eac3e8662e4ab0310d8e12381ee2ba77a9c16fa19c205ea64b3"
+                                        { dbhv1BlockResultHash = read "15de5c588b1eef119b2c03e7baf124deb0b3a01260ccc43cb7e470922d67c531"
                                         }
                             }
         TestBlocks.succeedReceiveBlock b4
@@ -581,12 +581,12 @@ testMakeCatchupStatus sProtocolVersion =
                               bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
                                 SBlockHashVersion0 ->
                                     DerivableBlockHashesV0
-                                        { dbhv0TransactionOutcomesHash = emptyBlockTOH 3,
+                                        { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 3,
                                           dbhv0BlockStateHash = read "cdf730c1b3fdc6d07f404c6b95a4f3417c19653b1299b92f59fcaffcc9745910"
                                         }
                                 SBlockHashVersion1 ->
                                     DerivableBlockHashesV1
-                                        { dbhv1BlockResultHash = read "f36a049939054eac3e8662e4ab0310d8e12381ee2ba77a9c16fa19c205ea64b3"
+                                        { dbhv1BlockResultHash = read "15de5c588b1eef119b2c03e7baf124deb0b3a01260ccc43cb7e470922d67c531"
                                         }
                             }
         TestBlocks.succeedReceiveBlock b4
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs
index 97127360b1..70544940f5 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Common.hs
@@ -21,7 +21,7 @@ import Concordium.Types
 import qualified Concordium.Types.Conditionally as Cond
 import Concordium.Types.Option
 import Concordium.Types.Parameters
-import Concordium.Types.Transactions
+import Concordium.Types.TransactionOutcomes
 import GHC.IO (unsafePerformIO)
 import GHC.IORef (newIORef)
 import Test.Hspec (Spec)
@@ -107,7 +107,7 @@ someBlockPointer sProtocolVersion bh r e =
               bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
                 SBlockHashVersion0 ->
                     DerivableBlockHashesV0
-                        { dbhv0TransactionOutcomesHash = emptyTransactionOutcomesHashV1,
+                        { dbhv0TransactionOutcomesHash = toTransactionOutcomesHash emptyTransactionOutcomesHashV1,
                           dbhv0BlockStateHash = stateHash
                         }
                 SBlockHashVersion1 ->
@@ -120,7 +120,7 @@ someBlockPointer sProtocolVersion bh r e =
 myBlockPointer :: SProtocolVersion pv -> Round -> Epoch -> BlockPointer pv
 myBlockPointer sProtocolVersion = someBlockPointer sProtocolVersion myBlockHash
 
--- | A key pair created from the provided seeed.
+-- | A key pair created from the provided seed.
 sigKeyPair' :: Int -> Sig.KeyPair
 sigKeyPair' seed = fst $ Dummy.randomBlockKeyPair $ mkStdGen seed
 
@@ -166,3 +166,16 @@ forEveryProtocolVersionConsensusV1 check =
     forEveryProtocolVersion $ \spv pvString -> case consensusVersionFor spv of
         ConsensusV0 -> return ()
         ConsensusV1 -> check spv pvString
+
+forEveryProtocolVersionBHV1 ::
+    ( forall pv.
+      (IsProtocolVersion pv, IsConsensusV1 pv, BlockHashVersionFor pv ~ 'BlockHashVersion1) =>
+      SProtocolVersion pv ->
+      String ->
+      Spec
+    ) ->
+    Spec
+forEveryProtocolVersionBHV1 check =
+    forEveryProtocolVersionConsensusV1 $ \spv pvString -> case sBlockHashVersionFor spv of
+        SBlockHashVersion1 -> check spv pvString
+        _ -> return ()
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs
index 0649df2678..6605d48eaf 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Consensus/Blocks.hs
@@ -34,13 +34,14 @@ import qualified Concordium.Types.DummyData as Dummy
 import Concordium.Types.HashableTo
 import Concordium.Types.Parameters
 import Concordium.Types.SeedState
+import qualified Concordium.Types.TransactionOutcomes as TransactionOutcomes
 import Concordium.Types.Transactions
 import qualified Concordium.Types.Transactions as Transactions
 
 import qualified Concordium.Genesis.Data.P6 as P6
 import qualified Concordium.Genesis.Data.P7 as P7
 import Concordium.GlobalState.BakerInfo
-import Concordium.GlobalState.Basic.BlockState.LFMBTree (hashAsLFMBT)
+import Concordium.GlobalState.Basic.BlockState.LFMBTree (hashAsLFMBTV0)
 import Concordium.GlobalState.BlockState (TransactionSummaryV1)
 import qualified Concordium.GlobalState.DummyData as Dummy
 import Concordium.KonsensusV1.Consensus
@@ -253,25 +254,25 @@ timeoutMessagesFor sProtocolVersion qc curRound curEpoch = mkTm <$> bakers sProt
 
 -- | Helper to compute the transaction outcomes hash for a given set of transaction outcomes and
 --  special transaction outcomes.
-transactionOutcomesHash ::
+transactionOutcomesHashV1 ::
     [TransactionSummaryV1] ->
     [Transactions.SpecialTransactionOutcome] ->
-    Transactions.TransactionOutcomesHash
-transactionOutcomesHash outcomes specialOutcomes =
-    Transactions.TransactionOutcomesHash $
+    TransactionOutcomes.TransactionOutcomesHash
+transactionOutcomesHashV1 outcomes specialOutcomes =
+    TransactionOutcomes.TransactionOutcomesHash $
         H.hashShort $
             "TransactionOutcomesHashV1"
                 <> H.hashToShortByteString out
                 <> H.hashToShortByteString special
   where
     lfmbHash :: (HashableTo H.Hash a) => [a] -> H.Hash
-    lfmbHash = hashAsLFMBT (H.hash "EmptyLFMBTree") . fmap getHash
+    lfmbHash = hashAsLFMBTV0 (H.hash "EmptyLFMBTree") . fmap getHash
     out = lfmbHash outcomes
     special = lfmbHash specialOutcomes
 
 -- | Compute the transaction outcomes hash for a block with no transactions.
-emptyBlockTOH :: BakerId -> Transactions.TransactionOutcomesHash
-emptyBlockTOH bid = transactionOutcomesHash [] [BlockAccrueReward 0 0 0 0 0 0 bid]
+emptyBlockTOHV1 :: BakerId -> TransactionOutcomes.TransactionOutcomesHash
+emptyBlockTOHV1 bid = transactionOutcomesHashV1 [] [BlockAccrueReward 0 0 0 0 0 0 bid]
 
 setStateHash :: StateHash -> BakedBlock PV -> BakedBlock PV
 setStateHash newStateHash block = case bbDerivableHashes block of
@@ -294,12 +295,12 @@ testBB1 =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "dee89435dba1609a84fa62283d2f63ec50f85b9c22f8815daf348df5428ccb65"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "39a83a5c78db450c757b9d8c11c6911b7de5a4d2a8ce964a16f7fc87ed697b69"
+                    { dbhv1BlockResultHash = read "db192a5742802472eee54a04a3fb718782ab7781964844b7eb94d06b15a05149"
                     }
         }
   where
@@ -322,12 +323,12 @@ testBB2 =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "d36974d10f1331559e396be5f8e31ecedc2042ebf941bc2fad6050e9e082f206"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "2d988a0381670c7142ed81afe2b5745113d565e8de4b1656fcfafd27b0b22ecb"
+                    { dbhv1BlockResultHash = read "9d4e02c619415a6dfaf5e5a525316b2eb2fc298d8152261d3bf0b876d8c015ac"
                     }
         }
   where
@@ -350,12 +351,12 @@ testBB3 =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "50998f735737ce13b35715a173efb7a3ad20cba597ba540985cd562a0b7bed74"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "e3488977b88b8d2b9291f205145b8445deb5238af2526b6a3fd75f725dafef83"
+                    { dbhv1BlockResultHash = read "b1bd2ff4c79cd23807f0a4c3ede1f655009ea7e6a188059cea797c209243bfc3"
                     }
         }
   where
@@ -371,12 +372,12 @@ testBB2' =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "20cd8fe8689b17850e73e8322b53398a49df5e4723eaa77acaf5474e94915c0b"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "589c7ee85c2178f3ea9ba8be4bbd4e5946bb5b5ce757164c2dbe28551f354db5"
+                    { dbhv1BlockResultHash = read "56a194ebc7843cec1c3d81f5ff279c56505681161ef181b374cd0c847cc80966"
                     }
         }
   where
@@ -393,12 +394,12 @@ testBB3' =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "784471f09f9678a2cf8208af45186f553406430b67e035ebf1b772e7c39fbd97"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "51b39b40caa3b23e41e461177659cf0b6e24c98d0471fd59cf2de134645af87e"
+                    { dbhv1BlockResultHash = read "02f43ab9e9c765a4a8e53b809a4f33d3a794694aee11c604e5bf78f2698cc41d"
                     }
         }
   where
@@ -422,12 +423,12 @@ testBB4' =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "3bb5b307d7abc6fad2464455f604d63512fff93d7fdeb2aa08d5a8f2720340fe"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "c061123ab66c29dfb5c44be1f3fa62eff91bf27d1a7947e190cab98ee39eb367"
+                    { dbhv1BlockResultHash = read "f28292a34519200f2e4b621726fb19aba30be9f08847213c48352baf805907d9"
                     }
         }
   where
@@ -443,7 +444,7 @@ testBB3'' =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "2b81e5943112b9a9916e57980a4b17b5b3b329eba0402d14201bfe1c9551a16d"
                     }
             SBlockHashVersion1 ->
@@ -474,12 +475,12 @@ testBB1E =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "3ce2fe0d538434fa7677549a4acbdecea606bd47a61fa39735de1dc144c95eab"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "92c6d014d2d788845521445c299e85d16854f308397000fc64564ea7abe0e341"
+                    { dbhv1BlockResultHash = read "777c8b14fad4d6293dfffcc254da9e433e65b9d5dcee17d08b517dc80322a25c"
                     }
         }
   where
@@ -502,12 +503,12 @@ testBB2E =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "df5d25b8ffbad7be62be0ae2ce1a4730018062c3bda6d6caa02ea03545a263fd"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "be9c7f10dc2e649bbdd89e6ad97f6b72b3fc83fa3292aa62e1db558b17b9f0af"
+                    { dbhv1BlockResultHash = read "eb33a9b3934e695e7f946674ac9704ed5ef93ff6a4a8a67582430e5dcefe9f3e"
                     }
         }
   where
@@ -532,12 +533,12 @@ testBB3EX =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "81e1b33e20088562fcb48c619ea16e800d7fba58995fa6487a6209cf448c7d08"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "9aee22a152f71ef811c017729d3bf47fc5eb110bb2853fe0b66f57091b18351a"
+                    { dbhv1BlockResultHash = read "add7420070e13016aac084523302f5971d52770ff533c8ff14d48852683de116"
                     }
         }
   where
@@ -578,12 +579,12 @@ testBB3E =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "dc31a663a0bd166507e21cc641759018651c716b3571531672956abf24b0f4bc"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "e95fc29d250c0fb4acb4e297ec0af49678442e9e2174c8ade12c0cc509995a9a"
+                    { dbhv1BlockResultHash = read "49b3adc9032e5ad91c5c179657812f7d95d8fd0aaa8604880027712b79e1358e"
                     }
         }
   where
@@ -617,12 +618,12 @@ testBB4E =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "daa799010a8b4acb47fa97b876abed73621db292029360734d9c8978b5859e7b"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "6141bfe4eadcd557e42d4cc319a9855a26ea4ff37ecbb486d0244ad611bd4cba"
+                    { dbhv1BlockResultHash = read "76798f1794d6c9efee199d155668aea6f46af6730e1e407838d9004361b1bc7e"
                     }
         }
   where
@@ -640,12 +641,12 @@ testBB4E' =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "41b44dd4db52dae4021a0d71fbec00a423ffc9892cf97bf6e506d722cdaaeb0d"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "a2a7356e06ff00522c4d821cd497a253ef12f09912cc96615927ac98a71ecea4"
+                    { dbhv1BlockResultHash = read "75b7246cc127b0ace238b30fa85826dfefb56134fdaadd33dc75cb71a16bc2c6"
                     }
         }
   where
@@ -670,12 +671,12 @@ testBB5E' =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "ff8cd1198e3926f743e91a97484d75f1109534aaf9655e1c8c9507d4d0ebd8b3"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "c7eaff2141ade9ac6d5fd8513678d9c7f42e5915f0be7b7b94e89a88c816a9e9"
+                    { dbhv1BlockResultHash = read "43de9349eecdf924addae7cf7ea4165dc2bf9cdc37bfa66fbd41e4a89b02cbf8"
                     }
         }
   where
@@ -713,12 +714,12 @@ testBB2Ex =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "df76421871484a877532dc9b748fcf248bd186898def8bd40fee0a3cf9636b92"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "cde603d206bd3f3ac1534efbb648d70d237f277c79e6923e91485df68e2d861f"
+                    { dbhv1BlockResultHash = read "7a8c8af3240193ca276dcfca125d652cf8f4cec3b665cf922ec0a5977ae15e02"
                     }
         }
   where
@@ -758,12 +759,12 @@ testBB3Ex =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "dc31a663a0bd166507e21cc641759018651c716b3571531672956abf24b0f4bc"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "593789121ba54a59eeaa06fce6b694072dde26f8aec6830717fbc7ea6d4eb4fa"
+                    { dbhv1BlockResultHash = read "64c40bfa061ec21944f37f6b94a2724083e3c3d87d20066e61cdaa4e340fd31d"
                     }
         }
   where
@@ -791,12 +792,12 @@ testBB3EA =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "df5d25b8ffbad7be62be0ae2ce1a4730018062c3bda6d6caa02ea03545a263fd"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "be9c7f10dc2e649bbdd89e6ad97f6b72b3fc83fa3292aa62e1db558b17b9f0af"
+                    { dbhv1BlockResultHash = read "eb33a9b3934e695e7f946674ac9704ed5ef93ff6a4a8a67582430e5dcefe9f3e"
                     }
         }
   where
@@ -824,12 +825,12 @@ testBB4EA =
           bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = emptyBlockTOH bakerId,
+                    { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 bakerId,
                       dbhv0BlockStateHash = read "41b44dd4db52dae4021a0d71fbec00a423ffc9892cf97bf6e506d722cdaaeb0d"
                     }
             SBlockHashVersion1 ->
                 DerivableBlockHashesV1
-                    { dbhv1BlockResultHash = read "a2a7356e06ff00522c4d821cd497a253ef12f09912cc96615927ac98a71ecea4"
+                    { dbhv1BlockResultHash = read "75b7246cc127b0ace238b30fa85826dfefb56134fdaadd33dc75cb71a16bc2c6"
                     }
         }
   where
@@ -1088,7 +1089,7 @@ testReceiveInvalidDuplicate sProtocolVersion =
             { bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
                 SBlockHashVersion0 ->
                     DerivableBlockHashesV0
-                        { dbhv0TransactionOutcomesHash = emptyBlockTOH 2,
+                        { dbhv0TransactionOutcomesHash = emptyBlockTOHV1 2,
                           dbhv0BlockStateHash = StateHashV0 minBound
                         }
                 SBlockHashVersion1 ->
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs
index 36f308b177..bdfb356e2d 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/LMDB.hs
@@ -1,6 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module ConcordiumTests.KonsensusV1.LMDB (tests) where
 
@@ -34,6 +36,7 @@ import Concordium.Types
 import qualified Concordium.Types.Conditionally as Cond
 import Concordium.Types.HashableTo
 import Concordium.Types.Option
+import Concordium.Types.TransactionOutcomes
 import Concordium.Types.Transactions
 
 import qualified ConcordiumTests.KonsensusV1.Common as Common
@@ -90,8 +93,8 @@ dummyBlockSig = Block.sign dummyKP "someMessage"
 -- | A helper function for creating a 'BakedBlock' given a round. Used by 'dummyBlock' to create blocks.
 --  The block is well-formed and contains the supplied transactions and is for the specified round.
 --  Beyond that, there should be no expectation on the data in the block.
-dummyBakedBlock :: SProtocolVersion pv -> Round -> Vector.Vector BlockItem -> BakedBlock pv
-dummyBakedBlock sProtocolVersion n ts =
+dummyBakedBlock :: forall pv. (IsProtocolVersion pv) => Round -> Vector.Vector BlockItem -> BakedBlock pv
+dummyBakedBlock n ts =
     BakedBlock
         { bbRound = n,
           bbEpoch = 1,
@@ -102,7 +105,7 @@ dummyBakedBlock sProtocolVersion n ts =
           bbEpochFinalizationEntry = Absent,
           bbNonce = dummyProof,
           bbTransactions = ts,
-          bbDerivableHashes = case sBlockHashVersionFor sProtocolVersion of
+          bbDerivableHashes = case sBlockHashVersionFor (protocolVersion @pv) of
             SBlockHashVersion0 ->
                 DerivableBlockHashesV0
                     { dbhv0TransactionOutcomesHash = TransactionOutcomesHash dummyHash,
@@ -149,17 +152,17 @@ dummyBlockItem =
 -- | A helper function for creating a block with the given round and block items.
 --  Blocks with different hashes can then be constructed by calling this function with different rounds.
 --  The blocks are derived from 'dummyBakedBlock' with the supplied round and block items.
-dummyBlock :: SProtocolVersion pv -> Round -> Vector.Vector BlockItem -> Block pv
-dummyBlock sProtocolVersion n ts = NormalBlock $ SignedBlock b h dummyBlockSig
+dummyBlock :: forall pv. (IsProtocolVersion pv) => Round -> Vector.Vector BlockItem -> Block pv
+dummyBlock n ts = NormalBlock $ SignedBlock b h dummyBlockSig
   where
-    b = dummyBakedBlock sProtocolVersion n ts
+    b = dummyBakedBlock n ts
     h = getHash b
 
 -- | A helper function for creating a StoredBlock with the given block height and round, and with no transactions.
 --  Empty 'StoredBlock's with different hashes can then be constructed by calling this function with different rounds.
 --  The blocks are derived from 'dummyBlock' with the supplied height and round, but no block items.
-dummyStoredBlockEmpty :: SProtocolVersion pv -> BlockHeight -> Round -> StoredBlock pv
-dummyStoredBlockEmpty sProtocolVersion h n = StoredBlock blockMeta (dummyBlock sProtocolVersion n Vector.empty) (BlobRef 0)
+dummyStoredBlockEmpty :: forall pv. (IsProtocolVersion pv) => BlockHeight -> Round -> StoredBlock pv
+dummyStoredBlockEmpty h n = StoredBlock blockMeta (dummyBlock n Vector.empty) (BlobRef 0)
   where
     blockMeta =
         BlockMetadata
@@ -170,15 +173,15 @@ dummyStoredBlockEmpty sProtocolVersion h n = StoredBlock blockMeta (dummyBlock s
               bmTransactionsSize = 0,
               bmBlockStateHash =
                 Cond.conditionally
-                    (sBlockStateHashInMetadata (sBlockHashVersionFor sProtocolVersion))
+                    (sBlockStateHashInMetadata (sBlockHashVersionFor (protocolVersion @pv)))
                     (StateHashV0 dummyHash)
             }
 
 -- | A helper function for creating a StoredBlock with the given block height and round, and with one transaction.
 --  'StoredBlock's (with one transaction) with different hashes can then be constructed by calling this function with different rounds.
 --  The blocks are derived from 'dummyBlock' with the supplied height and round, and a singular 'dummyBlockItem'.
-dummyStoredBlockOneTransaction :: SProtocolVersion pv -> BlockHeight -> Round -> StoredBlock pv
-dummyStoredBlockOneTransaction sProtocolVersion height n = StoredBlock blockMeta (dummyBlock sProtocolVersion n $ Vector.singleton dummyBlockItem) (BlobRef 0)
+dummyStoredBlockOneTransaction :: forall pv. (IsProtocolVersion pv) => BlockHeight -> Round -> StoredBlock pv
+dummyStoredBlockOneTransaction height n = StoredBlock blockMeta (dummyBlock n $ Vector.singleton dummyBlockItem) (BlobRef 0)
   where
     blockMeta =
         BlockMetadata
@@ -189,29 +192,29 @@ dummyStoredBlockOneTransaction sProtocolVersion height n = StoredBlock blockMeta
               bmTransactionsSize = 200,
               bmBlockStateHash =
                 Cond.conditionally
-                    (sBlockStateHashInMetadata (sBlockHashVersionFor sProtocolVersion))
+                    (sBlockStateHashInMetadata (sBlockHashVersionFor (protocolVersion @pv)))
                     (StateHashV0 dummyHash)
             }
 
 -- | List of stored blocks used for testing. The heights are chosen so it is tested that the endianness of the stored block heights are correct.
-dummyStoredBlocks :: SProtocolVersion pv -> [StoredBlock pv]
-dummyStoredBlocks sProtocolVersion =
-    [ dummyStoredBlockEmpty sProtocolVersion 1 1,
-      dummyStoredBlockEmpty sProtocolVersion 0x100 2,
-      dummyStoredBlockEmpty sProtocolVersion 0x10000 3,
-      dummyStoredBlockEmpty sProtocolVersion 0x1000000 4,
-      dummyStoredBlockEmpty sProtocolVersion 0x100000000 5,
-      dummyStoredBlockEmpty sProtocolVersion 0x10000000000 6,
-      dummyStoredBlockEmpty sProtocolVersion 0x1000000000000 7,
-      dummyStoredBlockEmpty sProtocolVersion 0x100000000000000 8,
-      dummyStoredBlockEmpty sProtocolVersion 0 9,
-      dummyStoredBlockOneTransaction sProtocolVersion 5 10
+dummyStoredBlocks :: (IsProtocolVersion pv) => [StoredBlock pv]
+dummyStoredBlocks =
+    [ dummyStoredBlockEmpty 1 1,
+      dummyStoredBlockEmpty 0x100 2,
+      dummyStoredBlockEmpty 0x10000 3,
+      dummyStoredBlockEmpty 0x1000000 4,
+      dummyStoredBlockEmpty 0x100000000 5,
+      dummyStoredBlockEmpty 0x10000000000 6,
+      dummyStoredBlockEmpty 0x1000000000000 7,
+      dummyStoredBlockEmpty 0x100000000000000 8,
+      dummyStoredBlockEmpty 0 9,
+      dummyStoredBlockOneTransaction 5 10
     ]
 
 -- | A FinalizationEntry. Both used by 'writeBlocks' and used when testing 'lookupLatestFinalizationEntry'.
 dummyFinalizationEntry :: FinalizationEntry
 dummyFinalizationEntry =
-    let feSuccessorProof = BlockQuasiHash dummyHash
+    let feSuccessorProof = SuccessorProof dummyHash
         feFinalizedQuorumCertificate = dummyQC
         succRound = qcRound feFinalizedQuorumCertificate + 1
         feSuccessorQuorumCertificate =
@@ -238,9 +241,9 @@ runLLMDBTest name action = withTempDirectory "" name $ \path ->
         (\dbhandlers -> runSilentLogger $ runReaderT (runDiskLLDBM action) dbhandlers)
 
 -- | Set up the database with the 'dummyStoredBlocks' finalized.
-setupDummy :: (IsProtocolVersion pv) => SProtocolVersion pv -> DiskLLDBM pv (ReaderT (DatabaseHandlers pv) (LoggerT IO)) ()
-setupDummy sProtocolVersion = do
-    forM_ (dummyStoredBlocks sProtocolVersion) $ \sb ->
+setupDummy :: forall pv. (IsProtocolVersion pv) => SProtocolVersion pv -> DiskLLDBM pv (ReaderT (DatabaseHandlers pv) (LoggerT IO)) ()
+setupDummy _ = do
+    forM_ (dummyStoredBlocks @pv) $ \sb ->
         writeCertifiedBlock
             sb
             dummyQC
@@ -248,7 +251,7 @@ setupDummy sProtocolVersion = do
                   qcRound = blockRound sb,
                   qcEpoch = blockEpoch sb
                 }
-    writeFinalizedBlocks (dummyStoredBlocks sProtocolVersion) dummyFinalizationEntry
+    writeFinalizedBlocks (dummyStoredBlocks @pv) dummyFinalizationEntry
 
 -- | Test that 'lookupLastBlock' returns the block with the greatest height among the dummy blocks.
 --  The dummy blocks are chosen to have a wide range of blockheights to catch possible endianness
@@ -280,17 +283,17 @@ testLookupBlockByHeight sProtocolVersion = runLLMDBTest "lookupBlockByHeightTest
         Just sb -> liftIO $ assertEqual "BlockHeight should be 0x10000" 0x10000 (blockHeight sb)
 
 -- | Test that the function 'memberBlock' returns 'True' for a selected block.
-testMemberBlock :: (IsProtocolVersion pv) => SProtocolVersion pv -> Assertion
+testMemberBlock :: forall pv. (IsProtocolVersion pv) => SProtocolVersion pv -> Assertion
 testMemberBlock sProtocolVersion = runLLMDBTest "memberBlockTest" $ do
     setupDummy sProtocolVersion
-    isMember <- memberBlock $ getHash $ dummyBakedBlock sProtocolVersion 1 Vector.empty
+    isMember <- memberBlock $ getHash $ dummyBakedBlock @pv 1 Vector.empty
     liftIO $ assertBool "isMember should be True" isMember
 
 -- | Test that the function 'lookupBlock' retrieves a selected block.
-testLookupBlock :: (IsProtocolVersion pv) => SProtocolVersion pv -> Assertion
+testLookupBlock :: forall pv. (IsProtocolVersion pv) => SProtocolVersion pv -> Assertion
 testLookupBlock sProtocolVersion = runLLMDBTest "lookupBlockTest" $ do
     setupDummy sProtocolVersion
-    block <- lookupBlock $ getHash $ dummyBakedBlock sProtocolVersion 5 Vector.empty
+    block <- lookupBlock $ getHash $ dummyBakedBlock @pv 5 Vector.empty
     case block of
         Nothing -> liftIO $ assertFailure "Block should be Just"
         Just sb -> liftIO $ assertEqual "BlockHeight should be 0x100000000" 0x100000000 (blockHeight sb)
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs
index 2b57aa8c52..3983ff29aa 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TransactionProcessingTest.hs
@@ -67,6 +67,7 @@ import Concordium.Types.HashableTo
 import Concordium.Types.IdentityProviders
 import Concordium.Types.Option
 import Concordium.Types.Parameters
+import Concordium.Types.TransactionOutcomes
 import Concordium.Types.Transactions
 
 import Concordium.GlobalState.Transactions
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs
index af0e1c169a..50f9f5c618 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/TreeStateTest.hs
@@ -99,6 +99,7 @@ import qualified Concordium.Types.Conditionally as Cond
 import Concordium.Types.Execution
 import Concordium.Types.HashableTo
 import Concordium.Types.Parameters
+import Concordium.Types.TransactionOutcomes
 import Concordium.Types.Transactions
 
 -- konsensus v1 related imports.
@@ -655,7 +656,7 @@ testLookupTransaction _ = describe "lookupTransaction" $ do
 
 -- | Testing 'getNonFinalizedAccountTransactions'
 --  This test ensures that:
---  * An existing non finalized account transction can be looked up
+--  * An existing non finalized account transaction can be looked up
 --  * Looking up with an unknown transaction hash will result in a 'Nothing' result.
 testGetNonFinalizedAccountTransactions ::
     forall pv.
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs
index 373e3eb328..77ecc1658a 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/KonsensusV1/Types.hs
@@ -28,9 +28,9 @@ import Concordium.Types
 import qualified Concordium.Types.DummyData as Dummy
 import Concordium.Types.Option
 import Concordium.Types.Transactions
-import qualified Concordium.Types.Transactions as Transactions
 import qualified Data.FixedByteString as FBS
 
+import qualified Concordium.Types.TransactionOutcomes as TransactionOutcomes
 import qualified ConcordiumTests.KonsensusV1.Common as Common
 
 -- | Generate a 'FinalizerSet'. The size parameter determines the size of the committee that
@@ -107,7 +107,7 @@ genFinalizationEntry :: Gen FinalizationEntry
 genFinalizationEntry = do
     feFinalizedQuorumCertificate <- genQuorumCertificate
     preQC <- genQuorumCertificate
-    feSuccessorProof <- BlockQuasiHash . Hash.Hash . FBS.pack <$> vector 32
+    feSuccessorProof <- SuccessorProof . Hash.Hash . FBS.pack <$> vector 32
     let succRound = qcRound feFinalizedQuorumCertificate + 1
     let sqcEpoch = qcEpoch feFinalizedQuorumCertificate
     let feSuccessorQuorumCertificate =
@@ -243,7 +243,9 @@ genBakedBlock sProtocolVersion = do
             bbStateHash <- StateHashV0 . Hash.Hash . FBS.pack <$> vector 32
             return $
                 DerivableBlockHashesV0
-                    { dbhv0TransactionOutcomesHash = Transactions.emptyTransactionOutcomesHashV1,
+                    { dbhv0TransactionOutcomesHash =
+                        TransactionOutcomes.toTransactionOutcomesHash
+                            TransactionOutcomes.emptyTransactionOutcomesHashV1,
                       dbhv0BlockStateHash = bbStateHash
                     }
         SBlockHashVersion1 -> do
@@ -317,9 +319,9 @@ propSerializeSignedBlock ::
     (IsProtocolVersion pv) =>
     SProtocolVersion pv ->
     Property
-propSerializeSignedBlock sProtocolVersion =
+propSerializeSignedBlock _ =
     forAll (genSignedBlock @pv) $ \sb ->
-        case runGet (getSignedBlock sProtocolVersion (TransactionTime 42)) $! runPut (putSignedBlock sb) of
+        case runGet (getSignedBlock (TransactionTime 42)) $! runPut (putSignedBlock sb) of
             Left _ -> False
             Right sb' -> sb == sb'
 
@@ -406,14 +408,14 @@ propSignQuorumSignatureMessageDiffBody =
                     pubKeys = [(Bls.derivePublicKey someBlsSecretKey), (Bls.derivePublicKey (someOtherBlsSecretKey 1))]
                 in  not (checkQuorumSignature qsm1 pubKeys qs')
 
-propSignBakedBlock :: SProtocolVersion pv -> Property
+propSignBakedBlock :: (IsProtocolVersion pv) => SProtocolVersion pv -> Property
 propSignBakedBlock sProtocolVersion =
     forAll (genBakedBlock sProtocolVersion) $ \bb ->
         forAll genBlockHash $ \genesisHash ->
             forAll genBlockKeyPair $ \kp@(Sig.KeyPair _ pk) ->
                 (verifyBlockSignature pk genesisHash (signBlock kp genesisHash bb))
 
-propSignBakedBlockDiffKey :: SProtocolVersion pv -> Property
+propSignBakedBlockDiffKey :: (IsProtocolVersion pv) => SProtocolVersion pv -> Property
 propSignBakedBlockDiffKey sProtocolVersion =
     forAll (genBakedBlock sProtocolVersion) $ \bb ->
         forAll genBlockHash $ \genesisHash ->
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/MerkleProofs.hs b/concordium-consensus/tests/consensus/ConcordiumTests/MerkleProofs.hs
new file mode 100644
index 0000000000..353ee89854
--- /dev/null
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/MerkleProofs.hs
@@ -0,0 +1,181 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module ConcordiumTests.MerkleProofs where
+
+import qualified Data.ByteString as BS
+import Data.Functor.Identity
+import qualified Data.HashMap.Strict as HM
+import Data.Serialize
+import Test.Hspec
+import Test.QuickCheck
+
+import Concordium.MerkleProofs
+import Concordium.Types
+import Concordium.Types.HashableTo
+import Concordium.Types.Parameters
+
+import Concordium.KonsensusV1.Types
+import Concordium.Types.Option
+
+import ConcordiumTests.KonsensusV1.Common
+import ConcordiumTests.KonsensusV1.Consensus.Blocks
+import ConcordiumTests.KonsensusV1.Types (
+    genBakedBlock,
+    genQuorumCertificate,
+    genTimeoutCertificate,
+ )
+
+-- | Test that the root hash of a quorum certificate Merkle proof matches the hash of the QC.
+propQCMerkleProofMatchesHash :: Property
+propQCMerkleProofMatchesHash = forAll genQuorumCertificate $ \qc ->
+    getHash qc === toRootHash (runIdentity (buildMerkleProof (const True) qc))
+
+-- | Test that the root hash of a timeout certificate Merkle proof matches the hash of the TC.
+propTCMerkleProofMatchesHash :: Property
+propTCMerkleProofMatchesHash = forAll genTimeoutCertificate $ \tc ->
+    getHash (Present tc) === toRootHash (runIdentity (buildMerkleProof (const True) (Present tc)))
+
+-- | Test that the root hash of a baked block Merkle proof matches the block hash.
+propBBMerkleProofMatchesHash ::
+    (IsProtocolVersion pv, BlockHashVersionFor pv ~ 'BlockHashVersion1) =>
+    SProtocolVersion pv ->
+    Property
+propBBMerkleProofMatchesHash spv = forAll (genBakedBlock spv) $ \bb ->
+    blockHash (getHash bb) === toRootHash (runIdentity (buildMerkleProof (const True) bb))
+
+-- | Test that parsing a (full) baked block Merkle proof gives the expected structure.
+propBBMerkleProofParse ::
+    forall pv.
+    (IsProtocolVersion pv, IsConsensusV1 pv, BlockHashVersionFor pv ~ 'BlockHashVersion1) =>
+    SProtocolVersion pv ->
+    Property
+propBBMerkleProofParse spv =
+    conjoin (theTest <$> [testBB1, testBB2, testBB3, testBB2', testBB3', testBB4', testBB3'', testBB1E, testBB2E, testBB3EX])
+        .&&. forAll (genBakedBlock spv) theTest
+  where
+    theTest :: BakedBlock pv -> Property
+    theTest bb@BakedBlock{..} =
+        let proof = runIdentity (buildMerkleProof (const True) bb)
+        in  case uncurry parseMerkleProof blockSchema proof of
+                Left err -> counterexample ("Failed to parse proof" ++ show err) False
+                Right (pt, hsh) ->
+                    blockHash (getHash bb) === hsh
+                        .&&. pt
+                            === HM.fromList
+                                [   ( "header",
+                                      Node
+                                        ( HM.fromList
+                                            [ ("epoch", Leaf (encode bbEpoch)),
+                                              ("parent", Leaf (encode (qcBlock bbQuorumCertificate))),
+                                              ("round", Leaf (encode bbRound))
+                                            ]
+                                        )
+                                    ),
+                                    ( "quasi",
+                                      Node
+                                        ( HM.fromList
+                                            [   ( "data",
+                                                  Node
+                                                    ( HM.fromList
+                                                        [ ("transactions", Leaf (encode (computeTransactionsHash SBlockHashVersion1 bbTransactions))),
+                                                          ("result", Leaf (encode (case bbDerivableHashes of DerivableBlockHashesV1{..} -> dbhv1BlockResultHash)))
+                                                        ]
+                                                    )
+                                                ),
+                                                ( "meta",
+                                                  Node
+                                                    ( HM.fromList
+                                                        [   ( "certificatesHash",
+                                                              Node
+                                                                ( HM.fromList
+                                                                    [   ( "timeoutFinalization",
+                                                                          Node
+                                                                            ( HM.fromList
+                                                                                [ ("epochFinalizationEntry", Node finEntry),
+                                                                                  ("timeoutCertificate", Node timeoutCert)
+                                                                                ]
+                                                                            )
+                                                                        ),
+                                                                      ("quorumCertificate", Node quorumCert)
+                                                                    ]
+                                                                )
+                                                            ),
+                                                            ( "bakerInfo",
+                                                              Node
+                                                                ( HM.fromList
+                                                                    [   ( "nonce",
+                                                                          Node
+                                                                            ( HM.fromList
+                                                                                [ ("blockNonce", Leaf (encode bbNonce))
+                                                                                ]
+                                                                            )
+                                                                        ),
+                                                                        ( "timestampBaker",
+                                                                          Node
+                                                                            ( HM.fromList
+                                                                                [ ("bakerId", Leaf (encode bbBaker)),
+                                                                                  ("timestamp", Leaf (encode bbTimestamp))
+                                                                                ]
+                                                                            )
+                                                                        )
+                                                                    ]
+                                                                )
+                                                            )
+                                                        ]
+                                                    )
+                                                )
+                                            ]
+                                        )
+                                    )
+                                ]
+                  where
+                    finalizerQCRoundsFor rounds =
+                        Node . HM.fromList . zip [show n | n <- [0 :: Integer ..]] $
+                            ( \(rnd, finSet) ->
+                                Node (HM.fromList [("round", Leaf (encode rnd)), ("finalizers", Leaf (encodeFinSet finSet))])
+                            )
+                                <$> finalizerRoundsList rounds
+                    encodeFinSet finSet = BS.drop 4 (encode finSet)
+                    timeoutCert = case bbTimeoutCertificate of
+                        Absent -> HM.fromList [("null", Leaf "")]
+                        Present TimeoutCertificate{..} ->
+                            HM.fromList
+                                [ ("round", Leaf (encode tcRound)),
+                                  ("minEpoch", Leaf (encode tcMinEpoch)),
+                                  ("finalizerQCRoundsFirstEpoch", finalizerQCRoundsFor tcFinalizerQCRoundsFirstEpoch),
+                                  ("finalizerQCRoundsSecondEpoch", finalizerQCRoundsFor tcFinalizerQCRoundsSecondEpoch),
+                                  ("aggregateSignature", Leaf (encode tcAggregateSignature))
+                                ]
+                    finEntry = case bbEpochFinalizationEntry of
+                        Absent -> HM.fromList [("null", Leaf "")]
+                        Present FinalizationEntry{..} ->
+                            HM.fromList
+                                [ ("finalizedBlock", Leaf (encode (qcBlock feFinalizedQuorumCertificate))),
+                                  ("finalizedRound", Leaf (encode (qcRound feFinalizedQuorumCertificate))),
+                                  ("epoch", Leaf (encode (qcEpoch feFinalizedQuorumCertificate))),
+                                  ("finalizedAggregateSignature", Leaf (encode (qcAggregateSignature feFinalizedQuorumCertificate))),
+                                  ("finalizedSignatories", Leaf (encodeFinSet (qcSignatories feFinalizedQuorumCertificate))),
+                                  ("successorAggregateSignature", Leaf (encode (qcAggregateSignature feSuccessorQuorumCertificate))),
+                                  ("successorSignatories", Leaf (encodeFinSet (qcSignatories feSuccessorQuorumCertificate))),
+                                  ("successorProof", Leaf (encode feSuccessorProof))
+                                ]
+                    quorumCert =
+                        let QuorumCertificate{..} = bbQuorumCertificate
+                        in  HM.fromList
+                                [ ("block", Leaf (encode qcBlock)),
+                                  ("round", Leaf (encode qcRound)),
+                                  ("epoch", Leaf (encode qcEpoch)),
+                                  ("aggregateSignature", Leaf (encode qcAggregateSignature)),
+                                  ("signatories", Leaf (encodeFinSet qcSignatories))
+                                ]
+
+tests :: Spec
+tests = describe "MerkleProofs" $ parallel $ do
+    it "Check hash result for QuorumCertificate" propQCMerkleProofMatchesHash
+    it "Check hash result for TimeoutCertificate" propTCMerkleProofMatchesHash
+    forEveryProtocolVersionBHV1 $ \spv pvString -> describe pvString $ do
+        it "Check hash result for BakedBlock" (propBBMerkleProofMatchesHash spv)
+        it "Correct parse of BakedBlock proof" (propBBMerkleProofParse spv)
diff --git a/concordium-consensus/tests/consensus/ConcordiumTests/Update.hs b/concordium-consensus/tests/consensus/ConcordiumTests/Update.hs
index 5176a4e981..7a0e25a2ea 100644
--- a/concordium-consensus/tests/consensus/ConcordiumTests/Update.hs
+++ b/concordium-consensus/tests/consensus/ConcordiumTests/Update.hs
@@ -35,7 +35,7 @@ import Concordium.GlobalState.Block
 import qualified Concordium.GlobalState.BlockPointer as BS
 import Concordium.GlobalState.Parameters
 import Concordium.Types.IdentityProviders
-import Concordium.Types.Transactions
+import Concordium.Types.TransactionOutcomes
 
 import Concordium.Logger
 
diff --git a/concordium-consensus/tests/consensus/Spec.hs b/concordium-consensus/tests/consensus/Spec.hs
index 950e51696a..e552c183a1 100644
--- a/concordium-consensus/tests/consensus/Spec.hs
+++ b/concordium-consensus/tests/consensus/Spec.hs
@@ -22,6 +22,7 @@ import qualified ConcordiumTests.KonsensusV1.TransactionProcessingTest (tests)
 import qualified ConcordiumTests.KonsensusV1.TreeStateTest (tests)
 import qualified ConcordiumTests.KonsensusV1.Types (tests)
 import qualified ConcordiumTests.LeaderElectionTest (tests)
+import qualified ConcordiumTests.MerkleProofs (tests)
 import qualified ConcordiumTests.PassiveFinalization (test)
 import qualified ConcordiumTests.ReceiveTransactionsTest (test)
 import qualified ConcordiumTests.Update (test)
@@ -67,3 +68,4 @@ main = atLevel $ \lvl -> hspec $ do
     ConcordiumTests.KonsensusV1.CatchUp.tests
     ConcordiumTests.EndToEnd.CredentialDeploymentTests.tests lvl
     ConcordiumTests.EndToEnd.TransactionTableIntegrationTest.tests
+    ConcordiumTests.MerkleProofs.tests
diff --git a/concordium-consensus/tests/globalstate/Basic/AccountTable.hs b/concordium-consensus/tests/globalstate/Basic/AccountTable.hs
deleted file mode 100644
index 7be9eb05d2..0000000000
--- a/concordium-consensus/tests/globalstate/Basic/AccountTable.hs
+++ /dev/null
@@ -1,138 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE DataKinds #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeFamilies #-}
-{-# LANGUAGE ViewPatterns #-}
-
-module Basic.AccountTable where
-
-import qualified Concordium.Crypto.SHA256 as H
-import Concordium.GlobalState.Basic.BlockState.Account
-import Concordium.Types
-import Concordium.Types.HashableTo
-import Data.Bits
-import Data.Word
-import Lens.Micro.Internal (Index, IxValue, Ixed)
-import Lens.Micro.Platform
-import Prelude hiding (lookup)
-
-data AccountTable (av :: AccountVersion) = Empty | Tree !(AT av)
-
-instance HashableTo H.Hash (AccountTable av) where
-    getHash Empty = H.hash "EmptyLFMBTree" -- this is the definition in the persistent implementation, I think it is acceptable to define it this way in the basic one
-    getHash (Tree t) = getHash t
-
-data AT (av :: AccountVersion)
-    = Branch !Word8 !Bool !H.Hash !(AT av) !(AT av)
-    | Leaf !(AccountHash av) (Account av)
-
-instance HashableTo H.Hash (AT av) where
-    getHash (Branch _ _ h _ _) = h
-    getHash (Leaf (AccountHash h) _) = h
-
-nextLevel :: AT av -> Word8
-nextLevel (Branch lvl _ _ _ _) = lvl + 1
-nextLevel (Leaf _ _) = 0
-
-full :: AT av -> Bool
-full (Branch _ f _ _ _) = f
-full (Leaf _ _) = True
-
-mkLeaf :: (IsAccountVersion av) => Account av -> AT av
-mkLeaf acct = Leaf (getHash acct) acct
-{-# INLINE mkLeaf #-}
-
-mkBranch :: Word8 -> Bool -> AT av -> AT av -> AT av
-mkBranch lvl f l r = Branch lvl f (H.hashShort $ H.hashToShortByteString (getHash l) <> H.hashToShortByteString (getHash r)) l r
-{-# INLINE mkBranch #-}
-
-empty :: AccountTable av
-empty = Empty
-
-lookup' :: AccountIndex -> AT av -> Maybe (Account av)
-lookup' 0 (Leaf _ acct) = Just acct
-lookup' _ (Leaf _ _) = Nothing
-lookup' x (Branch (fromIntegral -> branchBit) _ _ l r)
-    | testBit x branchBit = lookup' (clearBit x branchBit) r
-    | otherwise = lookup' x l
-
-lookup :: AccountIndex -> AccountTable av -> Maybe (Account av)
-lookup _ Empty = Nothing
-lookup x (Tree t) = lookup' x t
-
-append :: forall av. (IsAccountVersion av) => Account av -> AccountTable av -> (AccountIndex, AccountTable av)
-append acct Empty = (0, Tree (Leaf (getHash acct) acct))
-append acct (Tree t) = append' t & _2 %~ Tree
-  where
-    append' :: AT av -> (AccountIndex, AT av)
-    append' l@(Leaf h _) = (1, Branch 0 True branchHash l newLeaf)
-      where
-        branchHash =
-            H.hashShort $
-                H.hashToShortByteString (theAccountHash h)
-                    <> H.hashToShortByteString (theAccountHash newHash)
-    append' b@(Branch lvl True _ _ _) = (bit (fromIntegral lvl + 1), mkBranch (lvl + 1) False b newLeaf)
-    append' (Branch lvl False _ l r) =
-        let (i', r') = append' r
-        in  ( setBit i' (fromIntegral lvl),
-              mkBranch lvl (full r' && nextLevel r' == lvl) l r'
-            )
-    newLeaf = Leaf newHash acct
-    newHash = getHash acct
-
--- | Get the size of an 'AccountTable'.
-size :: AccountTable av -> Word64
-size Empty = 0
-size (Tree t) = size' t
-  where
-    size' (Leaf _ _) = 1
-    size' (Branch lvl True _ _ _) = bit (fromIntegral lvl + 1)
-    size' (Branch lvl False _ _ r) = setBit (size' r) (fromIntegral lvl)
-
-type instance Index (AT av) = AccountIndex
-type instance IxValue (AT av) = Account av
-
-instance (IsAccountVersion av) => Ixed (AT av) where
-    ix i upd l@(Leaf _ acct)
-        | i == 0 = mkLeaf <$> upd acct
-        | otherwise = pure l
-    ix i upd (Branch lvl f _ l r)
-        | testBit i (fromIntegral lvl) = mkBranch lvl f l <$> ix (clearBit i (fromIntegral lvl)) upd r
-        | otherwise = (\l' -> mkBranch lvl f l' r) <$> ix i upd l
-
-type instance Index (AccountTable av) = AccountIndex
-type instance IxValue (AccountTable av) = Account av
-
-instance (IsAccountVersion av) => Ixed (AccountTable av) where
-    ix _ _ Empty = pure Empty
-    ix i upd a@(Tree t)
-        | i < bit (fromIntegral (nextLevel t)) = Tree <$> ix i upd t
-        | otherwise = pure a
-
-toList :: AccountTable av -> [(AccountIndex, Account av)]
-toList Empty = []
-toList (Tree t) = toL 0 t
-  where
-    toL o (Leaf _ a) = [(o, a)]
-    toL o (Branch lvl _ _ t1 t2) = toL o t1 ++ toL (setBit o (fromIntegral lvl)) t2
-
--- | Convert the account table to a list of accounts with their hashes.
---  The accounts are in ascending index order.
-toHashedList :: AccountTable av -> [Hashed' (AccountHash av) (Account av)]
-toHashedList Empty = []
-toHashedList (Tree t) = toHL t
-  where
-    toHL (Leaf h a) = [Hashed a h]
-    toHL (Branch _ _ _ t1 t2) = toHL t1 ++ toHL t2
-
--- | Strict fold over the account table in increasing order of account index.
-foldl' :: (a -> Account av -> a) -> a -> AccountTable av -> a
-foldl' _ a Empty = a
-foldl' f !a0 (Tree t) = ft a0 t
-  where
-    ft a (Leaf _ acct) = f a acct
-    ft a (Branch _ _ _ l r) =
-        let !a1 = ft a l
-            !a2 = ft a1 r
-        in  a2
diff --git a/concordium-consensus/tests/globalstate/Basic/Accounts.hs b/concordium-consensus/tests/globalstate/Basic/Accounts.hs
index 3a51cc50b2..2a0769f548 100644
--- a/concordium-consensus/tests/globalstate/Basic/Accounts.hs
+++ b/concordium-consensus/tests/globalstate/Basic/Accounts.hs
@@ -1,15 +1,18 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
 module Basic.Accounts where
 
-import qualified Concordium.Crypto.SHA256 as H
 import Concordium.Genesis.Data
 import qualified Concordium.GlobalState.AccountMap as AccountMap
 import Concordium.GlobalState.Basic.BlockState.Account
 import Concordium.GlobalState.Basic.BlockState.AccountReleaseSchedule
+import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMBTree
+import Concordium.GlobalState.BlockState (AccountsHash (..))
 import Concordium.ID.Parameters
 import qualified Concordium.ID.Types as ID
 import Concordium.Types
@@ -18,13 +21,12 @@ import Concordium.Types.HashableTo
 import Control.Monad
 import Data.Foldable
 import qualified Data.Map.Strict as Map
+import qualified Data.Sequence as Seq
 import Data.Serialize
 import GHC.Stack (HasCallStack)
 import Lens.Micro.Internal (Index, IxValue, Ixed)
 import Lens.Micro.Platform
 
-import qualified Basic.AccountTable as AT
-
 -- | Representation of the set of accounts on the chain.
 --  Each account has an 'AccountIndex' which is the order
 --  in which it was created.
@@ -46,7 +48,7 @@ data Accounts (pv :: ProtocolVersion) = Accounts
     { -- | Unique index of accounts by 'AccountAddress'
       accountMap :: !(AccountMap.PureAccountMap pv),
       -- | Hashed Merkle-tree of the accounts.
-      accountTable :: !(AT.AccountTable (AccountVersionFor pv)),
+      accountTable :: !(Seq.Seq (Account (AccountVersionFor pv))),
       -- | A mapping of 'ID.CredentialRegistrationID's to accounts on which they are used.
       accountRegIds :: !(Map.Map ID.RawCredentialRegistrationID AccountIndex)
     }
@@ -54,11 +56,12 @@ data Accounts (pv :: ProtocolVersion) = Accounts
 instance (IsProtocolVersion pv) => Show (Accounts pv) where
     show Accounts{..} = "Accounts {\n" ++ (concatMap showAcct . AccountMap.toListPure $ accountMap) ++ "accountRegIds = " ++ show accountRegIds ++ "\n}"
       where
-        showAcct (addr, ind) = show addr ++ " => " ++ maybe "MISSING" show (accountTable ^? ix ind) ++ "\n"
+        showAcct (addr, ind) =
+            show addr ++ " => " ++ maybe "MISSING" show (accountTable ^? ix (fromIntegral ind)) ++ "\n"
 
 -- | An 'Accounts' with no accounts.
 emptyAccounts :: Accounts pv
-emptyAccounts = Accounts AccountMap.empty AT.Empty Map.empty
+emptyAccounts = Accounts AccountMap.empty Seq.Empty Map.empty
 
 -- | Add or modify a given account.
 --  If an account matching the given account's address does not exist,
@@ -78,10 +81,11 @@ putAccount !acct = snd . putAccountWithIndex acct
 putAccountWithIndex :: (IsProtocolVersion pv) => Account (AccountVersionFor pv) -> Accounts pv -> (AccountIndex, Accounts pv)
 putAccountWithIndex !acct Accounts{..} =
     case AccountMap.lookupPure addr accountMap of
-        Nothing ->
-            let (i, newAccountTable) = AT.append acct accountTable
-            in  (i, Accounts (AccountMap.insertPure addr i accountMap) newAccountTable accountRegIds)
-        Just i -> (i, Accounts accountMap (accountTable & ix i .~ acct) accountRegIds)
+        Nothing -> (i, Accounts (AccountMap.insertPure addr i accountMap) newAccountTable accountRegIds)
+          where
+            i = fromIntegral $ Seq.length accountTable
+            newAccountTable = accountTable Seq.|> acct
+        Just i -> (i, Accounts accountMap (accountTable & ix (fromIntegral i) .~ acct) accountRegIds)
   where
     addr = acct ^. accountAddress
 
@@ -109,7 +113,7 @@ exists addr Accounts{..} = AccountMap.isAddressAssignedPure addr accountMap
 getAccount :: (IsProtocolVersion pv) => AccountAddress -> Accounts pv -> Maybe (Account (AccountVersionFor pv))
 getAccount addr Accounts{..} = case AccountMap.lookupPure addr accountMap of
     Nothing -> Nothing
-    Just i -> accountTable ^? ix i
+    Just i -> accountTable ^? ix (fromIntegral i)
 
 getAccountIndex :: (IsProtocolVersion pv) => AccountAddress -> Accounts pv -> Maybe AccountIndex
 getAccountIndex addr Accounts{..} = AccountMap.lookupPure addr accountMap
@@ -119,11 +123,11 @@ getAccountIndex addr Accounts{..} = AccountMap.lookupPure addr accountMap
 getAccountWithIndex :: (IsProtocolVersion pv) => AccountAddress -> Accounts pv -> Maybe (AccountIndex, Account (AccountVersionFor pv))
 getAccountWithIndex addr Accounts{..} = case AccountMap.lookupPure addr accountMap of
     Nothing -> Nothing
-    Just i -> (i,) <$> accountTable ^? ix i
+    Just i -> (i,) <$> accountTable ^? ix (fromIntegral i)
 
 -- | Traversal for accessing the account at a given index.
 indexedAccount :: (IsProtocolVersion pv) => AccountIndex -> Traversal' (Accounts pv) (Account (AccountVersionFor pv))
-indexedAccount ai = lens accountTable (\a v -> a{accountTable = v}) . ix ai
+indexedAccount ai = lens accountTable (\a v -> a{accountTable = v}) . ix (fromIntegral ai)
 
 -- | Lens for accessing the account at a given index, assuming the account exists.
 --  If the account does not exist, this throws an error.
@@ -163,7 +167,7 @@ updateAccount !upd =
 unsafeGetAccount :: (IsProtocolVersion pv) => AccountAddress -> Accounts pv -> Account (AccountVersionFor pv)
 unsafeGetAccount addr Accounts{..} = case AccountMap.lookupPure addr accountMap of
     Nothing -> error $ "unsafeGetAccount: Account " ++ show addr ++ " does not exist."
-    Just i -> accountTable ^?! ix i
+    Just i -> accountTable ^?! ix (fromIntegral i)
 
 -- | Check whether the given address would clash with any existing addresses in
 --  the accounts structure. The meaning of this depends on the protocol version.
@@ -189,8 +193,12 @@ recordRegIds rids accs = accs{accountRegIds = Map.union (accountRegIds accs) (Ma
 
 -- since credentials can only be used on one account the union is well-defined, the maps should be disjoint.
 
-instance HashableTo H.Hash (Accounts pv) where
-    getHash Accounts{..} = getHash accountTable
+instance (IsProtocolVersion pv) => HashableTo (AccountsHash pv) (Accounts pv) where
+    getHash =
+        AccountsHash
+            . LFMBTree.theLFMBTreeHash
+            . LFMBTree.lfmbtHash (sBlockHashVersionFor (protocolVersion @pv))
+            . accountTable
 
 type instance Index (Accounts pv) = AccountAddress
 type instance IxValue (Accounts pv) = (Account (AccountVersionFor pv))
@@ -199,21 +207,21 @@ instance (IsProtocolVersion pv) => Ixed (Accounts pv) where
     ix addr f acc@Accounts{..} =
         case AccountMap.lookupPure addr accountMap of
             Nothing -> pure acc
-            Just i -> (\atable -> acc{accountTable = atable}) <$> ix i f accountTable
+            Just i -> (\atable -> acc{accountTable = atable}) <$> ix (fromIntegral i) f accountTable
 
 -- | Convert an 'Accounts' to a list of 'Account's with their indexes.
 accountList :: Accounts pv -> [(AccountIndex, Account (AccountVersionFor pv))]
-accountList = AT.toList . accountTable
+accountList = zip [0 ..] . toList . accountTable
 
 -- | Fold over the account table in ascending order of account index.
 foldAccounts :: (a -> Account (AccountVersionFor pv) -> a) -> a -> Accounts pv -> a
-foldAccounts f a = AT.foldl' f a . accountTable
+foldAccounts f a = foldl' f a . accountTable
 
 -- | Serialize 'Accounts' in V0 format.
 serializeAccounts :: (IsProtocolVersion pv) => GlobalContext -> Putter (Accounts pv)
 serializeAccounts cryptoParams Accounts{..} = do
-    putWord64be $ AT.size accountTable
-    forM_ (AT.toList accountTable) $ \(_, acct) -> serializeAccount cryptoParams acct
+    putWord64be $ fromIntegral $ Seq.length accountTable
+    forM_ accountTable $ \acct -> serializeAccount cryptoParams acct
 
 -- | Deserialize 'Accounts'. The serialization format may depend on the protocol version.
 --  The state migration determines how do construct an 'Accounts' at a new protocol version 'pv'
@@ -245,7 +253,7 @@ deserializeAccounts migration cryptoParams = do
                     (i + 1)
                     Accounts
                         { accountMap = AccountMap.insertPure (acct ^. accountAddress) acctId accountMap,
-                          accountTable = snd (AT.append acct accountTable),
+                          accountTable = accountTable Seq.|> acct,
                           accountRegIds = newRegIds
                         }
             | otherwise = return accts
diff --git a/concordium-consensus/tests/globalstate/Basic/InstanceTable.hs b/concordium-consensus/tests/globalstate/Basic/InstanceTable.hs
deleted file mode 100644
index 96aa06e254..0000000000
--- a/concordium-consensus/tests/globalstate/Basic/InstanceTable.hs
+++ /dev/null
@@ -1,214 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Basic.InstanceTable where
-
-import qualified Concordium.Crypto.SHA256 as H
-import Concordium.GlobalState.Instance
-import Concordium.Types
-import Concordium.Types.HashableTo
-
-import Data.Serialize
-import Data.Word
-import Lens.Micro.Internal (Index, IxValue, Ixed)
-import Lens.Micro.Platform
-
-data InstanceTable
-    = -- | The empty instance table
-      Empty
-    | -- | A non-empty instance table (recording the number of instances present)
-      Tree !Word64 !IT
-    deriving (Show)
-
-computeBranchHash :: IT -> IT -> H.Hash
-computeBranchHash t1 t2 = H.hashShort $! (H.hashToShortByteString (getHash t1 :: H.Hash) <> H.hashToShortByteString (getHash t2 :: H.Hash))
-
--- | Internal tree nodes of an 'InstanceTable'.
---  Branches satisfy the following invariant properties:
---  * The left branch is always a full sub-tree with height 1 less than the parent (or a leaf if the parent height is 0)
---  * The right branch has height less than the parent
---  * The hash is @computeBranchHash l r@ where @l@ and @r@ are the left and right subtrees
---  * The first @Bool@ is @True@ if the tree is full, i.e. the right sub-tree is full with height 1 less than the parent
---  * The second @Bool@ is @True@ if the tree has vacant leaves: either @hasVacancies l@ or @hasVacancies r@ is @True@
-data IT
-    = -- | A branch has the following fields:
-      --  * the height of the branch (0 if all children are leaves)
-      --  * whether the branch is a full binary tree
-      --  * whether the tree has vacant leaves
-      --  * the Merkle hash (lazy)
-      --  * the left and right subtrees
-      Branch !Word8 !Bool !Bool H.Hash IT IT
-    | -- | A leaf holds a contract instance
-      Leaf !BasicInstance
-    | -- | A vacant leaf records the 'ContractSubindex' of the last instance
-      --  with this 'ContractIndex'.
-      VacantLeaf !ContractSubindex
-    deriving (Show)
-
-instance HashableTo H.Hash IT where
-    getHash (Branch _ _ _ h _ _) = h
-    getHash (Leaf i) = getHash i
-    getHash (VacantLeaf si) = H.hash $ runPut $ put si
-
-instance HashableTo H.Hash InstanceTable where
-    -- The hash of the empty tree is defined arbitrarily to be the hash of the string "EmptyInstances"
-    getHash Empty = H.hash "EmptyInstances"
-    getHash (Tree _ t) = getHash t
-
--- | A fold over the leaves of an 'IT'
-foldIT :: SimpleFold IT (Either ContractSubindex BasicInstance)
-foldIT up (Branch _ _ _ _ l r) = foldIT up l <> foldIT up r
-foldIT up t@(Leaf i) = t <$ up (Right i)
-foldIT up t@(VacantLeaf si) = t <$ up (Left si)
-
-type instance Index IT = ContractIndex
-type instance IxValue IT = BasicInstance
-
-instance Ixed IT where
-    ix i upd br@(Branch b f v _ t1 t2)
-        | i < 2 ^ b = mkBranch <$> ix i upd t1 <*> pure t2
-        | i < 2 ^ (b + 1) = mkBranch t1 <$> (ix (i - 2 ^ b) upd t2)
-        | otherwise = pure br
-      where
-        mkBranch t1' t2' = Branch b f v (computeBranchHash t1' t2') t1' t2'
-    ix i upd l@(Leaf inst)
-        | i == 0 = Leaf <$> upd inst
-        | otherwise = pure l
-    ix _ _ v@(VacantLeaf _) = pure v
-
-type instance Index InstanceTable = ContractAddress
-type instance IxValue InstanceTable = BasicInstance
-
-instance Ixed InstanceTable where
-    ix _ _ t@Empty = pure t
-    ix i upd (Tree s t) = Tree s <$> (ix (contractIndex i) . filtered ((== i) . instanceAddress)) upd t
-
--- | Determine if an 'IT' is a full binary tree.
-isFull :: IT -> Bool
-isFull (Branch _ f _ _ _ _) = f
-isFull _ = True
-
--- | The height for the level above.
-nextHeight :: IT -> Word8
-nextHeight (Branch h _ _ _ _ _) = h + 1
-nextHeight _ = 0
-
-hasVacancies :: IT -> Bool
-hasVacancies (Branch _ _ v _ _ _) = v
-hasVacancies (Leaf _) = False
-hasVacancies (VacantLeaf _) = True
-
-newContractInstance :: Lens InstanceTable InstanceTable ContractAddress BasicInstance
-newContractInstance mk Empty = Tree 1 . Leaf <$> mk (ContractAddress 0 0)
-newContractInstance mk (Tree s0 t0) = Tree (s0 + 1) <$> nci 0 t0
-  where
-    -- Insert into a tree with vacancies: insert in left if it has vacancies, otherwise right
-    nci offset (Branch h f True _ l r)
-        | hasVacancies l = let newBranch l' = mkBranch h f (hasVacancies l' || hasVacancies r) l' r in newBranch <$> nci offset l
-        | hasVacancies r = let newBranch r' = mkBranch h f (hasVacancies r') l r' in newBranch <$> nci (offset + 2 ^ h) r
-        | otherwise = error "newContractInstance: branch has vacancies, but children do not"
-    -- Insert into full tree with no vacancies: create new branch at top level
-    nci offset b@(Branch h True False _ _ _) = mkBranch (h + 1) False False b <$> (leaf (offset + 2 ^ (h + 1)) 0)
-    -- Insert into non-full tree with no vacancies: insert on right subtree (invariant implies left is full, but can add to right)
-    nci offset (Branch h False False _ l r) = newBranch <$> nci (offset + 2 ^ h) r
-      where
-        newBranch r' = mkBranch h (isFull r' && nextHeight r' == h) False l r'
-    -- Insert at leaf: create a new branch
-    nci offset b@(Leaf _) = mkBranch 0 True False b <$> (leaf (offset + 1) 0)
-    -- Insert at vacant leaf: create leaf with next subindex
-    nci offset (VacantLeaf si) = leaf offset (succ si)
-    mkBranch h f v t1' t2' = Branch h f v (computeBranchHash t1' t2') t1' t2'
-    leaf ind subind = Leaf <$> mk (ContractAddress ind subind)
-
--- | Delete the contract instance with the given 'ContractIndex'.
-deleteContractInstance :: ContractIndex -> InstanceTable -> InstanceTable
-deleteContractInstance _ Empty = Empty
-deleteContractInstance i0 (Tree s0 t0) = uncurry Tree $ dci i0 t0
-  where
-    dci i l@(Leaf inst)
-        | i == 0 = (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress inst)
-        | otherwise = (s0, l)
-    dci _ vl@(VacantLeaf _) = (s0, vl)
-    dci i b@(Branch h f _ _ l r)
-        | i < 2 ^ h = let (s', l') = dci i l in (s', mkBranch l' r)
-        | i < 2 ^ (h + 1) = let (s', r') = dci (i - 2 ^ h) r in (s', mkBranch l r')
-        | otherwise = (s0, b)
-      where
-        mkBranch t1' t2' = Branch h f (hasVacancies t1' || hasVacancies t2') (computeBranchHash t1' t2') t1' t2'
-
--- | Delete the contract instance at the given 'ContractAddress'.
-deleteContractInstanceExact :: ContractAddress -> InstanceTable -> InstanceTable
-deleteContractInstanceExact _ Empty = Empty
-deleteContractInstanceExact addr (Tree s0 t0) = uncurry Tree $ dci (contractIndex addr) t0
-  where
-    dci i l@(Leaf inst)
-        | i == 0 && addr == instanceAddress inst =
-            (s0 - 1, VacantLeaf $ contractSubindex $ instanceAddress inst)
-        | otherwise = (s0, l)
-    dci _ vl@(VacantLeaf _) = (s0, vl)
-    dci i b@(Branch h f _ _ l r)
-        | i < 2 ^ h = let (s', l') = dci i l in (s', mkBranch l' r)
-        | i < 2 ^ (h + 1) = let (s', r') = dci (i - 2 ^ h) r in (s', mkBranch l r')
-        | otherwise = (s0, b)
-      where
-        mkBranch t1' t2' = Branch h f (hasVacancies t1' || hasVacancies t2') (computeBranchHash t1' t2') t1' t2'
-
--- | Construct an 'InstanceTable' given a monadic function that
---  will be invoked for each 'ContractIndex' in sequence to give
---  the 'ContractSubindex' (for a vacancy) or 'Instance', until
---  the function returns 'Nothing', indicating there are no more
---  instances in the constructed table.
-constructM ::
-    (Monad m) =>
-    (ContractIndex -> m (Maybe (Either ContractSubindex BasicInstance))) ->
-    m InstanceTable
-constructM build = c 0 0 []
-  where
-    -- The list argument is a stack of @Maybe IT@ such that, for each @Just t@ in the list:
-    -- \* @t@ is full (satisfying the invariant properties of 'IT' instances);
-    -- \* The height of @t@ is one less than its index in the list.
-    c !idx !count l =
-        build idx >>= \case
-            Nothing -> return $! collapse0 count l
-            Just (Left si) -> c (idx + 1) count $! bubble (VacantLeaf si) l
-            Just (Right inst) -> c (idx + 1) (count + 1) $! bubble (Leaf inst) l
-    -- Add a new entry to the stack. @t@ is always a full 'IT' at level one
-    -- less than that required for the next index of the stack.
-    bubble t [] = [Just t]
-    bubble t (Nothing : l) = Just t : l
-    bubble t (Just t' : l) = Nothing : (bubble $! mkBranch True t' t) l
-    -- Collapse a stack with the above invariant properties into an 'InstanceTable'.
-    collapse0 _ [] = Empty
-    collapse0 count (Nothing : l) = collapse0 count l
-    collapse0 count (Just t : l) = collapse1 count l t
-    -- Here @t@ is either a non-full tree at the appropriate level of the stack,
-    -- or is a full tree at a lower level.
-    collapse1 count [] t = Tree count t
-    collapse1 count (Nothing : l) t = collapse1 count l t
-    collapse1 count (Just t' : l) t = collapse1 count l (mkBranch False t' t)
-    mkBranch f t1' t2' = Branch (nextHeight t1') f (hasVacancies t1' || hasVacancies t2') (computeBranchHash t1' t2') t1' t2'
-
--- | A collection of smart contract instances.
-newtype Instances = Instances
-    { _instances :: InstanceTable
-    }
-
-makeLenses ''Instances
-
-instance HashableTo H.Hash Instances where
-    getHash = getHash . _instances
-
-type instance Index Instances = ContractAddress
-type instance IxValue Instances = BasicInstance
-
-instance Ixed Instances where
-    ix z = instances . ix z
-
-instance Show Instances where
-    show (Instances Empty) = "Instances {}"
-    show (Instances (Tree _ t)) = "Instances {\n" ++ (concatMap f $ t ^.. foldIT) ++ "}"
-      where
-        f (Left _) = ""
-        f (Right inst) = show inst <> "\n"
diff --git a/concordium-consensus/tests/globalstate/Basic/Instances.hs b/concordium-consensus/tests/globalstate/Basic/Instances.hs
deleted file mode 100644
index b6008b6a78..0000000000
--- a/concordium-consensus/tests/globalstate/Basic/Instances.hs
+++ /dev/null
@@ -1,139 +0,0 @@
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TypeApplications #-}
-
-module Basic.Instances (
-    InstanceParameters (..),
-    Instance (..),
-    InstanceV (..),
-    HasInstanceAddress (..),
-    makeInstance,
-    Instances,
-    emptyInstances,
-    getInstance,
-    updateInstanceAt,
-    updateInstanceAt',
-    createInstance,
-    deleteInstance,
-    foldInstances,
-    instanceCount,
-
-    -- * Serialization
-    putInstancesV0,
-    getInstancesV0,
-) where
-
-import Basic.InstanceTable
-
-import Concordium.GlobalState.Instance
-import qualified Concordium.GlobalState.Wasm as GSWasm
-import Concordium.Types
-import qualified Concordium.Wasm as Wasm
-
-import Data.Serialize
-import qualified Data.Set as Set
-import Data.Word
-import Lens.Micro.Platform
-
--- | The empty set of smart contract instances.
-emptyInstances :: Instances
-emptyInstances = Instances Empty
-
--- | Get the smart contract instance at the given address, if it exists.
-getInstance :: ContractAddress -> Instances -> Maybe BasicInstance
-getInstance addr (Instances iss) = iss ^? ix addr
-
--- | Update the instance at the specified address with an amount delta and
---  potentially new state and module. If new state is not provided the state of the instance
---  is not changed. If a new module is not provided the module of the instance
---  is not changed. If there is no instance with the given address, this does
---  nothing. If the instance at the given address has a different version than
---  given this function raises an exception.
-updateInstanceAt ::
-    forall v.
-    (Wasm.IsWasmVersion v) =>
-    ContractAddress ->
-    AmountDelta ->
-    Maybe (InstanceStateV v) ->
-    Maybe (GSWasm.ModuleInterfaceV v, Set.Set Wasm.ReceiveName) ->
-    Instances ->
-    Instances
-updateInstanceAt ca amt val maybeModule (Instances iss) = Instances (iss & ix ca %~ updateOnlyV)
-  where
-    -- only update if the instance matches the state version. Otherwise raise an exception.
-    updateOnlyV = case Wasm.getWasmVersion @v of
-        Wasm.SV0 -> \case
-            InstanceV0 i -> InstanceV0 $ updateInstanceV amt val Nothing i
-            InstanceV1 _ -> error "Expected a V0 instance, but got V1."
-        Wasm.SV1 -> \case
-            InstanceV0 _ -> error "Expected a V1 instance, but got V0"
-            InstanceV1 i -> InstanceV1 $ updateInstanceV amt val maybeModule i
-
--- | Update the instance at the specified address with a __new amount__ and
---  potentially new state. If new state is not provided the state of the instance
---  is not changed. If a new module is not provided the module of the instance
---  is not changed. If there is no instance with the given address, this does
---  nothing. If the instance at the given address has a different version than
---  given this function raises an exception.
-updateInstanceAt' :: forall v. (Wasm.IsWasmVersion v) => ContractAddress -> Amount -> Maybe (InstanceStateV v) -> Maybe (GSWasm.ModuleInterfaceV v, Set.Set Wasm.ReceiveName) -> Instances -> Instances
-updateInstanceAt' ca amt val maybeModule (Instances iss) = Instances (iss & ix ca %~ updateOnlyV)
-  where
-    -- only update if the instance matches the state version. Otherwise raise an exception.
-    updateOnlyV = case Wasm.getWasmVersion @v of
-        Wasm.SV0 -> \case
-            InstanceV0 i -> InstanceV0 $ updateInstanceV' amt val Nothing i
-            InstanceV1 _ -> error "Expected a V0 instance, but got V1."
-        Wasm.SV1 -> \case
-            InstanceV0 _ -> error "Expected a V1 instance, but got V0"
-            InstanceV1 i -> InstanceV1 $ updateInstanceV' amt val maybeModule i
-
--- | Create a new smart contract instance.
-createInstance :: (ContractAddress -> BasicInstance) -> Instances -> (BasicInstance, Instances)
-createInstance mkInst (Instances iss) = Instances <$> (iss & newContractInstance <%~ mkInst)
-
--- | Delete the instance with the given address.  Does nothing
---  if there is no such instance.
-deleteInstance :: ContractAddress -> Instances -> Instances
-deleteInstance ca (Instances i) = Instances (deleteContractInstanceExact ca i)
-
--- | A fold over smart contract instances.
-foldInstances :: SimpleFold Instances BasicInstance
-foldInstances _ is@(Instances Empty) = is <$ mempty
-foldInstances f is@(Instances (Tree _ t)) = is <$ (foldIT . _Right) f t
-
-instanceCount :: Instances -> Word64
-instanceCount (Instances Empty) = 0
-instanceCount (Instances (Tree c _)) = c
-
--- | Serialize 'Instances' in V0 format.
-putInstancesV0 :: Putter Instances
-putInstancesV0 (Instances Empty) = putWord8 0
-putInstancesV0 (Instances (Tree _ t)) = do
-    mapM_ putOptInstance (t ^.. foldIT)
-    putWord8 0
-  where
-    putOptInstance (Left si) = do
-        putWord8 1
-        put si
-    putOptInstance (Right inst) = do
-        case inst of
-            InstanceV0 i -> do
-                putWord8 2
-                putV0InstanceV0 i
-            InstanceV1 i -> do
-                putWord8 3
-                putV1InstanceV0 i
-
--- | Deserialize 'Instances' in V0 format.
-getInstancesV0 ::
-    (ModuleRef -> Wasm.InitName -> Maybe (Set.Set Wasm.ReceiveName, GSWasm.ModuleInterface GSWasm.InstrumentedModuleV)) ->
-    Get Instances
-getInstancesV0 resolve = Instances <$> constructM buildInstance
-  where
-    buildInstance idx =
-        getWord8 >>= \case
-            0 -> return Nothing
-            1 -> Just . Left <$> get
-            2 -> Just . Right . InstanceV0 <$> getV0InstanceV0 resolve idx
-            3 -> Just . Right . InstanceV1 <$> getV1InstanceV0 resolve idx
-            _ -> fail "Bad instance list"
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs
index 6d329a84d4..08d74272b4 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/Accounts.hs
@@ -5,16 +5,15 @@
 
 module GlobalStateTests.Accounts where
 
-import qualified Basic.AccountTable as BAT
 import qualified Basic.Accounts as B
 import Concordium.Crypto.DummyData
 import Concordium.Crypto.FFIDataTypes
-import qualified Concordium.Crypto.SHA256 as H
 import qualified Concordium.Crypto.SignatureScheme as Sig
 import qualified Concordium.GlobalState.AccountMap as AccountMap
 import qualified Concordium.GlobalState.AccountMap.DifferenceMap as DiffMap
 import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import Concordium.GlobalState.Basic.BlockState.Account as BA
+import Concordium.GlobalState.BlockState (AccountsHash)
 import Concordium.GlobalState.DummyData
 import qualified Concordium.GlobalState.Persistent.Account as PA
 import qualified Concordium.GlobalState.Persistent.Accounts as P
@@ -74,13 +73,13 @@ checkEquivalent :: (P.SupportsPersistentAccount PV m, av ~ AccountVersionFor PV)
 checkEquivalent ba pa = do
     addrsAndIndices <- P.allAccounts pa
     checkBinary (==) (AccountMap.toMapPure (B.accountMap ba)) (Map.fromList addrsAndIndices) "==" "Basic account map" "Persistent account map"
-    let bat = BAT.toList (B.accountTable ba)
+    let bat = B.accountList ba
     pat <- L.toAscPairList (P.accountTable pa)
     bpat <- mapM (_2 PA.toTransientAccount) pat
     checkBinary (==) bat bpat "==" "Basic account table (as list)" "Persistent account table (as list)"
-    let bath = getHash (B.accountTable ba) :: H.Hash
-    path <- getHashM (P.accountTable pa)
-    checkBinary (==) bath path "==" "Basic account table hash" "Persistent account table hash"
+    let bath = getHash ba :: AccountsHash PV
+    path <- getHashM pa
+    checkBinary (==) bath path "==" "Basic accounts hash" "Persistent accounts hash"
     pregids <- P.loadRegIds pa
     checkBinary (==) (B.accountRegIds ba) pregids "==" "Basic registration ids" "Persistent registration ids"
 
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs
index 11f0e54ab2..436748f99b 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/BlockHash.hs
@@ -35,6 +35,7 @@ import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.BlockState (emptyPersistentTransactionOutcomes)
 import Concordium.Types.DummyData
 import Concordium.Types.HashableTo
+import Concordium.Types.TransactionOutcomes
 import Control.Monad.IO.Class
 import System.Random
 
@@ -196,9 +197,13 @@ tests = do
                 defaultHash `shouldNotBe` hash'
 
             specify "Hash of emptyPersistentTransactionOutcomes (TOV0) is hash of emptyTransactionOutcomesV0" $
-                runDummyHashMonad (getHashM @_ @TransactionOutcomesHash (emptyPersistentTransactionOutcomes @'TOV0))
-                    `shouldBe` getHash emptyTransactionOutcomesV0
+                runDummyHashMonad (getHashM (emptyPersistentTransactionOutcomes @'TOV0))
+                    `shouldBe` getHash @(TransactionOutcomesHashV 'TOV0) emptyTransactionOutcomesV0
 
             specify "Hash of emptyPersistentTransactionOutcomes (TOV1) is emptyTransactionOutcomesHashV1" $
-                runDummyHashMonad (getHashM @_ @TransactionOutcomesHash (emptyPersistentTransactionOutcomes @'TOV1))
+                runDummyHashMonad (getHashM (emptyPersistentTransactionOutcomes @'TOV1))
                     `shouldBe` emptyTransactionOutcomesHashV1
+
+            specify "Hash of emptyPersistentTransactionOutcomes (TOV2) is emptyTransactionOutcomesHashV2" $
+                runDummyHashMonad (getHashM (emptyPersistentTransactionOutcomes @'TOV2))
+                    `shouldBe` emptyTransactionOutcomesHashV2
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/Instances.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/Instances.hs
index b0a8c4fbe1..689ec2c904 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/Instances.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/Instances.hs
@@ -1,5 +1,9 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
@@ -14,11 +18,9 @@ import Data.Serialize
 import qualified Data.Set as Set
 import qualified Data.Text as Text
 import Data.Word
-import Lens.Micro.Platform
 
 import qualified Concordium.Crypto.SHA256 as H
 import qualified Concordium.GlobalState.ContractStateV1 as StateV1
-import Concordium.GlobalState.Instance
 import qualified Concordium.GlobalState.Wasm as GSWasm
 import qualified Concordium.Scheduler.WasmIntegration as WasmV0
 import qualified Concordium.Scheduler.WasmIntegration.V1 as WasmV1
@@ -29,9 +31,16 @@ import qualified Concordium.Wasm as Wasm
 import qualified Data.ByteString as BS
 import qualified Data.FixedByteString as FBS
 
-import Basic.InstanceTable
-import Basic.Instances
-
+import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMBTree
+import Concordium.GlobalState.BlockState
+import Concordium.GlobalState.Persistent.BlobStore
+import Concordium.GlobalState.Persistent.BlockState.Modules
+import Concordium.GlobalState.Persistent.Cache
+import qualified Concordium.GlobalState.Persistent.Instances as Instances
+import Concordium.GlobalState.Persistent.MonadicRecursive
+import Concordium.ID.Types (accountAddressSize)
+import Control.Exception
+import Control.Monad.Reader
 import Test.Hspec
 import Test.QuickCheck
 
@@ -59,33 +68,167 @@ validContractArtifactsV1 = mapMaybe packModule contractSourcesV1
         let source = Wasm.ModuleSource sourceBytes
         in  (source,) <$> WasmV1.processModule SP5 (Wasm.WasmModuleV source)
 
-checkBinary :: (Show a) => (a -> a -> Bool) -> a -> a -> String -> String -> String -> Either String ()
-checkBinary bop x y sbop sx sy = unless (bop x y) $ Left $ "Not satisfied: " ++ sx ++ " (" ++ show x ++ ") " ++ sbop ++ " " ++ sy ++ " (" ++ show y ++ ")"
-
-invariantIT :: ContractIndex -> IT -> Either String (Word8, Bool, Bool, ContractIndex, H.Hash, Word64)
-invariantIT offset (Leaf inst) = do
-    checkBinary (==) (contractIndex $ instanceAddress inst) offset "==" "account index" "expected value"
-    return (0, True, False, succ offset, getHash inst, 1)
-invariantIT offset (VacantLeaf si) = return (0, True, True, succ offset, H.hash $ runPut $ put si, 0)
-invariantIT offset (Branch h f v hsh l r) = do
-    (hl, fl, vl, offset', hshl, cl) <- invariantIT offset l
+-- | Assert that a binary predicate holds.
+checkBinary :: (Show a, MonadFail m) => (a -> a -> Bool) -> a -> a -> String -> String -> String -> m ()
+checkBinary bop x y sbop sx sy =
+    unless (bop x y) $
+        fail $
+            "Not satisfied: " ++ sx ++ " (" ++ show x ++ ") " ++ sbop ++ " " ++ sy ++ " (" ++ show y ++ ")"
+
+-- | Check an invariant on 'Instances.IT' (see 'invariantInstances'). The return value is a tuple
+--  consisting of:
+--   * the height of the branch (0 for leaves)
+--   * whether the branch is full (in the tree sense - not in the sense of no vacancies)
+--   * whether the branch has vacancies
+--   * the index of the next leaf
+--   * the Merkle hash of the branch
+invariantIT ::
+    (IsProtocolVersion pv) =>
+    ContractIndex ->
+    Instances.IT pv (BufferedFix (Instances.IT pv)) ->
+    TestMonad (Word8, Bool, Bool, ContractIndex, H.Hash)
+invariantIT offset (Instances.Leaf inst) = do
+    params <- Instances.loadInstanceParameters inst
+    checkBinary (==) (contractIndex $ Instances.pinstanceAddress params) offset "==" "account index" "expected value"
+    return (0, True, False, succ offset, getHash inst)
+invariantIT offset (Instances.VacantLeaf si) = do
+    return (0, True, True, succ offset, H.hash (encode si))
+invariantIT offset (Instances.Branch h f v hsh l r) = do
+    (hl, fl, vl, offset', hshl) <- invariantIT offset =<< mproject l
     checkBinary (==) hl h "==" "sucessor level of left child" "node level"
-    unless fl $ Left "tree is not left-full"
-    (hr, fr, vr, offset'', hshr, cr) <- invariantIT offset' r
+    unless fl $ fail "tree is not left-full"
+    (hr, fr, vr, offset'', hshr) <- invariantIT offset' =<< mproject r
     checkBinary (==) hsh (H.hash $ runPut $ put hshl <> put hshr) "==" "branch hash" "hash(leftHash <> rightHash)"
     checkBinary (<=) hr h "<=" "successor level of right child" "node level"
     checkBinary (==) f (fr && hr == h) "<->" "branch marked full" "right child is full at next lower level"
     checkBinary (==) v (vl || vr) "<->" "branch has vacancies" "at least one child has vacancies"
-    return (succ h, f, v, offset'', hsh, cl + cr)
-
-invariantInstanceTable :: InstanceTable -> Either String ()
-invariantInstanceTable Empty = Right ()
-invariantInstanceTable (Tree c0 t) = do
-    (_, _, _, _, _, c) <- invariantIT 0 t
-    checkBinary (==) c0 c "==" "reported number of instances" "actual number"
+    return (succ h, f, v, offset'', hsh)
+
+-- | Check the following invariant on 'Instances.Instances':
+--   * At each leaf node, the account index matches the index in the table.
+--   * At each branch node:
+--      * The level of the node is 1+ the level of the left child.
+--      * The left child is a full subtree.
+--      * The recorded hash is the hash of the combined hashes of the left and right subtrees.
+--      * The level of the node is at least 1+ the level of the right child.
+--      * The branch is marked full if and only if the right subtree is full.
+--      * The branch has vacancies exactly when at least one subtree has vacancies.
+--   * The root records the correct size of the table.
+invariantInstances :: (IsProtocolVersion pv) => Instances.Instances pv -> TestMonad ()
+invariantInstances Instances.InstancesEmpty = return ()
+invariantInstances (Instances.InstancesTree size bf) = do
+    (_, _, _, ContractIndex recSize, _) <- invariantIT 0 =<< mproject bf
+    checkBinary (==) recSize size "==" "measured size" "recorded size"
+
+-- | A model for an individual instance.
+data ModelInstance = forall v.
+      (Wasm.IsWasmVersion v) =>
+    ModelInstance
+    { mInstanceParameters :: !Instances.PersistentInstanceParameters,
+      mInstanceModule :: !(Wasm.ModuleSource v),
+      mInstanceInterface :: !(GSWasm.ModuleInterfaceV v),
+      mInstanceState :: !(Instances.InstanceStateV v),
+      mInstanceStateHash :: !Instances.InstanceStateHash,
+      mInstanceAmount :: !Amount
+    }
 
-invariantInstances :: Instances -> Either String ()
-invariantInstances = invariantInstanceTable . _instances
+instance Show ModelInstance where
+    show ModelInstance{..} =
+        "ModelInstance{"
+            ++ "mInstanceParameters = "
+            ++ show mInstanceParameters
+            ++ ", "
+            ++ "mInstanceModule = "
+            ++ show mInstanceModule
+            ++ ", "
+            ++ "mInstanceInterface = "
+            ++ show mInstanceInterface
+            ++ ", "
+            ++ "mInstanceStateHash = "
+            ++ show mInstanceStateHash
+            ++ ", "
+            ++ "mInstanceAmount = "
+            ++ show mInstanceAmount
+            ++ "}"
+
+instance HashableTo H.Hash ModelInstance where
+    getHash (ModelInstance params _ _ (Instances.InstanceStateV0 _) isHash modAmt) =
+        Instances.makeInstanceHashV0 (getHash params) isHash modAmt
+    getHash (ModelInstance params _ _ (Instances.InstanceStateV1 _) isHash modAmt) =
+        Instances.makeInstanceHashV0 (getHash params) isHash modAmt
+
+-- | The address associated with a model of a smart contract instance.
+mInstanceAddr :: ModelInstance -> ContractAddress
+mInstanceAddr = Instances.pinstanceAddress . mInstanceParameters
+
+-- | Construct a 'Instances.PersistentInstance' from a 'ModelInstance'.
+toPersistentInstance :: ModelInstance -> TestMonad (Instances.PersistentInstance pv)
+toPersistentInstance (ModelInstance @v params modSrc iface pinstanceModel _ pinstanceAmount) = do
+    pinstanceParameters <- refMake @_ @BufferedRef params
+    moduleVSource <- storeRef (Wasm.WasmModuleV modSrc)
+    case Wasm.getWasmVersion @v of
+        Wasm.SV0 -> do
+            pinstanceModuleInterface <-
+                refMake
+                    (ModuleV0 ModuleV{moduleVInterface = makePersistentInstrumentedModuleV <$> iface, ..})
+            let pinstanceHash =
+                    Instances.makeInstanceHashV0State
+                        (Instances.pinstanceParameterHash params)
+                        pinstanceModel
+                        pinstanceAmount
+            return $ Instances.PersistentInstanceV0 Instances.PersistentInstanceV{..}
+        Wasm.SV1 -> do
+            pinstanceModuleInterface <-
+                refMake
+                    (ModuleV1 ModuleV{moduleVInterface = makePersistentInstrumentedModuleV <$> iface, ..})
+            pinstanceHash <-
+                Instances.makeInstanceHashV1State
+                    (Instances.pinstanceParameterHash params)
+                    pinstanceModel
+                    pinstanceAmount
+            return $ Instances.PersistentInstanceV1 Instances.PersistentInstanceV{..}
+
+-- | Assert that a 'ModelInstance' matches a 'Instances.PersistentInstance'.
+modelsPersistentInstance :: ModelInstance -> Instances.PersistentInstance pv -> TestMonad Property
+modelsPersistentInstance modInst perInst = do
+    case (modInst, perInst) of
+        (ModelInstance modParams modSrc modIFace modModel@Instances.InstanceStateV0{} _ modAmt, Instances.PersistentInstanceV0 Instances.PersistentInstanceV{..}) -> do
+            perParams <- refLoad pinstanceParameters
+            ModuleV{..} <- unsafeToModuleV <$> refLoad pinstanceModuleInterface
+            perSrc <- loadRef moduleVSource
+            perInstrMod <- mapM loadInstrumentedModuleV moduleVInterface
+            statesProp <- compareStates pinstanceModel modModel
+            return $
+                counterexample "instance parameters" (perParams === modParams)
+                    .&&. counterexample "module source" (Wasm.wmvSource perSrc === modSrc)
+                    .&&. counterexample "module interface" (perInstrMod == modIFace)
+                    .&&. counterexample "instance state" statesProp
+                    .&&. counterexample "amount" (pinstanceAmount === modAmt)
+        (ModelInstance modParams modSrc modIFace modModel@Instances.InstanceStateV1{} _ modAmt, Instances.PersistentInstanceV1 Instances.PersistentInstanceV{..}) -> do
+            perParams <- refLoad pinstanceParameters
+            ModuleV{..} <- unsafeToModuleV <$> refLoad pinstanceModuleInterface
+            perSrc <- loadRef moduleVSource
+            perInstrMod <- mapM loadInstrumentedModuleV moduleVInterface
+            statesProp <- compareStates pinstanceModel modModel
+            return $
+                counterexample "instance parameters" (perParams === modParams)
+                    .&&. counterexample "module source" (Wasm.wmvSource perSrc === modSrc)
+                    .&&. counterexample "module interface" (perInstrMod == modIFace)
+                    .&&. counterexample "instance state" statesProp
+                    .&&. counterexample "amount" (pinstanceAmount === modAmt)
+        _ -> return $ counterexample "instance version mismatch" False
+  where
+    compareStates :: Instances.InstanceStateV v -> Instances.InstanceStateV v -> TestMonad Property
+    compareStates (Instances.InstanceStateV0 cs0) (Instances.InstanceStateV0 cs1) =
+        return (cs0 === cs1)
+    compareStates (Instances.InstanceStateV1 ps0) (Instances.InstanceStateV1 ps1) = do
+        bs0 <- StateV1.toByteString ps0
+        bs1 <- StateV1.toByteString ps1
+        return (bs0 === bs1)
+
+-- | Generate an arbitrary account address.
+genAccountAddress :: Gen AccountAddress
+genAccountAddress = AccountAddress . FBS.pack <$> vector accountAddressSize
 
 -- These generators name contracts as numbers to make sure the names are valid.
 genInitName :: Gen Wasm.InitName
@@ -108,94 +251,169 @@ genReceiveNames = do
         return (i, Set.fromList receives)
     return $ Map.fromList ns
 
+-- | Generate a V0 contract state.
 genV0ContractState :: Gen Wasm.ContractState
 genV0ContractState = do
     n <- choose (1, 1000)
     Wasm.ContractState . BS.pack <$> vector n
 
--- This currently always generates the empty state.
+-- | Generate a V1 contract state.
 genV1ContractState :: Gen StateV1.InMemoryPersistentState
 genV1ContractState = do
     seed <- arbitrary
     len <- choose (0, 10)
     return $ StateV1.generatePersistentTree seed len
 
-makeDummyInstance :: InstanceData -> Gen (ContractAddress -> Instance GSWasm.InstrumentedModuleV)
-makeDummyInstance (InstanceDataV0 model amount) = do
-    let owner = AccountAddress . FBS.pack . replicate 32 $ 0
-    (_, mInterface@GSWasm.ModuleInterface{..}) <- elements validContractArtifactsV0
-    initName <- if Set.null miExposedInit then return (Wasm.InitName "init_") else elements (Set.toList miExposedInit)
-    let receiveNames = fromMaybe Set.empty $ Map.lookup initName miExposedReceive
-    return $ makeInstance initName receiveNames mInterface model amount owner
-makeDummyInstance (InstanceDataV1 model amount) = do
-    let owner = AccountAddress . FBS.pack . replicate 32 $ 1
-    (_, mInterface@GSWasm.ModuleInterface{..}) <- elements validContractArtifactsV1
-    initName <- if Set.null miExposedInit then return (Wasm.InitName "init_") else elements (Set.toList miExposedInit)
-    let receiveNames = fromMaybe Set.empty $ Map.lookup initName miExposedReceive
-    return $ makeInstance initName receiveNames mInterface model amount owner
-
-data InstanceData
-    = InstanceDataV0 (InstanceStateV Wasm.V0) Amount
-    | InstanceDataV1 (InstanceStateV Wasm.V1) Amount
-
-instance Eq InstanceData where
-    (InstanceDataV0 (InstanceStateV0 v1) a1) == (InstanceDataV0 (InstanceStateV0 v2) a2) = v1 == v2 && a1 == a2
-    (InstanceDataV1 v1 a1) == (InstanceDataV1 v2 a2) = encode v1 == encode v2 && a1 == a2
-    _ == _ = False
-
-instance Show InstanceData where
-    show (InstanceDataV0 (InstanceStateV0 v) a) = "V0: " ++ show v ++ ", " ++ show a
-    show (InstanceDataV1 s a) = "V1: " ++ show (encode s) ++ ", " ++ show a
-
-instance Arbitrary InstanceData where
-    arbitrary = oneof [InstanceDataV0 <$> v0 <*> arbitrary, InstanceDataV1 <$> v1 <*> arbitrary]
-      where
-        v0 = InstanceStateV0 <$> genV0ContractState
-        v1 = InstanceStateV1 <$> genV1ContractState
-
-instanceData :: Instance GSWasm.InstrumentedModuleV -> InstanceData
-instanceData (InstanceV0 InstanceV{..}) = InstanceDataV0 _instanceVModel _instanceVAmount
-instanceData (InstanceV1 InstanceV{..}) = InstanceDataV1 _instanceVModel _instanceVAmount
+-- | Generate a model of a contract instance. This produces a function that takes the address and
+--  returns the model instance so that the address can be determined after the non-deterministic
+--  generation of the instance.
+genModelInstance :: Gen (ContractAddress -> ModelInstance)
+genModelInstance = oneof [genV0, genV1]
+  where
+    genV0 = do
+        pinstanceOwner <- genAccountAddress
+        (mInstanceModule, mInstanceInterface@GSWasm.ModuleInterface{..}) <- elements validContractArtifactsV0
+        let pinstanceContractModule = Wasm.getModuleRef (Wasm.WasmModuleV mInstanceModule)
+        pinstanceInitName <- if Set.null miExposedInit then return (Wasm.InitName "init_") else elements (Set.toList miExposedInit)
+        let pinstanceReceiveFuns = fromMaybe Set.empty $ Map.lookup pinstanceInitName miExposedReceive
+        memState <- genV0ContractState
+        let mInstanceStateHash = getHash memState
+        let mInstanceState = Instances.InstanceStateV0 memState
+        mInstanceAmount <- arbitrary
+        return $ \pinstanceAddress ->
+            ModelInstance
+                { mInstanceParameters =
+                    Instances.PersistentInstanceParameters
+                        { pinstanceParameterHash =
+                            Instances.makeInstanceParameterHash
+                                pinstanceAddress
+                                pinstanceOwner
+                                pinstanceContractModule
+                                pinstanceInitName,
+                          ..
+                        },
+                  ..
+                }
+    genV1 = do
+        pinstanceOwner <- genAccountAddress
+        (mInstanceModule, mInstanceInterface@GSWasm.ModuleInterface{..}) <- elements validContractArtifactsV1
+        let pinstanceContractModule = Wasm.getModuleRef (Wasm.WasmModuleV mInstanceModule)
+        pinstanceInitName <- if Set.null miExposedInit then return (Wasm.InitName "init_") else elements (Set.toList miExposedInit)
+        let pinstanceReceiveFuns = fromMaybe Set.empty $ Map.lookup pinstanceInitName miExposedReceive
+        memState <- genV1ContractState
+        let mInstanceStateHash = getHash memState
+            mInstanceState = Instances.InstanceStateV1 . StateV1.makePersistent $ memState
+        mInstanceAmount <- arbitrary
+        return $ \pinstanceAddress ->
+            ModelInstance
+                { mInstanceParameters =
+                    Instances.PersistentInstanceParameters
+                        { pinstanceParameterHash =
+                            Instances.makeInstanceParameterHash
+                                pinstanceAddress
+                                pinstanceOwner
+                                pinstanceContractModule
+                                pinstanceInitName,
+                          ..
+                        },
+                  ..
+                }
 
+-- | Convert an instance table to a list of the hashes of the leaves.
+instancesToHashList :: (IsProtocolVersion pv) => Instances.Instances pv -> TestMonad [H.Hash]
+instancesToHashList Instances.InstancesEmpty = return []
+instancesToHashList (Instances.InstancesTree _ instTab) = go [] =<< mproject instTab
+  where
+    go accum Instances.Branch{..} = do
+        accum' <- go accum =<< mproject branchRight
+        go accum' =<< mproject branchLeft
+    go accum (Instances.Leaf inst) =
+        return $ getHash inst : accum
+    go accum (Instances.VacantLeaf si) =
+        return $ H.hash (encode si) : accum
+
+-- | A model for the instance table.
 data Model = Model
-    { -- Data of instances
-      modelInstances :: Map.Map ContractIndex (ContractSubindex, InstanceData),
-      -- The next free subindex for free indexes
+    { -- | Data of instances
+      modelInstances :: Map.Map ContractIndex ModelInstance,
+      -- | The next free subindex for free indexes
       modelFree :: Map.Map ContractIndex ContractSubindex,
-      -- The lowest index that has never been assigned
+      -- | The lowest index that has never been assigned
       modelBound :: ContractIndex
     }
-    deriving (Eq, Show)
+    deriving (Show)
+
+-- | Convert a model instance table to a list of the hashes of the leaves.
+modelToHashList :: Model -> [H.Hash]
+modelToHashList Model{..} = l 0
+  where
+    l i
+        | i == modelBound = []
+        | Just mi <- Map.lookup i modelInstances = getHash mi : l (succ i)
+        | Just si <- Map.lookup i modelFree = H.hash (encode (si - 1)) : l (succ i)
+        | otherwise = error "Missing leaf in model"
+
+instance (IsProtocolVersion pv) => HashableTo (InstancesHash pv) Model where
+    getHash m@Model{..} =
+        Instances.makeInstancesHash (_contractIndex modelBound) $
+            LFMBTree.hashAsLFMBTV0 emptyHash (modelToHashList m)
+      where
+        emptyHash = H.hash "EmptyInstances"
 
+-- | The initial empty instance table model.
 emptyModel :: Model
 emptyModel = Model Map.empty Map.empty 0
 
-modelGetInstanceData :: ContractAddress -> Model -> Maybe InstanceData
-modelGetInstanceData (ContractAddress ci csi) m = do
-    (csi', idata) <- Map.lookup ci (modelInstances m)
-    guard $ csi == csi'
-    return idata
-
-modelUpdateInstanceAt :: forall v. (Wasm.IsWasmVersion v) => ContractAddress -> Amount -> InstanceStateV v -> Model -> Model
-modelUpdateInstanceAt (ContractAddress ci csi) amt val m = m{modelInstances = Map.adjust upd ci (modelInstances m)}
+-- | Get the model instance at a particular address in the model instance table.
+modelGetInstanceData :: ContractAddress -> Model -> Maybe ModelInstance
+modelGetInstanceData ca@(ContractAddress ci _) m = do
+    inst <- Map.lookup ci (modelInstances m)
+    guard $ ca == mInstanceAddr inst
+    return inst
+
+-- | Update a model instance as a particular address in the model instance table.
+--  This does nothing if the instance does not exist.
+--  If the instance does exist, then it must be of the same version as the supplied state.
+modelUpdateInstanceAt ::
+    forall v.
+    (Wasm.IsWasmVersion v) =>
+    ContractAddress ->
+    Amount ->
+    Instances.InstanceStateV v ->
+    Instances.InstanceStateHash ->
+    Model ->
+    Model
+modelUpdateInstanceAt addr@(ContractAddress ci _) amt val hsh m =
+    m{modelInstances = Map.adjust upd ci (modelInstances m)}
   where
-    upd o@(csi', ex)
-        | csi == csi' = case Wasm.getWasmVersion @v of
-            Wasm.SV0 -> case ex of
-                InstanceDataV0 _ _ -> (csi, InstanceDataV0 val amt)
-                _ -> error "Contract version mismatch."
-            Wasm.SV1 -> case ex of
-                InstanceDataV1 _ _ -> (csi, InstanceDataV1 val amt)
-                _ -> error "Contract version mismatch."
-        | otherwise = o
-
-modelCreateInstance :: (ContractAddress -> Instance GSWasm.InstrumentedModuleV) -> Model -> (ContractAddress, Model)
+    upd inst@ModelInstance{..}
+        | addr == mInstanceAddr inst = case (mInstanceState, val) of
+            (Instances.InstanceStateV0 _, Instances.InstanceStateV0 _) ->
+                ModelInstance
+                    { mInstanceState = val,
+                      mInstanceAmount = amt,
+                      mInstanceStateHash = hsh,
+                      ..
+                    }
+            (Instances.InstanceStateV1 _, Instances.InstanceStateV1 _) ->
+                ModelInstance
+                    { mInstanceState = val,
+                      mInstanceAmount = amt,
+                      mInstanceStateHash = hsh,
+                      ..
+                    }
+            _ -> error "Contract version mismatch."
+        | otherwise = inst
+
+-- | Update a model instance table by creating a new instance. Returns the address of the new
+--  instances as well as the updated model.
+modelCreateInstance :: (ContractAddress -> ModelInstance) -> Model -> (ContractAddress, Model)
 modelCreateInstance mk m
     | null (modelFree m) =
         let ca = ContractAddress (modelBound m) 0
         in  ( ca,
               m
-                { modelInstances = Map.insert (modelBound m) (0, instanceData (mk ca)) (modelInstances m),
+                { modelInstances = Map.insert (modelBound m) (mk ca) (modelInstances m),
                   modelBound = succ $ modelBound m
                 }
             )
@@ -206,16 +424,18 @@ modelCreateInstance mk m
         in
             ( ca,
               m
-                { modelInstances = Map.insert ci (csi, instanceData (mk ca)) (modelInstances m),
+                { modelInstances = Map.insert ci (mk ca) (modelInstances m),
                   modelFree = free'
                 }
             )
 
+-- | Update a model instance table by deleting the instance at a given contract address.
+-- This does nothing to the model if there is no instance at the given address.
 modelDeleteInstance :: ContractAddress -> Model -> Model
-modelDeleteInstance (ContractAddress ci csi) m = case Map.lookup ci (modelInstances m) of
+modelDeleteInstance ca@(ContractAddress ci csi) m = case Map.lookup ci (modelInstances m) of
     Nothing -> m
-    Just (csi', _) ->
-        if csi /= csi'
+    Just inst ->
+        if ca /= mInstanceAddr inst
             then m
             else
                 m
@@ -223,170 +443,246 @@ modelDeleteInstance (ContractAddress ci csi) m = case Map.lookup ci (modelInstan
                       modelFree = Map.insert ci (succ csi) (modelFree m)
                     }
 
-instanceTableToModel :: InstanceTable -> Model
-instanceTableToModel Empty = emptyModel
-instanceTableToModel (Tree _ t0) = ttm 0 emptyModel t0
-  where
-    ttm offset m (Branch h _ _ _ l r) =
-        let m' = ttm offset m l
-        in  ttm (offset + 2 ^ h) m' r
-    ttm offset m (Leaf inst) =
-        m
-            { modelInstances = Map.insert offset (contractSubindex $ instanceAddress inst, instanceData inst) (modelInstances m),
-              modelBound = modelBound m + 1
-            }
-    ttm offset m (VacantLeaf si) =
-        m
-            { modelFree = Map.insert offset (succ si) (modelFree m),
-              modelBound = modelBound m + 1
-            }
-
-modelCheck :: Instances -> Model -> Property
-modelCheck (Instances t) m = m === instanceTableToModel t
-
-checkEqualThen :: (Monad m, Eq a, Show a) => a -> a -> m Property -> m Property
-checkEqualThen a b r = if a /= b then return (a === b) else r
-
-checkBoolThen :: (Monad m) => String -> Bool -> m Property -> m Property
-checkBoolThen _ True r = r
-checkBoolThen ex False _ = return $ counterexample ex False
-
-checkEitherThen_ :: (Monad m) => Either String a -> m Property -> m Property
-checkEitherThen_ (Left ex) _ = return $ counterexample ex False
-checkEitherThen_ (Right _) r = r
-
-checkInvariantThen :: (Monad m) => Instances -> m Property -> m Property
-checkInvariantThen insts r = case invariantInstances insts of
-    Right _ -> r
-    Left ex -> return $ counterexample (ex ++ "\n" ++ show (_instances insts)) False
-
+-- | Choose an arbitrary key-value pair from a map.
 arbitraryMapElement :: Map.Map k v -> Gen (k, v)
 arbitraryMapElement m = do
     ind <- choose (0, Map.size m - 1)
     return (Map.elemAt ind m)
 
-generateFromUpdates :: Int -> Gen (Instances, Model)
-generateFromUpdates n0 = gen n0 emptyInstances emptyModel
+-- | A test monad that can be used for performing operations on an instance table.
+--  This uses the in-memory blob store.
+newtype TestMonad a = TestMonad {runTestMonad :: ModuleCache -> MemBlobStore -> IO a}
+    deriving
+        (Functor, Applicative, Monad, MonadIO, MonadFail)
+        via (ReaderT ModuleCache (ReaderT MemBlobStore IO))
+    deriving
+        (MonadBlobStore)
+        via (ReaderT ModuleCache (MemBlobStoreT IO))
+
+instance MonadCache ModuleCache TestMonad where
+    getCache = TestMonad $ \c _ -> return c
+
+-- | Run a 'TestMonad' with a fresh in-memory blob store and an empty 0-sized module cache.
+runTestMonadFresh :: TestMonad a -> IO a
+runTestMonadFresh a = bracket newMemBlobStore destroyMemBlobStore $ \mbs -> do
+    c <- newModuleCache 0
+    runTestMonad a c mbs
+
+-- | Generate a 'TestMonad' action for generating an instance table (by repeated creation and
+--  deletion of instances), and a corresponding model.
+generateFromUpdates :: (IsProtocolVersion pv) => Int -> Gen (TestMonad (Instances.Instances pv), Model)
+generateFromUpdates n0 = gen n0 (return Instances.emptyInstances) emptyModel
   where
     gen 0 insts model = return (insts, model)
-    gen n insts model = oneof $ [create, create, create] ++ if null (modelInstances model) then [] else [deleteExisting]
+    gen n insts model = oneof $ [create, create, create] ++ [deleteExisting | not (null (modelInstances model))]
       where
         create = do
-            instData <- arbitrary
-            dummyInstance <- makeDummyInstance instData
-            let (_, insts') = createInstance dummyInstance insts
+            dummyInstance <- genModelInstance
+
+            let insts' = fmap snd . Instances.newContractInstance (\ca -> ((),) <$> toPersistentInstance (dummyInstance ca)) =<< insts
             let (_, model') = modelCreateInstance dummyInstance model
             gen (n - 1) insts' model'
         deleteExisting = do
-            (ci, (csi, _)) <- arbitraryMapElement (modelInstances model)
+            (_, mi) <- arbitraryMapElement (modelInstances model)
             let
-                ca = ContractAddress ci csi
-                insts' = deleteInstance ca insts
+                ca = mInstanceAddr mi
+                insts' = Instances.deleteContractInstance ca =<< insts
                 model' = modelDeleteInstance ca model
             gen (n - 1) insts' model'
 
-testUpdates :: Int -> Gen Property
-testUpdates n0 = if n0 <= 0 then return (property True) else tu n0 emptyInstances emptyModel
+-- | Create and delete instances, then check invariants hold.
+testCreateDelete :: forall pv. (IsProtocolVersion pv) => SProtocolVersion pv -> Int -> Property
+testCreateDelete _ n = forAllShow (generateFromUpdates @pv n) (show . snd) $
+    \(insts, model) -> idempotentIOProperty $ runTestMonadFresh $ do
+        insts' <- insts
+        invariantInstances insts'
+        hlActual <- instancesToHashList insts'
+        let hlModel = modelToHashList model
+
+        hActual <- getHashM @_ @(InstancesHash pv) insts'
+        let hModel = getHash model
+        return $ hlActual === hlModel .&&. hActual === hModel
+
+-- | Check the structural invariants of the instances table and check that the hashes match the
+--  model.
+checkInvariants ::
+    forall pv.
+    (IsProtocolVersion pv) =>
+    Model ->
+    Instances.Instances pv ->
+    TestMonad ()
+checkInvariants model insts = do
+    invariantInstances insts
+    hlActual <- instancesToHashList insts
+    let hlModel = modelToHashList model
+    checkBinary (==) hlActual hlModel "==" "actual hash list" "model hash list"
+    hActual <- getHashM @_ @(InstancesHash pv) insts
+    let hModel = getHash model
+    checkBinary (==) hActual hModel "==" "actual root hash" "model root hash"
+
+-- | An abstracted representation of an update to the instance table that can be useful when
+-- reporting failures.
+data Update = Create ContractAddress | Delete ContractAddress | Update ContractAddress
+    deriving (Show)
+
+-- | Test the various operations on the instance table for the given number of iterations.
+--  After each operation, the invariants are asserted.
+testUpdates :: forall pv. (IsProtocolVersion pv) => SProtocolVersion pv -> Int -> Gen Property
+testUpdates _ n0 = do
+    (events, prop) <- tu n0 [] (return Instances.emptyInstances) emptyModel
+    return $ counterexample (show events) $ idempotentIOProperty $ runTestMonadFresh prop
   where
-    tu 0 insts model = checkInvariantThen insts $ return $ modelCheck insts model
-    tu n insts model =
-        checkInvariantThen insts $
-            checkEqualThen model (instanceTableToModel $ _instances insts) $
-                oneof $
-                    [create, deleteAbsent, updateAbsent]
-                        ++ (if null (modelInstances model) then [] else [updateExisting, deleteExisting])
-                        ++ (if null (modelFree model) then [] else [deleteFree, updateFree])
+    tu 0 evts insts model = return (reverse evts, checkInvariants @pv model =<< insts)
+    tu n evts insts0 model =
+        oneof $
+            [create, deleteAbsent, updateAbsent]
+                ++ (if null (modelInstances model) then [] else [updateExisting, deleteExisting])
+                ++ (if null (modelFree model) then [] else [deleteFree, updateFree])
       where
+        insts = do
+            i <- insts0
+            checkInvariants model i
+            return i
         create = do
-            instData <- arbitrary
-            dummyInstance <- makeDummyInstance instData
-            let (ca, insts') = createInstance dummyInstance insts
+            dummyInstance <- genModelInstance
             let (cam, model') = modelCreateInstance dummyInstance model
-            checkEqualThen (instanceAddress ca) cam $
-                tu (n - 1) insts' model'
+            let insts' = do
+                    (ca, i) <- Instances.newContractInstance (\ca -> (ca,) <$> toPersistentInstance (dummyInstance ca)) =<< insts
+                    checkBinary (==) ca cam "==" "new instance address" "model new instance address"
+                    return i
+            tu (n - 1) (Create cam : evts) insts' model'
         deleteAbsent = do
             ci <- ContractIndex <$> choose (fromIntegral $ modelBound model, maxBound)
             csi <- ContractSubindex <$> arbitrary
-            let
-                ca = ContractAddress ci csi
-                insts' = deleteInstance ca insts
+            let ca = ContractAddress ci csi
+                insts' = Instances.deleteContractInstance ca =<< insts
                 model' = modelDeleteInstance ca model
-            tu (n - 1) insts' model'
+            tu (n - 1) (Delete ca : evts) insts' model'
+
         updateAbsent = do
+            -- Pick a never-used contract index.
             ci <- ContractIndex <$> choose (fromIntegral $ modelBound model, maxBound)
             csi <- ContractSubindex <$> arbitrary
-            arbitrary >>= \case
-                InstanceDataV0 v a -> do
-                    let
-                        ca = ContractAddress ci csi
-                        insts' = updateInstanceAt' ca a (Just v) Nothing insts
-                        model' = modelUpdateInstanceAt ca a v model
-                    tu (n - 1) insts' model'
-                InstanceDataV1 v a -> do
-                    let
-                        ca = ContractAddress ci csi
-                        insts' = updateInstanceAt' ca a (Just v) Nothing insts
-                        model' = modelUpdateInstanceAt ca a v model
-                    tu (n - 1) insts' model'
+            let ca = ContractAddress ci csi
+            let insts' = do
+                    i <- insts
+                    res <-
+                        Instances.updateContractInstance
+                            (\_ -> fail "Update called on instance that should not exist.")
+                            ca
+                            i
+                    unless (isNothing res) $
+                        fail "Expected Nothing result when updating missing contract instance."
+                    return i
+            -- We do not update the model, as updating a non-existing instance will have no
+            -- effect.
+            tu (n - 1) (Update ca : evts) insts' model
+
         updateExisting = do
-            (ci, (csi0, curVer)) <- arbitraryMapElement (modelInstances model)
+            (ci, mi@ModelInstance{..}) <- arbitraryMapElement (modelInstances model)
+            let csi0 = contractSubindex (mInstanceAddr mi)
+            -- We use a valid index, but possibly invalid subindex.
             csi <- oneof [return csi0, ContractSubindex <$> arbitrary]
-            case curVer of
-                InstanceDataV0 _ _ -> do
-                    v <- InstanceStateV0 <$> genV0ContractState
-                    a <- arbitrary
-                    let
-                        ca = ContractAddress ci csi
-                        insts' = updateInstanceAt' ca a (Just v) Nothing insts
-                        model' = modelUpdateInstanceAt ca a v model
-                    tu (n - 1) insts' model'
-                InstanceDataV1 _ _ -> do
-                    v <- InstanceStateV1 <$> genV1ContractState
-                    a <- arbitrary
-                    let
-                        ca = ContractAddress ci csi
-                        insts' = updateInstanceAt' ca a (Just v) Nothing insts
-                        model' = modelUpdateInstanceAt ca a v model
-                    tu (n - 1) insts' model'
+            let ca = ContractAddress ci csi
+            (newAmt :: Amount) <- arbitrary
+            case mInstanceState of
+                Instances.InstanceStateV0{} -> do
+                    cs <- genV0ContractState
+                    let newState = Instances.InstanceStateV0 cs
+                    let newStateHash = getHash cs
+                    let insts' = do
+                            i <- insts
+                            let upd (Instances.PersistentInstanceV0 inst) = do
+                                    Instances.PersistentInstanceParameters{..} <-
+                                        refLoad
+                                            (Instances.pinstanceParameters inst)
+                                    return
+                                        ( (),
+                                          Instances.PersistentInstanceV0
+                                            inst
+                                                { Instances.pinstanceAmount = newAmt,
+                                                  Instances.pinstanceModel = newState,
+                                                  Instances.pinstanceHash =
+                                                    Instances.makeInstanceHashV0
+                                                        pinstanceParameterHash
+                                                        newStateHash
+                                                        newAmt
+                                                }
+                                        )
+                                upd _ = error "Instance version does not match expected value."
+                            res <- Instances.updateContractInstance upd ca i
+                            return $ maybe i snd res
+                    let model' = modelUpdateInstanceAt ca newAmt newState newStateHash model
+                    tu (n - 1) (Update ca : evts) insts' model'
+                Instances.InstanceStateV1{} -> do
+                    imps <- genV1ContractState
+                    let newState = Instances.InstanceStateV1 (StateV1.makePersistent imps)
+                    let newStateHash = getHash imps
+                    let insts' = do
+                            i <- insts
+                            let upd (Instances.PersistentInstanceV1 inst) = do
+                                    Instances.PersistentInstanceParameters{..} <-
+                                        refLoad
+                                            (Instances.pinstanceParameters inst)
+                                    return
+                                        ( (),
+                                          Instances.PersistentInstanceV1
+                                            inst
+                                                { Instances.pinstanceAmount = newAmt,
+                                                  Instances.pinstanceModel = newState,
+                                                  Instances.pinstanceHash =
+                                                    Instances.makeInstanceHashV1
+                                                        pinstanceParameterHash
+                                                        newStateHash
+                                                        newAmt
+                                                }
+                                        )
+                                upd _ = error "Instance version does not match expected value."
+                            res <- Instances.updateContractInstance upd ca i
+                            return $ maybe i snd res
+                    let model' = modelUpdateInstanceAt ca newAmt newState newStateHash model
+                    tu (n - 1) (Update ca : evts) insts' model'
+
         deleteExisting = do
-            (ci, (csi0, _)) <- arbitraryMapElement (modelInstances model)
+            (ci, mi) <- arbitraryMapElement (modelInstances model)
+            let csi0 = contractSubindex (mInstanceAddr mi)
+            -- We use a valid index, but possibly invalid subindex.
             csi <- oneof [return csi0, ContractSubindex <$> arbitrary]
-            let
-                ca = ContractAddress ci csi
-                insts' = deleteInstance ca insts
+            let ca = ContractAddress ci csi
+                insts' = Instances.deleteContractInstance ca =<< insts
                 model' = modelDeleteInstance ca model
-            tu (n - 1) insts' model'
+            tu (n - 1) (Delete ca : evts) insts' model'
+
         updateFree = do
             (ci, csi0) <- arbitraryMapElement (modelFree model)
             csi <- ContractSubindex <$> oneof [choose (0, fromIntegral csi0 - 1), choose (fromIntegral csi0, maxBound)]
-            arbitrary >>= \case
-                InstanceDataV0 v a -> do
-                    let
-                        ca = ContractAddress ci csi
-                        insts' = updateInstanceAt' ca a (Just v) Nothing insts
-                        model' = modelUpdateInstanceAt ca a v model
-                    tu (n - 1) insts' model'
-                InstanceDataV1 v a -> do
-                    let
-                        ca = ContractAddress ci csi
-                        insts' = updateInstanceAt' ca a (Just v) Nothing insts
-                        model' = modelUpdateInstanceAt ca a v model
-                    tu (n - 1) insts' model'
+            let ca = ContractAddress ci csi
+            let insts' = do
+                    i <- insts
+                    res <-
+                        Instances.updateContractInstance
+                            (\_ -> fail "Update called on instance that should not exist.")
+                            ca
+                            i
+                    unless (isNothing res) $
+                        fail "Expected Nothing result when updating missing contract instance."
+                    return i
+            -- We do not update the model, as updating a non-existing instance will have no
+            -- effect.
+            tu (n - 1) (Update ca : evts) insts' model
+
         deleteFree = do
             (ci, csi0) <- arbitraryMapElement (modelFree model)
             csi <- oneof [return csi0, ContractSubindex <$> arbitrary]
             let
                 ca = ContractAddress ci csi
-                insts' = deleteInstance ca insts
+                insts' = Instances.deleteContractInstance ca =<< insts
                 model' = modelDeleteInstance ca model
-            tu (n - 1) insts' model'
-
-testCreateDelete :: Int -> Gen Property
-testCreateDelete n = do
-    (insts, model) <- generateFromUpdates n
-    checkInvariantThen insts $ return $ modelCheck insts model
+            tu (n - 1) (Delete ca : evts) insts' model'
 
-testGetInstance :: Instances -> Model -> Gen Property
+-- | Given a 'TestMonad' that generates an instance table and a corresponding model, test that
+--  getting arbitrary contract addresses returns the same result in the instance table and model.
+testGetInstance :: (IsProtocolVersion pv) => TestMonad (Instances.Instances pv) -> Model -> Gen Property
 testGetInstance insts model =
     oneof $
         [present | not (null $ modelInstances model)]
@@ -394,29 +690,36 @@ testGetInstance insts model =
             ++ [absent]
   where
     present = do
-        (ci, (csi, d)) <- arbitraryMapElement (modelInstances model)
-        return $ fmap instanceData (getInstance (ContractAddress ci csi) insts) === Just d
+        (_, mi) <- arbitraryMapElement (modelInstances model)
+        return $ idempotentIOProperty $ runTestMonadFresh $ do
+            i <- Instances.lookupContractInstance (mInstanceAddr mi) =<< insts
+            case i of
+                Nothing -> return $ counterexample ("Missing instance @" ++ show (mInstanceAddr mi)) False
+                Just ai -> modelsPersistentInstance mi ai
     deleted = do
         (ci, csi0) <- arbitraryMapElement (modelFree model)
         csi <- ContractSubindex <$> oneof [choose (0, fromIntegral csi0 - 1), choose (fromIntegral csi0, maxBound)]
-        return $ fmap instanceData (getInstance (ContractAddress ci csi) insts) === Nothing
+        let ca = ContractAddress ci csi
+        return $ idempotentIOProperty $ runTestMonadFresh $ do
+            i <- Instances.lookupContractInstance ca =<< insts
+            return $ counterexample ("Instance should be deleted @" ++ show ca) (isNothing i)
     absent = do
         ci <- ContractIndex <$> choose (fromIntegral $ modelBound model, maxBound)
         csi <- ContractSubindex <$> arbitrary
-        return $ fmap instanceData (getInstance (ContractAddress ci csi) insts) === Nothing
-
-testFoldInstances :: Instances -> Model -> Property
-testFoldInstances insts model = allInsts === modInsts
-  where
-    allInsts = (\i -> (instanceAddress i, instanceData i)) <$> (insts ^.. foldInstances)
-    modInsts = (\(ci, (csi, d)) -> (ContractAddress ci csi, d)) <$> Map.toAscList (modelInstances model)
+        let ca = ContractAddress ci csi
+        return $ idempotentIOProperty $ runTestMonadFresh $ do
+            i <- Instances.lookupContractInstance ca =<< insts
+            return $ counterexample ("Instance should be absent @" ++ show ca) (isNothing i)
 
 tests :: Word -> Spec
-tests lvl = describe "GlobalStateTests.Instances" $ do
-    it "getInstance" $
+tests lvl = describe "GlobalStateTests.Instances" $ parallel $ do
+    it "getInstance (P7)" $
         withMaxSuccess (100 * fromIntegral lvl) $
-            forAllBlind (generateFromUpdates 5000) $
+            forAllBlind (generateFromUpdates @'P7 5000) $
                 \(i, m) -> withMaxSuccess 100 $ testGetInstance i m
-    it "foldInstances" $ withMaxSuccess 100 $ forAllBlind (generateFromUpdates 5000) $ uncurry testFoldInstances
-    it "10000 create/delete - check at end" $ withMaxSuccess 10 $ testCreateDelete 10000
-    it "500 instance updates - check every step" $ withMaxSuccess (100 * fromIntegral lvl) $ testUpdates 500
+    -- The hashing scheme for P1-P6 should be the same, but distinct from P7 onwards.
+    it "5 create/delete - check at end (P5)" $ withMaxSuccess 5000 $ testCreateDelete SP5 5
+    it "5 create/delete - check at end (P7)" $ withMaxSuccess 5000 $ testCreateDelete SP7 5
+    it "10000 create/delete - check at end (P7)" $ withMaxSuccess 10 $ testCreateDelete SP7 10000
+    it "500 instance updates - check every step (P5)" $ withMaxSuccess (100 * fromIntegral lvl) $ testUpdates SP5 500
+    it "500 instance updates - check every step (P7)" $ withMaxSuccess (100 * fromIntegral lvl) $ testUpdates SP7 500
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/LFMBTree.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/LFMBTree.hs
index e7f62ae731..b0a623b8ea 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/LFMBTree.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/LFMBTree.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DataKinds #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
@@ -16,17 +17,27 @@ import qualified Concordium.GlobalState.Basic.BlockState.LFMBTree as LFMBT
 import Concordium.GlobalState.Persistent.BlobStore
 import Concordium.GlobalState.Persistent.LFMBTree
 import Concordium.Types.HashableTo
+import Concordium.Types.ProtocolVersion
 import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.ByteString as BS
+import qualified Data.Serialize as S
 import Data.Word
 import Test.Hspec
 import Test.QuickCheck
 import Prelude hiding (lookup)
 
-abcHash, abcorrectHash :: H.Hash
-abcHash = H.hashOfHashes (H.hashOfHashes (H.hash "A") (H.hash "B")) (H.hash "C") -- "dbe11e36aa89a963103de7f8ad09c1100c06ccd5c5ad424ca741efb0689dc427"
-abcorrectHash = H.hashOfHashes (H.hashOfHashes (H.hash "A") (H.hash "B")) (H.hash "Correct") -- "084aeef37cbdb2e19255853cbae6d22c78aaaea7273aa39af4db96cc62c9bdac"
+abcHash, abcorrectHash :: LFMBT.LFMBTreeHashV0
+abcHash = LFMBT.LFMBTreeHash $ H.hashOfHashes (H.hashOfHashes (H.hash "A") (H.hash "B")) (H.hash "C") -- "dbe11e36aa89a963103de7f8ad09c1100c06ccd5c5ad424ca741efb0689dc427"
+abcorrectHash = LFMBT.LFMBTreeHash $ H.hashOfHashes (H.hashOfHashes (H.hash "A") (H.hash "B")) (H.hash "Correct") -- "084aeef37cbdb2e19255853cbae6d22c78aaaea7273aa39af4db96cc62c9bdac"
+
+abcHashV1, abcorrectHashV1 :: LFMBT.LFMBTreeHashV1
+abcHashV1 = LFMBT.LFMBTreeHash . H.hashLazy . S.runPutLazy $ do
+    S.putWord64be 3
+    S.put abcHash
+abcorrectHashV1 = LFMBT.LFMBTreeHash . H.hashLazy . S.runPutLazy $ do
+    S.putWord64be 3
+    S.put abcorrectHash
 
 testingFunction :: IO ()
 testingFunction = do
@@ -36,17 +47,17 @@ testingFunction = do
             tree <- foldM (\acc v -> snd <$> append v acc) (empty :: LFMBTree Word64 HashedBufferedRef BS.ByteString) ["A", "B", "C"]
             testElements <- mapM (`lookup` tree) [0 .. 3]
             liftIO $ testElements `shouldBe` map Just ["A", "B", "C"] ++ [Nothing]
-            h <- getHashM tree :: BlobStoreM H.Hash
+            h <- getHashM tree
             liftIO $ h `shouldBe` abcHash
             tree' <- loadRef =<< (storeRef tree :: BlobStoreM (BlobRef (LFMBTree Word64 HashedBufferedRef BS.ByteString)))
             testElements' <- mapM (`lookup` tree') [0 .. 3]
             liftIO $ testElements' `shouldBe` map Just ["A", "B", "C"] ++ [Nothing]
-            h' <- getHashM tree' :: BlobStoreM H.Hash
+            h' <- getHashM tree'
             liftIO $ h' `shouldBe` abcHash
             Just (_, tree'') <- update (\v -> return ((), v `BS.append` "orrect")) 2 tree'
             testElements'' <- mapM (`lookup` tree'') [0 .. 3]
             liftIO $ testElements'' `shouldBe` map Just ["A", "B", "Correct"] ++ [Nothing]
-            h'' <- getHashM tree'' :: BlobStoreM H.Hash
+            h'' <- getHashM tree''
             liftIO $ h'' `shouldBe` abcorrectHash
         )
 
@@ -66,9 +77,15 @@ testingFunction2 = do
             liftIO $ testElements'' `shouldBe` map Just ["A", "B", "Correct"] ++ [Nothing]
         )
 
-testHashAsLFMBT :: Property
-testHashAsLFMBT = forAll (fmap BS.pack <$> listOf (vector 10)) $ \bs ->
-    LFMBT.hashAsLFMBT (H.hash "EmptyLFMBTree") (getHash <$> bs) === getHash (LFMBT.fromFoldable @Word64 bs)
+testHashAsLFMBTV0 :: Property
+testHashAsLFMBTV0 = forAll (fmap BS.pack <$> listOf (vector 10)) $ \bs ->
+    LFMBT.hashAsLFMBTV0 (H.hash "EmptyLFMBTree") (getHash <$> bs)
+        === LFMBT.theLFMBTreeHash @'BlockHashVersion0 (getHash (LFMBT.fromFoldable @Word64 bs))
+
+testHashAsLFMBTV1 :: Property
+testHashAsLFMBTV1 = forAll (fmap BS.pack <$> listOf (vector 10)) $ \bs ->
+    LFMBT.hashAsLFMBTV1 (H.hash "EmptyLFMBTree") (getHash <$> bs)
+        === LFMBT.theLFMBTreeHash @'BlockHashVersion1 (getHash (LFMBT.fromFoldable @Word64 bs))
 
 tests :: Spec
 tests =
@@ -80,5 +97,8 @@ tests =
             "Using BufferedRef"
             testingFunction2
         it
-            "testHashAsLFMBT"
-            testHashAsLFMBT
+            "testHashAsLFMBTV0"
+            testHashAsLFMBTV0
+        it
+            "testHashAsLFMBTV1"
+            testHashAsLFMBTV1
diff --git a/concordium-consensus/tests/globalstate/GlobalStateTests/PersistentTreeState.hs b/concordium-consensus/tests/globalstate/GlobalStateTests/PersistentTreeState.hs
index 56d4cbbe4d..f23e3b4ee9 100644
--- a/concordium-consensus/tests/globalstate/GlobalStateTests/PersistentTreeState.hs
+++ b/concordium-consensus/tests/globalstate/GlobalStateTests/PersistentTreeState.hs
@@ -37,7 +37,7 @@ import Concordium.Types
 import Concordium.Types.AnonymityRevokers
 import Concordium.Types.HashableTo
 import Concordium.Types.IdentityProviders
-import qualified Concordium.Types.Transactions as Trns
+import qualified Concordium.Types.TransactionOutcomes as Trns
 import Control.Exception
 import Control.Monad
 import Control.Monad.Identity
@@ -108,7 +108,19 @@ testFinalizeABlock = do
     let proof2 = VRF.prove (fst $ randomKeyPair (mkStdGen 1)) "proof2"
     now <- liftIO $ getCurrentTime
     -- FIXME: Statehash is stubbed out with a placeholder hash
-    pb <- makePendingBlock (fst $ randomBlockKeyPair (mkStdGen 1)) 1 (bpHash genesisBlock) 0 proof1 proof2 NoFinalizationData [] (StateHashV0 minBound) (getHash Trns.emptyTransactionOutcomesV0) now
+    pb <-
+        makePendingBlock
+            (fst $ randomBlockKeyPair (mkStdGen 1))
+            1
+            (bpHash genesisBlock)
+            0
+            proof1
+            proof2
+            NoFinalizationData
+            []
+            (StateHashV0 minBound)
+            (Trns.toTransactionOutcomesHash Trns.emptyTransactionOutcomesHashV0)
+            now
 
     now' <- liftIO $ getCurrentTime
     blockPtr :: BlockPointerType TestM <- makeLiveBlock pb genesisBlock genesisBlock state now' 0
@@ -150,7 +162,19 @@ testFinalizeABlock = do
     -- add another block with different lfin and parent
     now'' <- liftIO $ getCurrentTime
     -- FIXME:  statehash is stubbed out with a palceholder stash
-    pb2 <- makePendingBlock (fst $ randomBlockKeyPair (mkStdGen 1)) 2 (bpHash blockPtr) 0 proof1 proof2 NoFinalizationData [] (StateHashV0 minBound) (getHash Trns.emptyTransactionOutcomesV0) now''
+    pb2 <-
+        makePendingBlock
+            (fst $ randomBlockKeyPair (mkStdGen 1))
+            2
+            (bpHash blockPtr)
+            0
+            proof1
+            proof2
+            NoFinalizationData
+            []
+            (StateHashV0 minBound)
+            (Trns.toTransactionOutcomesHash Trns.emptyTransactionOutcomesHashV0)
+            now''
     now''' <- liftIO $ getCurrentTime
     blockPtr2 :: BlockPointerType TestM <- makeLiveBlock pb2 blockPtr genesisBlock state now''' 0
     let frec2 = FinalizationRecord 2 (bpHash blockPtr2) (FinalizationProof [1] (sign "Hello" sk)) 0
diff --git a/concordium-consensus/tests/scheduler/SchedulerTests/Payday.hs b/concordium-consensus/tests/scheduler/SchedulerTests/Payday.hs
index 573fcc1541..3cbc4f6789 100644
--- a/concordium-consensus/tests/scheduler/SchedulerTests/Payday.hs
+++ b/concordium-consensus/tests/scheduler/SchedulerTests/Payday.hs
@@ -38,7 +38,6 @@ import Concordium.Types.SeedState
 import Concordium.Birk.Bake
 import qualified Concordium.GlobalState.AccountMap.LMDB as LMDBAccountMap
 import Concordium.GlobalState.BakerInfo
-import Concordium.GlobalState.Basic.BlockState.PoolRewards (BakerPoolRewardDetails (transactionFeesAccrued))
 import Concordium.GlobalState.BlockPointer (BlockPointer (_bpState))
 import Concordium.GlobalState.BlockState
 import Concordium.GlobalState.CapitalDistribution
@@ -48,6 +47,7 @@ import Concordium.GlobalState.Persistent.BlockPointer
 import Concordium.GlobalState.Persistent.BlockState
 import qualified Concordium.GlobalState.Persistent.BlockState as BS
 import Concordium.GlobalState.Persistent.TreeState
+import Concordium.GlobalState.PoolRewards (BakerPoolRewardDetails (transactionFeesAccrued))
 import Concordium.GlobalState.TreeState
 import Concordium.Startup
 import qualified SchedulerTests.Helpers as Helpers
diff --git a/concordium-consensus/tools/database-exporter/Main.hs b/concordium-consensus/tools/database-exporter/Main.hs
index 3125a5be78..660a996152 100644
--- a/concordium-consensus/tools/database-exporter/Main.hs
+++ b/concordium-consensus/tools/database-exporter/Main.hs
@@ -1,4 +1,7 @@
--- | This tools provides functionality for exporting a node database for use with the out-of-band
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | This tool provides functionality for exporting a node database for use with the out-of-band
 --  catch up mechanism.  It also provides functionality for checking that such an exported set of
 --  blocks is correctly serialized.
 module Main where
@@ -37,7 +40,7 @@ checkDatabase filepath = do
     logm _ lvl s = putStrLn $ show lvl ++ ": " ++ s
     handleImport :: (MonadLogger m) => UTCTime -> ImportData -> m (ImportResult a ())
     handleImport t (ImportBlock pv gi bs) = case promoteProtocolVersion pv of
-        SomeProtocolVersion spv -> case consensusVersionFor spv of
+        SomeProtocolVersion (spv :: SProtocolVersion pv) -> case consensusVersionFor spv of
             ConsensusV0 -> case deserializeExactVersionedPendingBlock spv bs t of
                 Left err -> do
                     logEvent External LLError $ "Deserialization failed for consensus v0 block: " <> err
@@ -45,7 +48,7 @@ checkDatabase filepath = do
                 Right pb -> do
                     logEvent External LLInfo $ "GenesisIndex: " ++ show gi ++ " block: " ++ show (pbHash pb) ++ " slot: " ++ show (blockSlot pb)
                     return $ Right ()
-            ConsensusV1 -> case SkovV1.deserializeExactVersionedPendingBlock spv bs t of
+            ConsensusV1 -> case SkovV1.deserializeExactVersionedPendingBlock @pv bs t of
                 Left err -> do
                     logEvent External LLError $ "Deserialization failed for consensus v1 block: " <> err
                     return $ Left ImportSerializationFail