Conway PParams prediction

eras/allegra/impl/src/Cardano/Ledger/Allegra/PParams.hs

@@ -51,6 +51,6 @@ instance Crypto c => EraGov (AllegraEra c) where
 
   prevPParamsGovStateL = prevPParamsShelleyGovStateL
 
-  futurePParamsGovStateL = futurePParamsShelleyGovStateL
+  futurePParamsGovStateG = futurePParamsShelleyGovStateL
 
   obligationGovState = const mempty

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

@@ -385,7 +385,7 @@ instance Crypto c => EraGov (AlonzoEra c) where
 
   prevPParamsGovStateL = prevPParamsShelleyGovStateL
 
-  futurePParamsGovStateL = futurePParamsShelleyGovStateL
+  futurePParamsGovStateG = futurePParamsShelleyGovStateL
 
   obligationGovState = const mempty
 

eras/babbage/impl/src/Cardano/Ledger/Babbage/PParams.hs

@@ -271,7 +271,7 @@ instance Crypto c => EraGov (BabbageEra c) where
 
   prevPParamsGovStateL = prevPParamsShelleyGovStateL
 
-  futurePParamsGovStateL = futurePParamsShelleyGovStateL
+  futurePParamsGovStateG = futurePParamsShelleyGovStateL
 
   obligationGovState = const mempty
 

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

