Merge pull request #4767 from IntersectMBO/lehins/avoid-computing-cur…

…rent-epochNo

Simplify working with current epoch number

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs

@@ -232,17 +232,16 @@ alonzoBbodyTransition =
         -- we make an assumption that 'incrBlocks' must enforce, better for it
         -- to be done in 'incrBlocks' where we can see that the assumption is
         -- enforced.
-        let hkAsStakePool = coerceKeyRole . bhviewID $ bh
+        let hkAsStakePool = coerceKeyRole $ bhviewID bh
             slot = bhviewSlot bh
-        (firstSlotNo, currEpoch) <- liftSTS $ do
+        (firstSlotNo, curEpochNo) <- liftSTS $ do
           ei <- asks epochInfoPure
-          e <- epochInfoEpoch ei slot
-          firstSlot <- epochInfoFirst ei e
-          pure (firstSlot, e)
+          let curEpochNo = epochInfoEpoch ei slot
+          pure (epochInfoFirst ei curEpochNo, curEpochNo)
 
         ls' <-
           trans @(EraRule "LEDGERS" era) $
-            TRC (LedgersEnv (bhviewSlot bh) currEpoch pp account, ls, StrictSeq.fromStrict txs)
+            TRC (LedgersEnv (bhviewSlot bh) curEpochNo pp account, ls, StrictSeq.fromStrict txs)
 
         {- ∑(tx ∈ txs)(totExunits tx) ≤ maxBlockExUnits pp  -}
         let txTotal, ppMax :: ExUnits

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs

@@ -24,7 +24,7 @@ import Cardano.Ledger.Alonzo.Rules.Utxo (AlonzoUtxoPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUTXOW, AlonzoUtxowEvent, AlonzoUtxowPredFailure)
 import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), AlonzoTx (..), IsValid (..))
