Add optional previous epoch Nonce to BHeaderView

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Imp/BbodySpec.hs

@@ -281,6 +281,7 @@ spec = do
               , bhviewHSize = 0
               , bhviewBHash = hashBlockBody blockBody
               , bhviewSlot = slotNo
+              , bhviewPrevEpochNonce = Nothing
               }
       tryRunImpRule @"BBODY"
         (BbodyEnv pp (nes ^. chainAccountStateL))

eras/dijkstra/impl/CHANGELOG.md

@@ -2,6 +2,9 @@
 
 ## 0.2.0.0
 
+* Add `bhviewPrevEpochNonce` to `BHeaderView`
+* Change `makeHeaderView` to expect an additional `Maybe Nonce`
+* Add `dijkstraBbodyTransition` to the BBODY rule
 * Add `DijkstraBlockBody` type and pattern
 * Add `mkBasicBlockBodyDijkstra`
 * Add `DijkstraEraBlockBody` class and instance for `DijkstraEraBlockBody`

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Rules/Bbody.hs

@@ -82,7 +82,11 @@ import qualified Cardano.Ledger.Shelley.Rules as Shelley
 import Control.State.Transition (
   Embed (..),
   STS (..),
+  TransitionRule,
+  judgmentContext,
  )
+import Control.State.Transition.Extended (TRC (..), (?!))
+import Data.Maybe (isNothing)
 import Data.Sequence (Seq)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
@@ -94,6 +98,7 @@ data DijkstraBbodyPredFailure era
     LedgersFailure (PredicateFailure (EraRule "LEDGERS" era))
   | TooManyExUnits (Mismatch RelLTEQ ExUnits)
   | BodyRefScriptsSizeTooBig (Mismatch RelLTEQ Int)
+  | PrevEpochNonceNotPresent
   deriving (Generic)
 
 deriving instance
@@ -121,6 +126,7 @@ instance
       LedgersFailure x -> Sum (LedgersFailure @era) 2 !> To x
       TooManyExUnits mm -> Sum TooManyExUnits 3 !> To mm
       BodyRefScriptsSizeTooBig mm -> Sum BodyRefScriptsSizeTooBig 4 !> To mm
