From 5310cb1f3e34a6117d2aaccb1d4ad3aa52e3b582 Mon Sep 17 00:00:00 2001 From: Luke Nadur <19835357+intricate@users.noreply.github.com> Date: Tue, 30 Jul 2019 11:49:24 -0500 Subject: [PATCH] [#440] Implement "already validated" flag for block and tx application --- .../Ouroboros/Consensus/Ledger/Abstract.hs | 16 ++ .../src/Ouroboros/Consensus/Ledger/Byron.hs | 210 +++++++++++------- .../Ouroboros/Consensus/Ledger/Extended.hs | 38 +++- .../Ouroboros/Consensus/Ledger/Mock/Block.hs | 4 + .../Ouroboros/Storage/ChainDB/Impl/LgrDB.hs | 4 +- .../src/Ouroboros/Storage/ChainDB/Model.hs | 2 +- .../Test/Consensus/ChainSyncClient.hs | 4 +- .../Test/Consensus/Mempool/TestBlock.hs | 2 + .../test-util/Test/Util/TestBlock.hs | 3 + 9 files changed, 188 insertions(+), 95 deletions(-) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs index 954119bdbeb..e2a197b5cca 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Abstract.hs @@ -11,6 +11,7 @@ module Ouroboros.Consensus.Ledger.Abstract ( ) where import Control.Monad.Except +import GHC.Stack (HasCallStack) import Ouroboros.Network.Block (Point, SlotNo) import Ouroboros.Network.Point (WithOrigin) @@ -57,6 +58,21 @@ class ( SupportedBlock blk -> LedgerState blk -> Except (LedgerError blk) (LedgerState blk) + -- | Re-apply a block to the very same ledger state it was applied in before. + -- + -- Since a block can only be applied to a single, specific, ledger state, + -- if we apply a previously applied block again it will be applied in the + -- very same ledger state, and therefore can't possibly fail. + -- + -- It is worth noting that since we already know that the block is valid in + -- the provided ledger state, the ledger layer should not perform /any/ + -- validation checks. + reapplyLedgerBlock :: HasCallStack + => LedgerConfig blk + -> blk + -> LedgerState blk + -> LedgerState blk + -- | Point of the most recently applied block -- -- Should be 'genesisPoint' when no blocks have been applied yet diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs index 5b86517fbb2..31d1c0de34b 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Byron.hs @@ -94,7 +94,7 @@ import qualified Cardano.Chain.Genesis as CC.Genesis import qualified Cardano.Chain.Slotting as CC.Slot import qualified Cardano.Chain.Update.Validation.Interface as CC.UPI import qualified Cardano.Chain.UTxO as CC.UTxO -import Cardano.Chain.ValidationMode (fromBlockValidationMode) +import Cardano.Chain.ValidationMode (ValidationMode (..), fromBlockValidationMode) import qualified Cardano.Crypto as Crypto import Cardano.Crypto.DSIGN import Cardano.Crypto.Hash @@ -227,63 +227,21 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg) fixPMI pmi = reAnnotate $ Annotated pmi () - applyLedgerBlock (ByronLedgerConfig cfg) (ByronBlock block) - (ByronLedgerState state snapshots) = do - runReaderT - (CC.Block.headerIsValid - (CC.Block.cvsUpdateState state) - (CC.Block.blockHeader block) - ) - (fromBlockValidationMode CC.Block.BlockValidation) - CC.Block.BodyState { CC.Block.utxo, CC.Block.updateState - , CC.Block.delegationState } - <- runReaderT - (CC.Block.updateBody bodyEnv bodyState block) - (fromBlockValidationMode CC.Block.BlockValidation) - let state' = state - { CC.Block.cvsLastSlot = CC.Block.blockSlot block - , CC.Block.cvsPreviousHash = Right $ CC.Block.blockHashAnnotated block - , CC.Block.cvsUtxo = utxo - , CC.Block.cvsUpdateState = updateState - , CC.Block.cvsDelegationState = delegationState - } - snapshots' - | CC.Block.cvsDelegationState state' == - CC.Block.cvsDelegationState state - = snapshots - | otherwise - = snapshots Seq.|> SB.bounded startOfSnapshot slot state' - where - startOfSnapshot = case snapshots of - _ Seq.:|> a -> sbUpper a - Seq.Empty -> SlotNo 0 - slot = convertSlot $ CC.Block.blockSlot block - return $ ByronLedgerState state' (trimSnapshots snapshots') - where - bodyState = CC.Block.BodyState - { CC.Block.utxo = CC.Block.cvsUtxo state - , CC.Block.updateState = CC.Block.cvsUpdateState state - , CC.Block.delegationState = CC.Block.cvsDelegationState state - } - bodyEnv = CC.Block.BodyEnvironment - { CC.Block.protocolMagic = fixPM $ CC.Genesis.configProtocolMagic cfg - , CC.Block.k = CC.Genesis.configK cfg - , CC.Block.allowedDelegators = allowedDelegators cfg - , CC.Block.protocolParameters = protocolParameters - , CC.Block.currentEpoch = CC.Slot.slotNumberEpoch - (CC.Genesis.configEpochSlots cfg) - (CC.Block.blockSlot block) - } - - protocolParameters = CC.UPI.adoptedProtocolParameters . CC.Block.cvsUpdateState - $ state - - fixPM (Crypto.AProtocolMagic a b) = Crypto.AProtocolMagic (reAnnotate a) b - - k = CC.Genesis.configK cfg - - trimSnapshots = Seq.dropWhileL $ \ss -> - sbUpper ss < convertSlot (CC.Block.blockSlot block) - 2 * coerce k + applyLedgerBlock = applyByronLedgerBlock + (fromBlockValidationMode CC.Block.BlockValidation) + + reapplyLedgerBlock cfg blk st = + let validationMode = fromBlockValidationMode CC.Block.NoBlockValidation + -- Given a 'BlockValidationMode' of 'NoBlockValidation', a call to + -- 'applyByronLedgerBlock' shouldn't fail since the ledger layer won't be + -- performing any block validation checks. + -- However, because 'applyByronLedgerBlock' can fail in the event it is + -- given a 'BlockValidationMode' of 'BlockValidation', it still /looks/ + -- like it can fail (since its type doesn't change based on the + -- 'ValidationMode') and we must still treat it as such. + in case runExcept (applyByronLedgerBlock validationMode cfg blk st) of + Left err -> error ("reapplyLedgerBlock: unexpected error: " <> show err) + Right st' -> st' ledgerTipPoint (ByronLedgerState state _) = case CC.Block.cvsPreviousHash state of -- In this case there are no blocks in the ledger state. The genesis @@ -293,6 +251,72 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg) where slot = convertSlot (CC.Block.cvsLastSlot state) +applyByronLedgerBlock :: ValidationMode + -> LedgerConfig (ByronBlock cfg) + -> ByronBlock cfg + -> LedgerState (ByronBlock cfg) + -> Except (LedgerError (ByronBlock cfg)) + (LedgerState (ByronBlock cfg)) +applyByronLedgerBlock validationMode + (ByronLedgerConfig cfg) + (ByronBlock block) + (ByronLedgerState state snapshots) = do + runReaderT + (CC.Block.headerIsValid + (CC.Block.cvsUpdateState state) + (CC.Block.blockHeader block) + ) + validationMode + CC.Block.BodyState { CC.Block.utxo, CC.Block.updateState + , CC.Block.delegationState } + <- runReaderT + (CC.Block.updateBody bodyEnv bodyState block) + validationMode + let state' = state + { CC.Block.cvsLastSlot = CC.Block.blockSlot block + , CC.Block.cvsPreviousHash = Right $ CC.Block.blockHashAnnotated block + , CC.Block.cvsUtxo = utxo + , CC.Block.cvsUpdateState = updateState + , CC.Block.cvsDelegationState = delegationState + } + snapshots' + | CC.Block.cvsDelegationState state' == + CC.Block.cvsDelegationState state + = snapshots + | otherwise + = snapshots Seq.|> SB.bounded startOfSnapshot slot state' + where + startOfSnapshot = case snapshots of + _ Seq.:|> a -> sbUpper a + Seq.Empty -> SlotNo 0 + slot = convertSlot $ CC.Block.blockSlot block + return $ ByronLedgerState state' (trimSnapshots snapshots') + where + bodyState = CC.Block.BodyState + { CC.Block.utxo = CC.Block.cvsUtxo state + , CC.Block.updateState = CC.Block.cvsUpdateState state + , CC.Block.delegationState = CC.Block.cvsDelegationState state + } + bodyEnv = CC.Block.BodyEnvironment + { CC.Block.protocolMagic = fixPM $ CC.Genesis.configProtocolMagic cfg + , CC.Block.k = CC.Genesis.configK cfg + , CC.Block.allowedDelegators = allowedDelegators cfg + , CC.Block.protocolParameters = protocolParameters + , CC.Block.currentEpoch = CC.Slot.slotNumberEpoch + (CC.Genesis.configEpochSlots cfg) + (CC.Block.blockSlot block) + } + + protocolParameters = CC.UPI.adoptedProtocolParameters . CC.Block.cvsUpdateState + $ state + + fixPM (Crypto.AProtocolMagic a b) = Crypto.AProtocolMagic (reAnnotate a) b + + k = CC.Genesis.configK cfg + + trimSnapshots = Seq.dropWhileL $ \ss -> + sbUpper ss < convertSlot (CC.Block.blockSlot block) - 2 * coerce k + allowedDelegators :: CC.Genesis.Config -> Set CC.Common.KeyHash allowedDelegators = CC.Genesis.unGenesisKeyHashes @@ -486,22 +510,48 @@ instance ( ByronGiven applyChainTick (ByronEBBLedgerConfig cfg) slotNo (ByronEBBLedgerState state) = ByronEBBLedgerState <$> applyChainTick cfg slotNo state - applyLedgerBlock (ByronEBBLedgerConfig cfg) (ByronBlockOrEBB block) - (ByronEBBLedgerState bs@(ByronLedgerState state snapshots)) = - case block of - CC.Block.ABOBBlock b -> ByronEBBLedgerState <$> applyLedgerBlock cfg (ByronBlock b) bs - CC.Block.ABOBBoundary b -> - mapExcept (fmap (\i -> ByronEBBLedgerState $ ByronLedgerState i snapshots)) $ - return $ state - { CC.Block.cvsPreviousHash = Right $ CC.Block.boundaryHeaderHashAnnotated hdr - , CC.Block.cvsLastSlot = CC.Slot.SlotNumber $ epochSlots * CC.Block.boundaryEpoch hdr - } - where - hdr = CC.Block.boundaryHeader b - CC.Slot.EpochSlots epochSlots = given + applyLedgerBlock = applyByronLedgerBlockOrEBB + (fromBlockValidationMode CC.Block.BlockValidation) + + reapplyLedgerBlock cfg blk st = + let validationMode = fromBlockValidationMode CC.Block.NoBlockValidation + -- Given a 'BlockValidationMode' of 'NoBlockValidation', a call to + -- 'applyByronLedgerBlockOrEBB' shouldn't fail since the ledger layer + -- won't be performing any block validation checks. + -- However, because 'applyByronLedgerBlockOrEBB' can fail in the event it + -- is given a 'BlockValidationMode' of 'BlockValidation', it still /looks/ + -- like it can fail (since its type doesn't change based on the + -- 'ValidationMode') and we must still treat it as such. + in case runExcept (applyByronLedgerBlockOrEBB validationMode cfg blk st) of + Left err -> error ("reapplyLedgerBlock: unexpected error: " <> show err) + Right st' -> st' ledgerTipPoint (ByronEBBLedgerState state) = castPoint $ ledgerTipPoint state +applyByronLedgerBlockOrEBB :: Given CC.Slot.EpochSlots + => ValidationMode + -> LedgerConfig (ByronBlockOrEBB cfg) + -> ByronBlockOrEBB cfg + -> LedgerState (ByronBlockOrEBB cfg) + -> Except (LedgerError (ByronBlockOrEBB cfg)) + (LedgerState (ByronBlockOrEBB cfg)) +applyByronLedgerBlockOrEBB validationMode + (ByronEBBLedgerConfig cfg) + (ByronBlockOrEBB block) + (ByronEBBLedgerState bs@(ByronLedgerState state snapshots)) = + case block of + CC.Block.ABOBBlock b -> + ByronEBBLedgerState <$> applyByronLedgerBlock validationMode cfg (ByronBlock b) bs + CC.Block.ABOBBoundary b -> + mapExcept (fmap (\i -> ByronEBBLedgerState $ ByronLedgerState i snapshots)) $ + return $ state + { CC.Block.cvsPreviousHash = Right $ CC.Block.boundaryHeaderHashAnnotated hdr + , CC.Block.cvsLastSlot = CC.Slot.SlotNumber $ epochSlots * CC.Block.boundaryEpoch hdr + } + where + hdr = CC.Block.boundaryHeader b + CC.Slot.EpochSlots epochSlots = given + -- | Construct Byron block from unannotated 'CC.Block.Block' -- -- This should be used only when forging blocks (not when receiving blocks @@ -827,27 +877,27 @@ instance (ByronGiven, Typeable cfg, ConfigContainsGenesis cfg) type ApplyTxErr (ByronBlockOrEBB cfg) = CC.UTxO.UTxOValidationError - applyTx = applyByronGenTx False - reapplyTx = applyByronGenTx True + applyTx = applyByronGenTx + (ValidationMode CC.Block.BlockValidation CC.UTxO.TxValidation) + + reapplyTx = applyByronGenTx + (ValidationMode CC.Block.NoBlockValidation CC.UTxO.TxValidationNoCrypto) - -- TODO #440: We need explicit support for this from the ledger - -- (though during testing we might still want to actually verify that we - -- didn't get any errors) reapplyTxSameState cfg tx st = - case runExcept (applyByronGenTx True cfg tx st) of + let validationMode = ValidationMode CC.Block.NoBlockValidation CC.UTxO.NoTxValidation + in case runExcept (applyByronGenTx validationMode cfg tx st) of Left err -> error $ "unexpected error: " <> show err Right st' -> st' -applyByronGenTx :: Bool -- ^ Have we verified this transaction previously? +applyByronGenTx :: ValidationMode -> LedgerConfig (ByronBlockOrEBB cfg) -> GenTx (ByronBlockOrEBB cfg) -> LedgerState (ByronBlockOrEBB cfg) -> Except CC.UTxO.UTxOValidationError (LedgerState (ByronBlockOrEBB cfg)) -applyByronGenTx _reapply (ByronEBBLedgerConfig (ByronLedgerConfig cfg)) genTx (ByronEBBLedgerState st@ByronLedgerState{..}) = +applyByronGenTx validationMode (ByronEBBLedgerConfig (ByronLedgerConfig cfg)) genTx (ByronEBBLedgerState st@ByronLedgerState{..}) = (\x -> ByronEBBLedgerState $ st { blsCurrent = x }) <$> go genTx blsCurrent where - validationMode = fromBlockValidationMode CC.Block.BlockValidation go :: GenTx (ByronBlockOrEBB cfg) -> CC.Block.ChainValidationState -> Except CC.UTxO.UTxOValidationError CC.Block.ChainValidationState diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Extended.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Extended.hs index 9d6103593b8..f7ddf541ebc 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Extended.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Extended.hs @@ -6,7 +6,8 @@ module Ouroboros.Consensus.Ledger.Extended ( -- * Extended ledger state - ExtLedgerState(..) + BlockPreviouslyApplied(..) + , ExtLedgerState(..) , ExtValidationError(..) , applyExtLedgerState , foldExtLedgerState @@ -49,25 +50,41 @@ deriving instance ProtocolLedgerView blk => Show (ExtValidationError blk) deriving instance (ProtocolLedgerView blk, Eq (ChainState (BlockProtocol blk))) => Eq (ExtLedgerState blk) +data BlockPreviouslyApplied = + BlockPreviouslyApplied + -- ^ The block has been previously applied and validated against the given + -- ledger state and no block validations should be performed. + | BlockNotPreviouslyApplied + -- ^ The block has not been previously applied to the given ledger state and + -- all block validations should be performed. + applyExtLedgerState :: ( UpdateLedger blk , ProtocolLedgerView blk , HasCallStack ) - => NodeConfig (BlockProtocol blk) + => BlockPreviouslyApplied + -> NodeConfig (BlockProtocol blk) -> blk -> ExtLedgerState blk -> Except (ExtValidationError blk) (ExtLedgerState blk) -applyExtLedgerState cfg blk ExtLedgerState{..} = do +applyExtLedgerState prevApplied cfg blk ExtLedgerState{..} = do ledgerState' <- withExcept ExtValidationErrorLedger $ applyChainTick (ledgerConfigView cfg) (blockSlot blk) ledgerState - ledgerState'' <- withExcept ExtValidationErrorLedger $ - applyLedgerBlock - (ledgerConfigView cfg) - blk - ledgerState' + ledgerState'' <- case prevApplied of + BlockNotPreviouslyApplied -> + withExcept ExtValidationErrorLedger $ + applyLedgerBlock + (ledgerConfigView cfg) + blk + ledgerState' + BlockPreviouslyApplied -> pure $ + reapplyLedgerBlock + (ledgerConfigView cfg) + blk + ledgerState' ouroborosChainState' <- withExcept ExtValidationErrorOuroboros $ applyChainState cfg @@ -77,11 +94,12 @@ applyExtLedgerState cfg blk ExtLedgerState{..} = do return $ ExtLedgerState ledgerState'' ouroborosChainState' foldExtLedgerState :: (ProtocolLedgerView blk, HasCallStack) - => NodeConfig (BlockProtocol blk) + => BlockPreviouslyApplied + -> NodeConfig (BlockProtocol blk) -> [blk] -- ^ Blocks to apply, oldest first -> ExtLedgerState blk -> Except (ExtValidationError blk) (ExtLedgerState blk) -foldExtLedgerState = repeatedlyM . applyExtLedgerState +foldExtLedgerState prevApplied = repeatedlyM . (applyExtLedgerState prevApplied) {------------------------------------------------------------------------------- Serialisation diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs index 4fb0fc9367b..6fd0a270f97 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Ledger/Mock/Block.hs @@ -222,6 +222,10 @@ instance (SimpleCrypto c, Typeable ext, SupportedBlock (SimpleBlock c ext)) applyChainTick _ _ = return applyLedgerBlock _cfg = updateSimpleLedgerState + reapplyLedgerBlock _cfg = (mustSucceed . runExcept) .: updateSimpleLedgerState + where + mustSucceed (Left err) = error ("reapplyLedgerBlock: unexpected error: " <> show err) + mustSucceed (Right st) = st ledgerTipPoint (SimpleLedgerState st) = mockTip st ledgerConfigView _ = SimpleLedgerConfig diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs index c3009eb31fd..774bf010b44 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Impl/LgrDB.hs @@ -202,12 +202,12 @@ openDB args@LgrDbArgs{..} immDB getBlock tracer = do apply :: blk -> ExtLedgerState blk -> Either (ExtValidationError blk) (ExtLedgerState blk) - apply = runExcept .: applyExtLedgerState lgrNodeConfig + apply = runExcept .: applyExtLedgerState BlockNotPreviouslyApplied lgrNodeConfig reapply :: blk -> ExtLedgerState blk -> ExtLedgerState blk - reapply b l = case apply b l of -- TODO skip some checks, see #440 + reapply b l = case runExcept (applyExtLedgerState BlockPreviouslyApplied lgrNodeConfig b l) of Left e -> error $ "reapply failed: " <> show e Right l' -> l' diff --git a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Model.hs b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Model.hs index 571275069e6..a36491a5ae0 100644 --- a/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Model.hs +++ b/ouroboros-consensus/src/Ouroboros/Storage/ChainDB/Model.hs @@ -334,7 +334,7 @@ validate cfg initLedger chain = -> ValidationResult blk go ledger validPrefix bs = case bs of [] -> ValidChain validPrefix ledger - b:bs' -> case runExcept (applyExtLedgerState cfg b ledger) of + b:bs' -> case runExcept (applyExtLedgerState BlockNotPreviouslyApplied cfg b ledger) of Right ledger' -> go ledger' (validPrefix :> b) bs' Left e -> InvalidChain e (fmap Block.blockPoint (b NE.:| bs')) validPrefix ledger diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/ChainSyncClient.hs b/ouroboros-consensus/test-consensus/Test/Consensus/ChainSyncClient.hs index fc26c639529..cd4603e96aa 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/ChainSyncClient.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/ChainSyncClient.hs @@ -370,13 +370,13 @@ updateClientState cfg chain ledgerState chainUpdates = where chain' = foldl' (flip Chain.addBlock) chain bs ledgerState' = runValidate $ - foldExtLedgerState cfg bs ledgerState + foldExtLedgerState BlockNotPreviouslyApplied cfg bs ledgerState Nothing -- There was a roll back in the updates, so validate the chain from -- scratch | Just chain' <- Chain.applyChainUpdates chainUpdates chain -> let ledgerState' = runValidate $ - foldExtLedgerState cfg (Chain.toOldestFirst chain') testInitExtLedger + foldExtLedgerState BlockNotPreviouslyApplied cfg (Chain.toOldestFirst chain') testInitExtLedger in (chain', ledgerState') | otherwise -> error "Client chain update failed" diff --git a/ouroboros-consensus/test-consensus/Test/Consensus/Mempool/TestBlock.hs b/ouroboros-consensus/test-consensus/Test/Consensus/Mempool/TestBlock.hs index 57182f9bc16..d54baca802a 100644 --- a/ouroboros-consensus/test-consensus/Test/Consensus/Mempool/TestBlock.hs +++ b/ouroboros-consensus/test-consensus/Test/Consensus/Mempool/TestBlock.hs @@ -117,6 +117,8 @@ instance UpdateLedger TestBlock where applyLedgerBlock = notNeeded + reapplyLedgerBlock = notNeeded + ledgerTipPoint = tlLastApplied testInitLedger :: LedgerState TestBlock diff --git a/ouroboros-consensus/test-util/Test/Util/TestBlock.hs b/ouroboros-consensus/test-util/Test/Util/TestBlock.hs index ef8f5abd0fb..3c54ba29701 100644 --- a/ouroboros-consensus/test-util/Test/Util/TestBlock.hs +++ b/ouroboros-consensus/test-util/Test/Util/TestBlock.hs @@ -250,6 +250,9 @@ instance UpdateLedger TestBlock where | otherwise = return $ TestLedger (Chain.blockPoint tb, BlockHash (Block.blockHash tb)) + reapplyLedgerBlock _ tb _ = + TestLedger (Chain.blockPoint tb, BlockHash (Block.blockHash tb)) + ledgerTipPoint = fst . lastApplied instance ProtocolLedgerView TestBlock where