consensus: store EBB header hash bytes in PBFT ChainState

ouroboros-consensus/ouroboros-consensus.cabal

@@ -88,6 +88,7 @@ library
                        Ouroboros.Consensus.Protocol.ModChainSel
                        Ouroboros.Consensus.Protocol.PBFT
                        Ouroboros.Consensus.Protocol.PBFT.ChainState
+                       Ouroboros.Consensus.Protocol.PBFT.ChainState.HeaderHashBytes
                        Ouroboros.Consensus.Protocol.PBFT.Crypto
                        Ouroboros.Consensus.Protocol.Praos
                        Ouroboros.Consensus.Protocol.Signed

ouroboros-consensus/src/Ouroboros/Consensus/ChainSyncClient.hs

@@ -330,8 +330,9 @@ chainSyncClient mkPipelineDecision0 tracer cfg btime
         -- guarantees that the ChainSync protocol /does/ in fact give us a
         -- switch-to-fork instead of a true rollback.
         (theirFrag, theirChainState) <-
-          case (,) <$> AF.rollback (castPoint intersection) ourFrag
-                   <*> rewindChainState cfg ourChainState (pointSlot intersection)
+          let i = castPoint intersection in
+          case (,) <$> AF.rollback i ourFrag
+                   <*> rewindChainState cfg ourChainState i
           of
             Just (c, d) -> return (c, d)
             -- The @intersection@ is not on the candidate chain, even though
@@ -635,8 +636,9 @@ chainSyncClient mkPipelineDecision0 tracer cfg btime
                    , ourTip
                    } -> traceException $ do
       (theirFrag', theirChainState') <-
-        case (,) <$> AF.rollback (castPoint intersection) theirFrag
-                 <*> rewindChainState cfg theirChainState (pointSlot intersection)
+        let i = castPoint intersection in
+        case (,) <$> AF.rollback i theirFrag
+                 <*> rewindChainState cfg theirChainState i
         of
           Just (c, d) -> return (c,d)
           -- Remember that we use our current chain fragment as the starting

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/Abstract.hs

@@ -43,8 +43,7 @@ import           GHC.Generics (Generic)
 import           Cardano.Prelude (NoUnexpectedThunks)
 
 import           Ouroboros.Network.AnchoredFragment (AnchoredFragment (..))
-import           Ouroboros.Network.Block (HasHeader (..), SlotNo (..))
-import           Ouroboros.Network.Point (WithOrigin)
+import           Ouroboros.Network.Block (HasHeader (..), Point, SlotNo (..))
 
 import qualified Ouroboros.Consensus.Util.AnchoredFragment as AF
 import           Ouroboros.Consensus.Util.Random