+      PrevEpochNonceNotPresent -> Sum PrevEpochNonceNotPresent 5
 
 instance
   ( Era era
@@ -134,6 +140,7 @@ instance
     2 -> SumD LedgersFailure <! From
     3 -> SumD TooManyExUnits <! From
     4 -> SumD BodyRefScriptsSizeTooBig <! From
+    5 -> SumD PrevEpochNonceNotPresent
     n -> Invalid n
 
 type instance EraRuleFailure "BBODY" DijkstraEra = DijkstraBbodyPredFailure DijkstraEra
@@ -297,6 +304,7 @@ instance
   , AlonzoEraPParams era
   , InjectRuleFailure "BBODY" AlonzoBbodyPredFailure era
   , InjectRuleFailure "BBODY" ConwayBbodyPredFailure era
+  , InjectRuleFailure "BBODY" DijkstraBbodyPredFailure era
   , EraRule "BBODY" era ~ DijkstraBBODY era
   , AlonzoEraTx era
   , BabbageEraTxBody era
@@ -317,7 +325,31 @@ instance
   type Event (DijkstraBBODY era) = AlonzoBbodyEvent era
 
   initialRules = []
-  transitionRules = [Conway.conwayBbodyTransition @era >> alonzoBbodyTransition @era]
+  transitionRules =
+    [ dijkstraBbodyTransition @era
+        >> Conway.conwayBbodyTransition @era
+        >> alonzoBbodyTransition @era
+    ]
+
+dijkstraBbodyTransition ::
+  forall era.
+  ( Signal (EraRule "BBODY" era) ~ Block BHeaderView era
+  , State (EraRule "BBODY" era) ~ ShelleyBbodyState era
+  , InjectRuleFailure "BBODY" DijkstraBbodyPredFailure era
+  ) =>
+  TransitionRule (EraRule "BBODY" era)
+dijkstraBbodyTransition = do
+  judgmentContext
+    >>= \( TRC
+             ( _
+               , state
+               , Block bh _
+               )
+           ) -> do
+        -- Check that the previous epoch nonce is present
+        isNothing (bhviewPrevEpochNonce bh)
+          ?! injectFailure PrevEpochNonceNotPresent
+        pure state
 
 conwayToDijkstraBbodyPredFailure ::
   forall era. ConwayBbodyPredFailure era -> DijkstraBbodyPredFailure era

eras/shelley/test-suite/bench/BenchValidation.hs

@@ -93,7 +93,7 @@ benchValidate ::
   ValidateInput era ->
   IO (NewEpochState era)
 benchValidate (ValidateInput globals state (Block bh txs)) =
-  let block = Block (makeHeaderView bh) txs
+  let block = Block (makeHeaderView bh Nothing) txs
    in case API.applyBlockEitherNoEvents ValidateAll globals state block of
         Right x -> pure x
         Left x -> error (show x)
@@ -111,7 +111,7 @@ applyBlock ::
   Int ->
   Int
 applyBlock (ValidateInput globals state (Block bh txs)) n =
-  let block = Block (makeHeaderView bh) txs
+  let block = Block (makeHeaderView bh Nothing) txs
    in case API.applyBlockEitherNoEvents ValidateAll globals state block of
         Right x -> seq (rnf x) (n + 1)
         Left x -> error (show x)
@@ -121,7 +121,7 @@ benchreValidate ::
   ValidateInput era ->
   NewEpochState era
 benchreValidate (ValidateInput globals state (Block bh txs)) =
-  API.applyBlockNoValidaton globals state (Block (makeHeaderView bh) txs)
+  API.applyBlockNoValidaton globals state (Block (makeHeaderView bh Nothing) txs)
 
 -- ==============================================================
 

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs

@@ -173,7 +173,7 @@ genBlockWithTxGen
         -- e.g. the KES period in which this key starts to be valid.
         <*> pure (fromIntegral (m * fromIntegral maxKESIterations))
         <*> pure oCert
-    let hView = makeHeaderView (blockHeader theBlock)
+    let hView = makeHeaderView (blockHeader theBlock) Nothing
     unless (bhviewBSize hView <= pp ^. ppMaxBBSizeL) $
       tracedDiscard $
         "genBlockWithTxGen: bhviewBSize too large"

eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs

@@ -326,7 +326,7 @@ chainTransition =
 
         let pp = nes ^. nesEpochStateL . curPParamsEpochStateL
             chainChecksData = pparamsToChainChecksPParams pp
-            bhView = makeHeaderView bh
+            bhView = makeHeaderView bh Nothing
 
         -- We allow one protocol version higher than the current era's maximum, because
         -- that is the way we can get out of the current era into the next one. We test

libs/cardano-ledger-core/src/Cardano/Ledger/BHeaderView.hs

@@ -3,7 +3,7 @@
 
 module Cardano.Ledger.BHeaderView where
 
-import Cardano.Ledger.BaseTypes (BoundedRational (..), UnitInterval)
+import Cardano.Ledger.BaseTypes (BoundedRational (..), Nonce, UnitInterval)
 import Cardano.Ledger.Hashes (EraIndependentBlockBody, HASH, Hash, KeyHash, KeyRole (..))
 import Cardano.Ledger.Slot (SlotNo (..), (-*))
 import Data.Word (Word32)
@@ -29,6 +29,9 @@ data BHeaderView = BHeaderView
   -- ^ The purported hash of the block body.
   , bhviewSlot :: SlotNo
   -- ^ The slot for which this block was submitted to the chain.
+  , bhviewPrevEpochNonce :: Maybe Nonce
+  -- ^ The previous epoch nonce, needed to validate Peras certificates
+  -- contained in blocks.
   }
 
 -- | Determine if the given slot is reserved for the overlay schedule.

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/AlonzoBBODY.hs

@@ -598,6 +598,7 @@ makeNaiveBlock txs = Block {blockHeader = bhView, blockBody}
         , bhviewHSize = 0
         , bhviewBHash = hashBlockBody blockBody
         , bhviewSlot = SlotNo 0
+        , bhviewPrevEpochNonce = Nothing
         }
     blockBody = mkBasicBlockBody & txSeqBlockBodyL .~ StrictSeq.fromList txs
 

libs/cardano-protocol-tpraos/src/Cardano/Protocol/TPraos/BHeader.hs

@@ -454,11 +454,12 @@ lastAppliedHash (At lab) = BlockHash $ labHash lab
 bnonce :: BHBody c -> Nonce
 bnonce = mkNonceFromOutputVRF . VRF.certifiedOutput . bheaderEta
 
-makeHeaderView :: Crypto c => BHeader c -> BHeaderView
-makeHeaderView bh@(BHeader bhb _) =
+makeHeaderView :: Crypto c => BHeader c -> Maybe Nonce -> BHeaderView
+makeHeaderView bh@(BHeader bhb _) nonce =
   BHeaderView
     (hashKey . bheaderVk $ bhb)
     (bsize bhb)
     (originalBytesSize bh)
     (bhash bhb)
     (bheaderSlotNo bhb)
+    nonce