consensus: bugfix in CS client: correctly rollback to an EBB with a b…

…lock in same slot

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

@@ -330,9 +330,7 @@ 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)
-          of
+          case rollback cfg ourFrag ourChainState intersection of
             Just (c, d) -> return (c, d)
             -- The @intersection@ is not on the candidate chain, even though
             -- we sent only points from the candidate chain to find an
@@ -635,9 +633,7 @@ chainSyncClient mkPipelineDecision0 tracer cfg btime
                    , ourTip
                    } -> traceException $ do
       (theirFrag', theirChainState') <-
-        case (,) <$> AF.rollback (castPoint intersection) theirFrag
-                 <*> rewindChainState cfg theirChainState (pointSlot intersection)
-        of
+        case rollback cfg theirFrag theirChainState intersection of
           Just (c, d) -> return (c,d)
           -- Remember that we use our current chain fragment as the starting
           -- point for the candidate's chain. Our fragment contained @k@
@@ -767,6 +763,28 @@ rejectInvalidBlocks tracer registry getIsInvalidBlock getCandidate =
       traceWith tracer $ TraceException ex
       throwM ex
 
+rollback
+  :: ( HasHeader (Header blk)
+     , OuroborosTag (BlockProtocol blk)
+     )
+  => NodeConfig (BlockProtocol blk)
+  -> AnchoredFragment (Header blk)
+  -> ChainState (BlockProtocol blk)
+  -> Point blk
+  -> Maybe (AnchoredFragment (Header blk), ChainState (BlockProtocol blk))
+rollback cfg ourFrag ourChainState intersection = do
+    let i = castPoint intersection
+    frag' <- AF.rollback i ourFrag
+
+    let slot = pointSlot i
+    let isAccompaniedEBB = case AF.successorBlock i ourFrag of
+          Nothing  -> False
+            -- intersection might be an EBB, but not an accompanied one
+          Just hdr -> At (blockSlot hdr) == slot
+    cs' <- rewindChainState cfg ourChainState slot isAccompaniedEBB
+
+    pure (frag', cs')
+
 {-------------------------------------------------------------------------------
   Explicit state
 -------------------------------------------------------------------------------}

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

@@ -215,7 +215,10 @@ class ( Show (ChainState    p)
                    --
                    -- 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).
+                   -- been applied)...
+                   -> Bool
+                   -- ^ ... unless the target block is an EBB accompanied by a
+                   -- non-EBB block in the same slot.
                    -> Maybe (ChainState p)
 
   --

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

@@ -158,7 +158,7 @@ instance BftCrypto c => OuroborosTag (Bft c) where
       SlotNo n       = blockSlot b
       expectedLeader = CoreId $ fromIntegral (n `mod` bftNumNodes)
 
-  rewindChainState _ _ _ = Just ()
+  rewindChainState _ _ _ _ = Just ()
 
 instance BftCrypto c => NoUnexpectedThunks (NodeConfig (Bft c))
   -- use generic instance

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

@@ -73,7 +73,7 @@ instance OuroborosTag p => OuroborosTag (WithLeaderSchedule p) where
             | lsNodeConfigNodeId `elem` nids -> Just ()
             | otherwise                      -> Nothing
 
-  applyChainState _ _ _ _ = return ()
-  rewindChainState _ _ _  = Just ()
+  applyChainState _ _ _ _  = return ()
+  rewindChainState _ _ _ _ = Just ()
 
 instance OuroborosTag p => NoUnexpectedThunks (NodeConfig (WithLeaderSchedule p))

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

@@ -271,7 +271,8 @@ instance ( PBftCrypto c
     where
       params = pbftWindowParams cfg
 
-  rewindChainState cfg = flip (rewind cfg params)
+  rewindChainState cfg chainState slot isEBB =
+      rewind cfg params slot isEBB chainState
     where
       params = pbftWindowParams cfg
 
@@ -351,6 +352,7 @@ rewind :: PBftCrypto c
        => NodeConfig (PBft cfg c)
        -> PBftWindowParams
        -> WithOrigin SlotNo
+       -> Bool
        -> PBftChainState c
        -> Maybe (PBftChainState c)
 rewind PBftNodeConfig{..} PBftWindowParams{..} =

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

@@ -4,6 +4,7 @@
 {-# LANGUAGE FlexibleContexts           #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LambdaCase                 #-}
+{-# LANGUAGE PatternGuards              #-}
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE ScopedTypeVariables        #-}
 {-# LANGUAGE StandaloneDeriving         #-}
@@ -394,12 +395,21 @@ append k n signer@(PBftSigner _ gk) PBftChainState{..} =
 -- In addition to preserving the invariant, we also have the guarantee that
 -- rolling back to a point (within @k@) and then reapplying the blocks that were
 -- rolled back results in the original state.
-rewind :: forall c. PBftCrypto c
+rewind :: forall c. (PBftCrypto c, HasCallStack)
        => SecurityParam
        -> WindowSize
        -> WithOrigin SlotNo
+       -> Bool
        -> PBftChainState c -> Maybe (PBftChainState c)
-rewind k n mSlot cs@PBftChainState{..} =
+rewind k n mSlot isEBB cs@PBftChainState{..}
+  | isEBB, At s <- mSlot = case ebbsLookup s ebbs of
+      Nothing     -> error $ "no EBB previously applied, " ++ show (mSlot, ebbs)
+      Just mSlot' -> case rewind_ k n mSlot' cs of
+        Right mbCs' -> pruneEBBsGT mSlot <$> mbCs'
+        Left mSlot'' ->
+          error $ "rewind: rollback to EBB not previously applied, "
+              ++ show (mSlot, mSlot', mSlot'', ebbs)
+  | otherwise =
   case rewind_ k n mSlot cs of
     Right mbCs' -> pruneEBBsGT mSlot <$> mbCs'
     Left mSlot' ->

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

@@ -329,7 +329,7 @@ instance ( PraosCrypto c
   --
   -- We don't roll back to the exact slot since that slot might not have been
   -- filled; instead we roll back the the block just before it.
-  rewindChainState PraosNodeConfig{..} cs rewindTo =
+  rewindChainState PraosNodeConfig{..} cs rewindTo _ =
       -- This may drop us back to the empty list if we go back to genesis
       Just $ dropWhile (\bi -> At (biSlot bi) > rewindTo) cs
 

ouroboros-consensus/test-consensus/Test/Consensus/Protocol/PBFT.hs

@@ -414,6 +414,7 @@ prop_directABb TestChainState{..} =
                    state0
         mbState2 = CS.rewind k n
                      (slotLatestInput $ toLastInput testChainInputsA)
+                     False
                      state1
     in Just testChainState === mbState2
 
@@ -451,6 +452,7 @@ prop_rewindPreservesInvariant TestChainState{..} =
                     testChainStateK
                     testChainStateN
                     testChainRewind
+                    False
                     testChainState
     in case rewound of
          Nothing     -> label "rollback too far in the past" True
@@ -468,6 +470,7 @@ prop_rewindReappendId TestChainState{..} =
                     testChainStateK
                     testChainStateN
                     testChainRewind
+                    False
                     testChainState
     in case rewound of
          Nothing     -> label "rollback too far in the past" True