@@ -189,10 +188,10 @@ class ( Show (ChainState    p)
   -- blocks.
   --
   -- This function should attempt to rewind the chain state to the state at some
-  -- given slot, or Origin to rewind to the state with no blocks.
+  -- given point.
   --
-  -- PRECONDITION: the slot to rewind to must correspond to the slot of a
-  -- header (or 'Origin') that was previously applied to the chain state using
+  -- PRECONDITION: the point to rewind to must correspond to a header (or
+  -- 'Origin') that was previously applied to the chain state using
   -- 'applyChainState'.
   --
   -- Rewinding the chain state is intended to be used when switching to a
@@ -207,14 +206,10 @@ class ( Show (ChainState    p)
   -- state). For example, rewinding a chain state by @i@ blocks and then
   -- rewinding that chain state again by @j@ where @i + j > k@ is not possible
   -- and will yield 'Nothing'.
-  rewindChainState :: NodeConfig p
+  rewindChainState :: CanValidate p hdr
+                   => NodeConfig p
                    -> ChainState p
-                   -> WithOrigin SlotNo
-                   -- ^ Slot to rewind to
-                   --
-                   -- This should be the state at the /end/ of the specified
-                   -- slot (i.e., after the block in that slot, if any, has
-                   -- been applied).
+                   -> Point hdr    -- ^ Point to rewind to
                    -> Maybe (ChainState p)
 
   --

ouroboros-consensus/src/Ouroboros/Consensus/Protocol/PBFT.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE LambdaCase              #-}
 {-# LANGUAGE MultiParamTypeClasses   #-}
 {-# LANGUAGE NamedFieldPuns          #-}
+{-# LANGUAGE PatternSynonyms         #-}
 {-# LANGUAGE RecordWildCards         #-}
 {-# LANGUAGE ScopedTypeVariables     #-}
 {-# LANGUAGE StandaloneDeriving      #-}
@@ -39,6 +40,7 @@ import           Control.Monad.Except
 import           Crypto.Random (MonadRandom)
 import           Data.Bimap (Bimap)
 import qualified Data.Bimap as Bimap
+import           Data.Proxy (Proxy (..))
 import qualified Data.Set as Set
 import           Data.Typeable (Typeable)
 import           Data.Word (Word64)
@@ -50,8 +52,8 @@ import           Cardano.Crypto.DSIGN.Class
 import           Cardano.Prelude (NoUnexpectedThunks)
 
 import qualified Ouroboros.Network.AnchoredFragment as AF
-import           Ouroboros.Network.Block (HasHeader (..), SlotNo (..))
-import           Ouroboros.Network.Point (WithOrigin (At))
+import           Ouroboros.Network.Block (pattern BlockPoint, pattern GenesisPoint, HasHeader (..), HeaderHash, Point, SlotNo (..))
+import           Ouroboros.Network.Point (WithOrigin (..))
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Crypto.DSIGN.Cardano
@@ -60,6 +62,8 @@ import           Ouroboros.Consensus.NodeId (CoreNodeId (..))
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Protocol.PBFT.ChainState (PBftChainState)
 import qualified Ouroboros.Consensus.Protocol.PBFT.ChainState as CS
+import           Ouroboros.Consensus.Protocol.PBFT.ChainState.HeaderHashBytes (
+                     headerHashBytes)
 import           Ouroboros.Consensus.Protocol.PBFT.Crypto
 import           Ouroboros.Consensus.Util.Condense
 import           Ouroboros.Consensus.Util.Orphans ()
@@ -91,6 +95,7 @@ instance (PBftCrypto c, Typeable toSign) => NoUnexpectedThunks (PBftFields c toS
 -- epoch boundary blocks (EBBs), which are unsigned. Of course the intention
 -- here is that 'headerPBftFields' will return 'Just' for regular blocks.
 class ( HasHeader hdr
+      , Serialise (HeaderHash hdr)
       , Signable (PBftDSIGN c) (OptSigned hdr)
       , BlockProtocol hdr ~ PBft cfg c
       ) => HeaderSupportsPBft cfg c hdr where
@@ -244,7 +249,7 @@ instance ( PBftCrypto c
   applyChainState cfg@PBftNodeConfig{..} lv@(PBftLedgerView dms) (b :: hdr) chainState =
       case headerPBftFields pbftExtConfig b of
         Nothing -> do
-          return $! appendEBB cfg params (blockSlot b) chainState
+          return $! appendEBB cfg params b chainState
         Just (PBftFields{..}, signed) -> do
           -- Check that the issuer signature verifies, and that it's a delegate of a
           -- genesis key, and that genesis key hasn't voted too many times.
@@ -360,26 +365,32 @@ append PBftNodeConfig{..} PBftWindowParams{..} =
   where
     PBftParams{..} = pbftParams
 
-appendEBB :: PBftCrypto c
+appendEBB :: forall cfg c hdr.
+             (PBftCrypto c, HeaderSupportsPBft cfg c hdr)
           => NodeConfig (PBft cfg c)
           -> PBftWindowParams
-          -> SlotNo
+          -> hdr
           -> PBftChainState c -> PBftChainState c
-appendEBB PBftNodeConfig{..} PBftWindowParams{..} =
+appendEBB PBftNodeConfig{..} PBftWindowParams{..} b =
     CS.appendEBB pbftSecurityParam windowSize
+      (blockSlot b) (headerHashBytes (Proxy :: Proxy hdr) (blockHash b))
   where
     PBftParams{..} = pbftParams
 
-rewind :: PBftCrypto c
+rewind :: forall cfg c hdr.
+          (PBftCrypto c, HeaderSupportsPBft cfg c hdr)
        => NodeConfig (PBft cfg c)
        -> PBftWindowParams
-       -> WithOrigin SlotNo
+       -> Point hdr
        -> PBftChainState c
        -> Maybe (PBftChainState c)
-rewind PBftNodeConfig{..} PBftWindowParams{..} =
-    CS.rewind pbftSecurityParam windowSize
+rewind PBftNodeConfig{..} PBftWindowParams{..} p =
+    CS.rewind pbftSecurityParam windowSize p'
   where
     PBftParams{..} = pbftParams
+    p' = case p of
+      GenesisPoint    -> Origin
+      BlockPoint s hh -> At (s, headerHashBytes (Proxy :: Proxy hdr) hh)
 
 {-------------------------------------------------------------------------------
   Extract necessary context