Merge pull request #2240 from input-output-hk/jc/dont-bang-the-mark-f…

…or-merging dont bang the mark for merging
IntersectMBO · Apr 19, 2021 · 49d29c3 · 49d29c3
2 parents 476e3a0 + e4d3830
commit 49d29c3
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 1 deletion.
diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/EpochBoundary.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/EpochBoundary.hs
@@ -216,7 +216,7 @@ instance
 
 -- | Snapshots of the stake distribution.
 data SnapShots crypto = SnapShots
-  { _pstakeMark :: !(SnapShot crypto),
+  { _pstakeMark :: SnapShot crypto,
     _pstakeSet :: !(SnapShot crypto),
     _pstakeGo :: !(SnapShot crypto),
     _feeSS :: !Coin

diff --git a/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Tick.hs b/shelley/chain-and-ledger/executable-spec/src/Shelley/Spec/Ledger/STS/Tick.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE DerivingStrategies #-}
@@ -32,6 +33,7 @@ import qualified Data.Map.Strict as Map
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
 import Shelley.Spec.Ledger.BaseTypes (ShelleyBase, StrictMaybe (..), epochInfo)
+import Shelley.Spec.Ledger.EpochBoundary (SnapShots (_pstakeMark))
 import Shelley.Spec.Ledger.Keys (GenDelegs (..))
 import Shelley.Spec.Ledger.LedgerState (DPState (..), DState (..), EpochState (..), FutureGenDeleg (..), LedgerState (..), NewEpochState (..), PulsingRewUpdate)
 import Shelley.Spec.Ledger.STS.NewEpoch (NEWEPOCH, NewEpochPredicateFailure)
@@ -168,6 +170,12 @@ bheadTransition = do
 
   nes' <- validatingTickTransition @TICK nes slot
 
+  -- Here we force the evaluation of the mark snapshot.
+  -- We do NOT force it in the TICKF and TICKN rule
+  -- so that it can remain a thunk when the consensus
+  -- layer computes the ledger view across the epoch boundary.
+  let !_ = _pstakeMark . esSnapshots . nesEs $ nes'
+
   ru'' <-
     trans @(Core.EraRule "RUPD" era) $
       TRC (RupdEnv bprev es, nesRu nes', slot)