@@ -19,6 +19,7 @@ module Cardano.Ledger.Conway.Governance (
   RatifyEnv (..),
   RatifySignal (..),
   ConwayGovState (..),
+  predictFuturePParams,
   Committee (..),
   committeeMembersL,
   committeeThresholdL,
@@ -170,6 +171,7 @@ import Cardano.Ledger.Binary (
   EncCBOR (..),
   FromCBOR (..),
   ToCBOR (..),
+  decNoShareCBOR,
  )
 import Cardano.Ledger.Binary.Coders (
   Decode (..),
@@ -213,6 +215,7 @@ import Cardano.Ledger.Shelley.LedgerState (
 import Cardano.Ledger.UMap
 import Cardano.Ledger.Val (Val (..))
 import Control.DeepSeq (NFData (..))
+import Control.Monad (guard)
 import Control.Monad.Trans.Reader (ReaderT, ask)
 import Data.Aeson (KeyValue, ToJSON (..), object, pairs, (.=))
 import Data.Default.Class (Default (..))
@@ -225,7 +228,7 @@ import Lens.Micro
 import Lens.Micro.Extras (view)
 import NoThunks.Class (NoThunks (..))
 
--- =============================================
+-- | Conway governance state
 data ConwayGovState era = ConwayGovState
   { cgsProposals :: !(Proposals era)
   , cgsCommittee :: !(StrictMaybe (Committee era))
@@ -273,6 +276,18 @@ conwayGovStateDRepDistrG = to (\govst -> (psDRepDistr . fst) $ finishDRepPulser
 getRatifyState :: ConwayGovState era -> RatifyState era
 getRatifyState (ConwayGovState {cgsDRepPulsingState}) = snd $ finishDRepPulser cgsDRepPulsingState
 
+predictFuturePParams :: ConwayGovState era -> Maybe (PParams era)
+predictFuturePParams govState = do
+  guard (any hasChangesToPParams (rsEnacted ratifyState))
+  pure (ensCurPParams (rsEnactState ratifyState))
+  where
+    ratifyState = extractDRepPulsingState (cgsDRepPulsingState govState)
+    hasChangesToPParams gas =
+      case pProcGovAction (gasProposalProcedure gas) of
+        ParameterChange {} -> True
+        HardForkInitiation {} -> True
+        _ -> False
+
 mkEnactState :: ConwayEraGov era => GovState era -> EnactState era
 mkEnactState gs =
   EnactState
@@ -298,15 +313,7 @@ instance EraPParams era => DecShareCBOR (ConwayGovState era) where
         <! From
 
 instance EraPParams era => DecCBOR (ConwayGovState era) where
-  decCBOR =
-    decode $
-      RecD ConwayGovState
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
-        <! From
+  decCBOR = decNoShareCBOR
 
 instance EraPParams era => EncCBOR (ConwayGovState era) where
   encCBOR ConwayGovState {..} =
@@ -354,6 +361,8 @@ instance EraPParams (ConwayEra c) => EraGov (ConwayEra c) where
 
   prevPParamsGovStateL = cgsPrevPParamsL
 
+  futurePParamsGovStateG = to predictFuturePParams
+
   obligationGovState st =
     Obligations
       { oblProposal = foldMap' gasDeposit $ proposalsActions (st ^. cgsProposalsL)

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

@@ -40,7 +40,7 @@ import Cardano.Ledger.Conway.Era (ConwayEPOCH, ConwayEra, ConwayRATIFY)
 import Cardano.Ledger.Conway.Governance (
   Committee,
   ConwayEraGov (..),
-  ConwayGovState (..),
+  ConwayGovState,
   DRepPulsingState (..),
   EnactState (..),
   GovActionId,

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

@@ -46,7 +46,7 @@ import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Era (ConwayCERTS, ConwayEra, ConwayGOV, ConwayLEDGER, ConwayUTXOW)
 import Cardano.Ledger.Conway.Governance (
   ConwayEraGov (..),
-  ConwayGovState (..),
+  ConwayGovState,
   GovProcedures (..),
   Proposals,
   constitutionScriptL,

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

@@ -31,7 +31,7 @@ import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Era (ConwayEPOCH, ConwayEra, ConwayNEWEPOCH)
 import Cardano.Ledger.Conway.Governance (
   ConwayEraGov,
-  ConwayGovState (..),
+  ConwayGovState,
   RatifyEnv (..),
   RatifySignal (..),
   RatifyState (..),
@@ -170,7 +170,7 @@ newEpochTransition = do
       ) <-
     judgmentContext
   if eNo /= succ eL
-    then pure (nes & newEpochStateDRepPulsingStateL %~ pulseDRepPulsingState)
+    then pure $ nes & newEpochStateDRepPulsingStateL %~ pulseDRepPulsingState
     else do
       es1 <- case ru of -- Here is where we extract the result of Reward pulsing.
         SNothing -> pure es0

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

@@ -56,7 +56,7 @@ import Cardano.Ledger.Binary.Coders
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Era (ConwayEra, ConwayUTXOS)
-import Cardano.Ledger.Conway.Governance (ConwayGovState (..))
+import Cardano.Ledger.Conway.Governance (ConwayGovState)
 import Cardano.Ledger.Conway.TxInfo ()
 import Cardano.Ledger.Plutus (PlutusWithContext)
 import Cardano.Ledger.SafeHash (SafeHash, hashAnnotated)

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

@@ -988,8 +988,9 @@ constitutionSpec =
       impAnn "Constitution has not been enacted yet" $
         curConstitution' `shouldBe` curConstitution
 
-      ConwayGovState expectedProposals _ _ _ _ expectedPulser <-
-        getsNES newEpochStateGovStateL
+      govState <- getsNES newEpochStateGovStateL
+      let expectedProposals = govState ^. cgsProposalsL
+          expectedPulser = govState ^. cgsDRepPulsingStateL
       expectedEnactState <- getEnactState
 
       impAnn "EnactState reflects the submitted governance action" $ do
@@ -1003,8 +1004,8 @@ constitutionSpec =
 
       passEpoch >> passEpoch
       impAnn "Proposal gets removed after expiry" $ do
-        ConwayGovState _ _ _ _ _ pulser <- getsNES newEpochStateGovStateL
-        let ratifyState = extractDRepPulsingState pulser
+        govStateFinal <- getsNES newEpochStateGovStateL
+        let ratifyState = extractDRepPulsingState (govStateFinal ^. cgsDRepPulsingStateL)
         rsExpired ratifyState `shouldBe` Set.singleton govActionId
 
 policySpec ::

eras/mary/impl/src/Cardano/Ledger/Mary/PParams.hs

@@ -58,6 +58,6 @@ instance Crypto c => EraGov (MaryEra c) where
 
   prevPParamsGovStateL = prevPParamsShelleyGovStateL
 
-  futurePParamsGovStateL = futurePParamsShelleyGovStateL
+  futurePParamsGovStateG = futurePParamsShelleyGovStateL
 
   obligationGovState = const mempty

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

@@ -53,7 +53,7 @@ import Data.Aeson (
 import Data.Default.Class (Default (..))
 import Data.Kind (Type)
 import GHC.Generics (Generic)
-import Lens.Micro (Lens', lens)
+import Lens.Micro (Lens', SimpleGetter, lens)
 import NoThunks.Class (NoThunks (..))
 
 class
@@ -89,8 +89,17 @@ class
   -- | Lens for accessing the previous protocol parameters
   prevPParamsGovStateL :: Lens' (GovState era) (PParams era)
 
-  -- | Lens for accessing the previous protocol parameters
-  futurePParamsGovStateL :: Lens' (GovState era) (Maybe (PParams era))
+  -- | Getter for accessing the future protocol parameters.
+  --
+  -- This getter is only reliable and efficient 2 stability before the end of the
+  -- epoch. Depending on the era, if called earlier in the epoch, it will either produce
+  -- unreliable results or getting those results will be somewhat costly.
+  --
+  -- Whenever called at the earliest two stability before the end of the epoch, then the
+  -- results will be 100% reliable and they will contain either a `Just` value with the
+  -- new `PParams`, when there was an update proposed and `Nothing` whenever PParams will
+  -- reamin unchanged at the next epoch boundary.
+  futurePParamsGovStateG :: SimpleGetter (GovState era) (Maybe (PParams era))
 
   obligationGovState :: GovState era -> Obligations
 
@@ -103,7 +112,7 @@ instance Crypto c => EraGov (ShelleyEra c) where
 
   prevPParamsGovStateL = prevPParamsShelleyGovStateL
 
-  futurePParamsGovStateL = futurePParamsShelleyGovStateL
+  futurePParamsGovStateG = futurePParamsShelleyGovStateL
 
   obligationGovState = const mempty -- No GovState obigations in ShelleyEra
 
@@ -114,7 +123,7 @@ data ShelleyGovState era = ShelleyGovState
   , sgsPrevPParams :: !(PParams era)
   , sgsFuturePParams :: Maybe (PParams era)
   -- ^ Prediction of any parameter changes that might happen on the epoch boundary. The
-  -- field is lazy on purpose, since we only need to compute this field only towards the
+  -- field is lazy on purpose, since we need to compute this field only towards the
   -- end of the epoch.
   }
   deriving (Generic)

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Constrained/Vars.hs

@@ -428,7 +428,7 @@ ppupStateT p =
     :$ Lensed (futurePParamProposals p) (futureProposalsL . proposedMapL p)
     :$ Lensed (currPParams p) (Gov.curPParamsGovStateL . pparamsFL p)
     :$ Lensed (prevPParams p) (Gov.curPParamsGovStateL . pparamsFL p)
-    :$ Lensed (futurePParams p) (Gov.futurePParamsGovStateL . pparamsMaybeFL p)
+    :$ Lensed (futurePParams p) (Gov.futurePParamsGovStateG . pparamsMaybeFL p)
   where
     ppupfun x y (PParamsF _ pp) (PParamsF _ prev) =
       ShelleyGovState

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/PrettyCore.hs

@@ -84,7 +84,7 @@ import Cardano.Ledger.Coin (Coin (..), CompactForm (..), DeltaCoin (..))
 import Cardano.Ledger.Conway.Governance (
   Committee (..),
   Constitution (..),
-  ConwayGovState (..),
+  ConwayGovState,
   DRepPulser (..),
   DRepPulsingState (..),
   EnactState (..),
@@ -107,6 +107,12 @@ import Cardano.Ledger.Conway.Governance (
   Voter (..),
   VotingProcedure (..),
   VotingProcedures (..),
+  cgsCommitteeL,
+  cgsConstitutionL,
+  cgsCurPParamsL,
+  cgsDRepPulsingStateL,
+  cgsPrevPParamsL,
+  cgsProposalsL,
   pGraphL,
   pRootsL,
   proposalsActionsMap,
@@ -2861,15 +2867,15 @@ instance PrettyA (GovRelation StrictMaybe era) where
   prettyA = pcPrevGovActionIds
 
 pcConwayGovState :: Reflect era => Proof era -> ConwayGovState era -> PDoc
-pcConwayGovState p (ConwayGovState ss cmt con cpp ppp dr) =
+pcConwayGovState p govState =
   ppRecord
     "ConwayGovState"
-    [ ("proposals", pcProposals ss)
-    , ("drepPulsingState", pcDRepPulsingState p dr)
-    , ("committee", ppStrictMaybe prettyA cmt)
-    , ("constitution", prettyA con)
-    , ("currentPParams", prettyA cpp)
-    , ("prevPParams", prettyA ppp)
+    [ ("proposals", pcProposals (govState ^. cgsProposalsL))
+    , ("committee", ppStrictMaybe prettyA (govState ^. cgsCommitteeL))
+    , ("constitution", prettyA (govState ^. cgsConstitutionL))
+    , ("currentPParams", prettyA (govState ^. cgsCurPParamsL))
+    , ("prevPParams", prettyA (govState ^. cgsPrevPParamsL))
+    , ("drepPulsingState", pcDRepPulsingState p (govState ^. cgsDRepPulsingStateL))
     ]
 
 instance Reflect era => PrettyA (ConwayGovState era) where

libs/cardano-ledger-test/src/Test/Cardano/Ledger/Generic/Proof.hs

@@ -80,7 +80,7 @@ import Cardano.Ledger.Babbage.TxOut (BabbageEraTxOut (..), BabbageTxOut (..))
 import Cardano.Ledger.BaseTypes (ShelleyBase)
 import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Conway (ConwayEra)
-import Cardano.Ledger.Conway.Governance (ConwayGovState (..), RunConwayRatify (..))
+import Cardano.Ledger.Conway.Governance (ConwayGovState, RunConwayRatify (..))
 import Cardano.Ledger.Conway.PParams (ConwayEraPParams (..), ConwayPParams (..))
 import Cardano.Ledger.Conway.TxCert (ConwayEraTxCert, ConwayTxCert (..))
 import Cardano.Ledger.Core (