-import Cardano.Ledger.BaseTypes (ShelleyBase, epochInfoPure)
+import Cardano.Ledger.BaseTypes (ShelleyBase)
 import Cardano.Ledger.Keys (DSignable, Hash)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.LedgerState (
@@ -55,8 +55,7 @@ import Cardano.Ledger.Shelley.Rules as Shelley (
   ShelleyLedgersPredFailure (..),
   renderDepositEqualsObligationViolation,
  )
-import Cardano.Ledger.Slot (epochInfoEpoch)
-import Control.Monad.Trans.Reader (asks)
+import Cardano.Ledger.Slot (epochFromSlot)
 import Control.State.Transition (
   Embed (..),
   STS (..),
@@ -131,22 +130,18 @@ ledgerTransition ::
   ) =>
   TransitionRule (someLEDGER era)
 ledgerTransition = do
-  TRC (LedgerEnv slot mbEpochNo txIx pp account _, LedgerState utxoSt certState, tx) <-
+  TRC (LedgerEnv slot mbCurEpochNo txIx pp account _, LedgerState utxoSt certState, tx) <-
     judgmentContext
   let txBody = tx ^. bodyTxL
 
-  epochNo <- case mbEpochNo of
-    Nothing -> liftSTS $ do
-      ei <- asks epochInfoPure
-      epochInfoEpoch ei slot
-    Just e -> pure e
+  curEpochNo <- maybe (liftSTS $ epochFromSlot slot) pure mbCurEpochNo
 
   certState' <-
     if tx ^. isValidTxL == IsValid True
       then
         trans @(EraRule "DELEGS" era) $
           TRC
-            ( DelegsEnv slot epochNo txIx pp tx account
+            ( DelegsEnv slot curEpochNo txIx pp tx account
             , certState
             , StrictSeq.fromStrict $ txBody ^. certsTxBodyL
             )

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Cert.hs

@@ -77,7 +77,8 @@ import NoThunks.Class (NoThunks)
 
 data CertEnv era = CertEnv
   { cePParams :: !(PParams era)
-  , ceCurrentEpoch :: !EpochNo
+  , ceCurrentEpoch :: EpochNo
+  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
   , ceCurrentCommittee :: StrictMaybe (Committee era)
   , ceCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   }

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Certs.hs

@@ -88,7 +88,8 @@ import NoThunks.Class (NoThunks (..))
 data CertsEnv era = CertsEnv
   { certsTx :: !(Tx era)
   , certsPParams :: !(PParams era)
-  , certsCurrentEpoch :: !EpochNo
+  , certsCurrentEpoch :: EpochNo
+  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
   , certsCurrentCommittee :: StrictMaybe (Committee era)
   , certsCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   }

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/GovCert.hs

@@ -91,7 +91,8 @@ import NoThunks.Class (NoThunks (..))
 
 data ConwayGovCertEnv era = ConwayGovCertEnv
   { cgcePParams :: !(PParams era)
-  , cgceCurrentEpoch :: !EpochNo
+  , cgceCurrentEpoch :: EpochNo
+  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
   , cgceCurrentCommittee :: StrictMaybe (Committee era)
   , cgceCommitteeProposals :: Map.Map (GovPurposeId 'CommitteePurpose era) (GovActionState era)
   -- ^ All of the `UpdateCommittee` proposals

eras/conway/impl/src/Cardano/Ledger/Conway/Rules/Ledger.hs

@@ -44,7 +44,6 @@ import Cardano.Ledger.BaseTypes (
   Relation (..),
   ShelleyBase,
   StrictMaybe (..),
-  epochInfoPure,
   swapMismatch,
   unswapMismatch,
  )
@@ -114,13 +113,12 @@ import Cardano.Ledger.Shelley.Rules (
   renderDepositEqualsObligationViolation,
   shelleyLedgerAssertions,
  )
-import Cardano.Ledger.Slot (epochInfoEpoch)
+import Cardano.Ledger.Slot (epochFromSlot)
 import Cardano.Ledger.UMap (UView (..))
 import qualified Cardano.Ledger.UMap as UMap
 import Cardano.Ledger.UTxO (EraUTxO (..))
 import Control.DeepSeq (NFData)
 import Control.Monad (unless, void, when)
-import Control.Monad.Trans.Reader (asks)
 import Control.State.Transition.Extended (
   Embed (..),
   STS (..),
@@ -383,7 +381,7 @@ ledgerTransition ::
   TransitionRule (someLEDGER era)
 ledgerTransition = do
   TRC
-    ( le@(LedgerEnv slot mbCurrentEpoch _txIx pp account mempool)
+    ( le@(LedgerEnv slot mbCurEpochNo _txIx pp account mempool)
       , ls@(LedgerState utxoState certState)
       , tx
       ) <-
@@ -394,11 +392,7 @@ ledgerTransition = do
       trans @(EraRule "MEMPOOL" era) $
         TRC (le, ls, tx)
 
-  currentEpoch <- case mbCurrentEpoch of
-    Nothing -> liftSTS $ do
-      ei <- asks epochInfoPure
-      epochInfoEpoch ei slot
-    Just e -> pure e
+  curEpochNo <- maybe (liftSTS $ epochFromSlot slot) pure mbCurEpochNo
 
   (utxoState', certStateAfterCERTS) <-
     if tx ^. isValidTxL == IsValid True
@@ -452,7 +446,7 @@ ledgerTransition = do
         certStateAfterCERTS <-
           trans @(EraRule "CERTS" era) $
             TRC
-              ( CertsEnv tx pp currentEpoch committee committeeProposals
+              ( CertsEnv tx pp curEpochNo committee committeeProposals
               , certState
               , StrictSeq.fromStrict $ txBody ^. certsTxBodyL
               )
@@ -469,7 +463,7 @@ ledgerTransition = do
             TRC
               ( GovEnv
                   (txIdTxBody txBody)
-                  currentEpoch
+                  curEpochNo
                   pp
                   (govState ^. constitutionGovStateL . constitutionScriptL)
                   certStateAfterCERTS

eras/shelley/impl/src/Cardano/Ledger/Shelley/API/Wallet.hs

@@ -41,7 +41,6 @@ where
 
 import Cardano.Ledger.Address (Addr (..), compactAddr)
 import Cardano.Ledger.BaseTypes (
-  BlocksMade,
   Globals (..),
   NonNegativeInterval,
   UnitInterval,
@@ -404,21 +403,19 @@ getRewardProvenance ::
   Globals ->
   NewEpochState era ->
   (RewardUpdate (EraCrypto era), RewardProvenance (EraCrypto era))
-getRewardProvenance globals newepochstate =
+getRewardProvenance globals newEpochState =
   ( runReader
-      (createRUpd slotsPerEpoch blocksmade epochstate maxsupply asc secparam)
+      (createRUpd slotsPerEpoch blocksMade epochState maxSupply asc secparam)
       globals
   , def
   )
   where
-    epochstate = nesEs newepochstate
-    maxsupply :: Coin
-    maxsupply = Coin (fromIntegral (maxLovelaceSupply globals))
-    blocksmade :: BlocksMade (EraCrypto era)
-    blocksmade = nesBprev newepochstate
-    epochnumber = nesEL newepochstate
+    epochState = nesEs newEpochState
+    maxSupply = Coin (fromIntegral (maxLovelaceSupply globals))
+    blocksMade = nesBprev newEpochState
+    epochNo = nesEL newEpochState
     slotsPerEpoch :: EpochSize
-    slotsPerEpoch = runReader (epochInfoSize (epochInfoPure globals) epochnumber) globals
+    slotsPerEpoch = epochInfoSize (epochInfoPure globals) epochNo
     asc = activeSlotCoeff globals
     secparam = securityParameter globals
 

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Bbody.hs

@@ -209,15 +209,14 @@ bbodyTransition =
         -- easier than differentiating here.
         let hkAsStakePool = coerceKeyRole $ bhviewID bhview
             slot = bhviewSlot bhview
-        (firstSlotNo, currEpoch) <- liftSTS $ do
+        (firstSlotNo, curEpochNo) <- liftSTS $ do
           ei <- asks epochInfoPure
-          e <- epochInfoEpoch ei slot
-          firstSlot <- epochInfoFirst ei e
-          pure (firstSlot, e)
+          let curEpochNo = epochInfoEpoch ei slot
+          pure (epochInfoFirst ei curEpochNo, curEpochNo)
 
         ls' <-
           trans @(EraRule "LEDGERS" era) $
-            TRC (LedgersEnv (bhviewSlot bhview) currEpoch pp account, ls, StrictSeq.fromStrict txs)
+            TRC (LedgersEnv (bhviewSlot bhview) curEpochNo pp account, ls, StrictSeq.fromStrict txs)
 
         let isOverlay = isOverlaySlot firstSlotNo (pp ^. ppDG) slot
         pure $ BbodyState ls' (incrBlocks isOverlay hkAsStakePool b)

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Deleg.hs

@@ -20,11 +20,13 @@ module Cardano.Ledger.Shelley.Rules.Deleg (
 where
 
 import Cardano.Ledger.BaseTypes (
+  EpochInterval (..),
   Globals (..),
   Mismatch (..),
   Relation (..),
   ShelleyBase,
   StrictMaybe (..),
+  addEpochInterval,
   epochInfoPure,
   invalidKey,
  )
@@ -87,7 +89,8 @@ import NoThunks.Class (NoThunks (..))
 
 data DelegEnv era = DelegEnv
   { slotNo :: !SlotNo
-  , curEpochNo :: !EpochNo
+  , deCurEpochNo :: EpochNo
+  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
   , ptr_ :: !Ptr
   , acnt_ :: !AccountState
   , ppDE :: !(PParams era) -- The protocol parameters are only used for the HardFork mechanism
@@ -377,13 +380,13 @@ checkSlotNotTooLate ::
   SlotNo ->
   EpochNo ->
   Rule (ShelleyDELEG era) 'Transition ()
-checkSlotNotTooLate slot (EpochNo currEpoch) = do
+checkSlotNotTooLate slot curEpochNo = do
   sp <- liftSTS $ asks stabilityWindow
   ei <- liftSTS $ asks epochInfoPure
-  let newEpoch = EpochNo (currEpoch + 1)
+  let firstSlot = epochInfoFirst ei newEpoch
+      tooLate = firstSlot *- Duration sp
+      newEpoch = addEpochInterval curEpochNo (EpochInterval 1)
   tellEvent (DelegNewEpoch newEpoch)
-  firstSlot <- liftSTS $ epochInfoFirst ei newEpoch
-  let tooLate = firstSlot *- Duration sp
   slot < tooLate ?! MIRCertificateTooLateinEpochDELEG (Mismatch slot tooLate)
 
 updateReservesAndTreasury ::

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delegs.hs

@@ -101,7 +101,8 @@ import Validation (failureUnless)
 
 data DelegsEnv era = DelegsEnv
   { delegsSlotNo :: !SlotNo
-  , delegsEpochNo :: !EpochNo
+  , delegsEpochNo :: EpochNo
+  -- ^ Lazy on purpose, because not all certificates need to know the current EpochNo
   , delegsIx :: !TxIx
   , delegspp :: !(PParams era)
   , delegsTx :: !(Tx era)

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Delpl.hs

@@ -60,7 +60,7 @@ import NoThunks.Class (NoThunks (..))
 
 data DelplEnv era = DelplEnv
   { delplSlotNo :: SlotNo
-  , delpEpochNo :: EpochNo
+  , delplEpochNo :: EpochNo
   , delPlPtr :: Ptr
   , delPlPp :: PParams era
   , delPlAccount :: AccountState

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Ledger.hs

@@ -35,7 +35,7 @@ module Cardano.Ledger.Shelley.Rules.Ledger (
 )
 where
 
-import Cardano.Ledger.BaseTypes (Globals, ShelleyBase, TxIx, epochInfoPure, invalidKey)
+import Cardano.Ledger.BaseTypes (ShelleyBase, TxIx, invalidKey)
 import Cardano.Ledger.Binary (
   DecCBOR (..),
   EncCBOR (..),
@@ -68,10 +68,8 @@ import Cardano.Ledger.Shelley.Rules.Ppup (ShelleyPpupPredFailure)
 import Cardano.Ledger.Shelley.Rules.Reports (showTxCerts)
 import Cardano.Ledger.Shelley.Rules.Utxo (ShelleyUtxoPredFailure (..), UtxoEnv (..))
 import Cardano.Ledger.Shelley.Rules.Utxow (ShelleyUTXOW, ShelleyUtxowPredFailure)
-import Cardano.Ledger.Slot (EpochNo (..), SlotNo, epochInfoEpoch)
+import Cardano.Ledger.Slot (EpochNo (..), SlotNo, epochFromSlot)
 import Control.DeepSeq (NFData (..))
-import Control.Monad.Reader (Reader)
-import Control.Monad.Trans.Reader (asks)
 import Control.State.Transition (
   Assertion (PostCondition),
   AssertionViolation (..),
@@ -244,11 +242,6 @@ instance
           pure (2, DelegsFailure a)
         k -> invalidKey k
 
-epochFromSlot :: SlotNo -> Reader Globals EpochNo
-epochFromSlot slot = do
-  ei <- asks epochInfoPure
-  epochInfoEpoch ei slot
-
 shelleyLedgerAssertions ::
   ( EraGov era
   , State (rule era) ~ LedgerState era
@@ -307,17 +300,13 @@ ledgerTransition ::
   ) =>
   TransitionRule (ShelleyLEDGER era)
 ledgerTransition = do
-  TRC (LedgerEnv slot mbEpochNo txIx pp account _, LedgerState utxoSt certState, tx) <-
+  TRC (LedgerEnv slot mbCurEpochNo txIx pp account _, LedgerState utxoSt certState, tx) <-
     judgmentContext
-  epochNo <- case mbEpochNo of
-    Nothing -> liftSTS $ do
-      ei <- asks epochInfoPure
-      epochInfoEpoch ei slot
-    Just e -> pure e
+  curEpochNo <- maybe (liftSTS $ epochFromSlot slot) pure mbCurEpochNo
   certState' <-
     trans @(EraRule "DELEGS" era) $
       TRC
-        ( DelegsEnv slot epochNo txIx pp tx account
+        ( DelegsEnv slot curEpochNo txIx pp tx account
         , certState
         , StrictSeq.fromStrict $ tx ^. bodyTxL . certsTxBodyL
         )

eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Rupd.hs

@@ -69,7 +69,6 @@ import Control.State.Transition (
   liftSTS,
   tellEvent,
  )
-import Data.Functor ((<&>))
 import qualified Data.Map.Strict as Map
 import Data.Set (Set)
 import GHC.Generics (Generic)
@@ -129,9 +128,9 @@ rupdTransition = do
   (slotsPerEpoch, slot, slotForce, maxLL, asc, k, e) <- liftSTS $ do
     ei <- asks epochInfoPure
     sr <- asks randomnessStabilisationWindow
-    e <- epochInfoEpoch ei s
-    slotsPerEpoch <- epochInfoSize ei e
-    slot <- epochInfoFirst ei e <&> (+* Duration sr)
+    let e = epochInfoEpoch ei s
+        slotsPerEpoch = epochInfoSize ei e
+        slot = epochInfoFirst ei e +* Duration sr
     maxLL <- asks maxLovelaceSupply
     asc <- asks activeSlotCoeff
     k <- asks securityParameter -- Maximum number of blocks we are allowed to roll back

eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/ImpTest.hs

@@ -599,7 +599,7 @@ defaultInitImpTestState nes = do
           (mkSlotLength . fromNominalDiffTimeMicro $ sgSlotLength shelleyGenesis)
       globals = mkShelleyGlobals shelleyGenesis epochInfoE
       epochNo = nesWithRoot ^. nesELL
-      slotNo = runIdentity $ runReaderT (epochInfoFirst (epochInfoPure globals) epochNo) globals
+      slotNo = epochInfoFirst (epochInfoPure globals) epochNo
   pure $
     ImpTestState
       { impNES = nesWithRoot

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

@@ -503,7 +503,7 @@ getKESPeriodRenewalNo keys (KESPeriod kp) =
 tooLateInEpoch :: SlotNo -> Bool
 tooLateInEpoch s = runShelleyBase $ do
   ei <- asks epochInfoPure
-  firstSlotNo <- epochInfoFirst ei (epochFromSlotNo s + 1)
+  let firstSlotNo = epochInfoFirst ei (epochFromSlotNo s + 1)
   stabilityWindow <- asks stabilityWindow
 
   return (s >= firstSlotNo *- Duration (2 * stabilityWindow))

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

@@ -635,9 +635,9 @@ oldEqualsNew pv newepochstate =
     maxsupply = Coin (fromIntegral (maxLovelaceSupply globals))
     blocksmade :: BlocksMade (EraCrypto era)
     blocksmade = nesBprev newepochstate
-    epochnumber = nesEL newepochstate
+    epochNumber = nesEL newepochstate
     slotsPerEpoch :: EpochSize
-    slotsPerEpoch = runReader (epochInfoSize (epochInfoPure globals) epochnumber) globals
+    slotsPerEpoch = epochInfoSize (epochInfoPure globals) epochNumber
     unAggregated =
       runReader (createRUpd slotsPerEpoch blocksmade epochstate maxsupply asc k) globals
     old = rsOld $ runReader (createRUpdOld slotsPerEpoch blocksmade epochstate maxsupply) globals
@@ -660,9 +660,9 @@ oldEqualsNewOn pv newepochstate = old === new
     maxsupply = Coin (fromIntegral (maxLovelaceSupply globals))
     blocksmade :: BlocksMade (EraCrypto era)
     blocksmade = nesBprev newepochstate
-    epochnumber = nesEL newepochstate
+    epochNumber = nesEL newepochstate
     slotsPerEpoch :: EpochSize
-    slotsPerEpoch = runReader (epochInfoSize (epochInfoPure globals) epochnumber) globals
+    slotsPerEpoch = epochInfoSize (epochInfoPure globals) epochNumber
     unAggregated =
       runReader (createRUpd slotsPerEpoch blocksmade epochstate maxsupply asc k) globals
     old :: Map (Credential 'Staking (EraCrypto era)) Coin