Fix tests to account for new way of predicting PParams

* Golden test for ShelleyGovState had to change due to addition of a new
  field

* Fix Shelley unit test by making sure the new future pparams field is
  updated correctly

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

@@ -91,6 +91,7 @@ module Cardano.Ledger.Shelley.LedgerState (
   esNonMyopicL,
   curPParamsEpochStateL,
   prevPParamsEpochStateL,
+  futurePParamsEpochStateL,
   asTreasuryL,
   asReservesL,
   lsUTxOStateL,

eras/shelley/impl/src/Cardano/Ledger/Shelley/LedgerState/Types.hs

@@ -639,6 +639,9 @@ curPParamsEpochStateL = esLStateL . lsUTxOStateL . utxosGovStateL . curPParamsGo
 prevPParamsEpochStateL :: EraGov era => Lens' (EpochState era) (PParams era)
 prevPParamsEpochStateL = esLStateL . lsUTxOStateL . utxosGovStateL . prevPParamsGovStateL
 
+futurePParamsEpochStateL :: EraGov era => Lens' (EpochState era) (FuturePParams era)
+futurePParamsEpochStateL = esLStateL . lsUTxOStateL . utxosGovStateL . futurePParamsGovStateL
+
 -- ==========================================
 -- AccountState
 

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

@@ -509,7 +509,7 @@ shelleyCommonPParamsHKDPairs px pp =
 -- | Update operation for protocol parameters structure @PParams@
 newtype ProposedPPUpdates era
   = ProposedPPUpdates (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era))
-  deriving (Generic)
+  deriving (Generic, Semigroup, Monoid)
 
 deriving instance Eq (PParamsUpdate era) => Eq (ProposedPPUpdates era)
 

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

@@ -70,6 +70,7 @@ import Cardano.Ledger.Shelley.LedgerState (
   StashedAVVMAddresses,
   curPParamsEpochStateL,
   dsGenDelegs,
+  futurePParamsEpochStateL,
   nesEpochStateL,
   prevPParamsEpochStateL,
   smartUTxOState,
@@ -229,6 +230,7 @@ initialShelleyState lab e utxo reserves genDelegs pp initNonce =
             def
             & curPParamsEpochStateL .~ pp
             & prevPParamsEpochStateL .~ pp
+            & futurePParamsEpochStateL .~ PotentialPParamsUpdate Nothing
         )
         SNothing
         (PoolDistr Map.empty)

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

@@ -12,6 +12,7 @@ import Cardano.Ledger.Shelley.Scripts ()
 import Cardano.Protocol.TPraos.BHeader (BHeader)
 import Control.State.Transition.Extended hiding (Assertion)
 import Data.List.NonEmpty (NonEmpty)
+import GHC.Stack
 import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (C, C_Crypto)
 import Test.Cardano.Ledger.Shelley.Rules.Chain (CHAIN, ChainState, totalAda)
 import Test.Cardano.Ledger.Shelley.TreeDiff (expectExprEqual)
@@ -30,7 +31,7 @@ data CHAINExample h era = CHAINExample
 
 -- | Runs example, applies chain state transition system rule (STS),
 --   and checks that trace ends with expected state or expected error.
-testCHAINExample :: CHAINExample (BHeader C_Crypto) C -> Assertion
+testCHAINExample :: HasCallStack => CHAINExample (BHeader C_Crypto) C -> Assertion
 testCHAINExample (CHAINExample initSt block (Right expectedSt)) = do
   (checkTrace @(CHAIN C) runShelleyBase () $ pure initSt .- block .->> expectedSt)
     >> expectExprEqual (totalAda expectedSt) maxLLSupply

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Combinators.hs

@@ -40,6 +40,7 @@ module Test.Cardano.Ledger.Shelley.Examples.Combinators (
   newEpoch,
   setCurrentProposals,
   setFutureProposals,
+  solidifyProposals,
   setPParams,
   setPrevPParams,
   setFutureGenDeleg,
@@ -52,6 +53,7 @@ import Cardano.Ledger.BaseTypes (
   BlocksMade (..),
   Nonce (..),
   StrictMaybe (..),
+  quorum,
   (⭒),
  )
 import Cardano.Ledger.Block (
@@ -89,12 +91,13 @@ import Cardano.Ledger.Shelley.LedgerState (
   applyRUpd,
   curPParamsEpochStateL,
   delegations,
+  futurePParamsEpochStateL,
   prevPParamsEpochStateL,
   rewards,
   updateStakeDistribution,
  )
 import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates)
-import Cardano.Ledger.Shelley.Rules (emptyInstantaneousRewards)
+import Cardano.Ledger.Shelley.Rules (emptyInstantaneousRewards, votedFuturePParams)
 import Cardano.Ledger.UMap (
   RDPair (..),
   UView (PtrUView, RewDepUView, SPoolUView),
@@ -120,10 +123,10 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import Data.Word (Word64)
-import Lens.Micro ((&), (.~), (^.))
+import Lens.Micro ((%~), (&), (.~), (^.))
 import Lens.Micro.Extras (view)
 import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
-import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce)
+import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce, testGlobals)
 
 -- ======================================================
 
@@ -717,7 +720,7 @@ newEpoch b cs = cs'
 -- Set the current protocol parameter proposals.
 setCurrentProposals ::
   forall era.
-  GovState era ~ ShelleyGovState era =>
+  (GovState era ~ ShelleyGovState era, EraPParams era) =>
   ProposedPPUpdates era ->
   ChainState era ->
   ChainState era
@@ -727,9 +730,15 @@ setCurrentProposals ps cs = cs {chainNes = nes'}
     es = nesEs nes
     ls = esLState es
     utxoSt = lsUTxOState ls
-    ppupSt = utxosGovState utxoSt
-    ppupSt' = ppupSt {sgsCurProposals = ps}
-    utxoSt' = utxoSt {utxosGovState = ppupSt'}
+    govState = utxosGovState utxoSt
+    pp = sgsCurPParams govState
+    govState' =
+      govState
+        { sgsCurProposals = ps
+        , sgsFuturePParams =
+            PotentialPParamsUpdate $ votedFuturePParams ps pp (quorum testGlobals)
+        }
+    utxoSt' = utxoSt {utxosGovState = govState'}
     ls' = ls {lsUTxOState = utxoSt'}
     es' = es {esLState = ls'}
     nes' = nes {nesEs = es'}
@@ -749,13 +758,23 @@ setFutureProposals ps cs = cs {chainNes = nes'}
     es = nesEs nes
     ls = esLState es
     utxoSt = lsUTxOState ls
-    ppupSt = utxosGovState utxoSt
-    ppupSt' = ppupSt {sgsFutureProposals = ps}
-    utxoSt' = utxoSt {utxosGovState = ppupSt'}
+    govState = utxosGovState utxoSt
+    govState' = govState {sgsFutureProposals = ps}
+    utxoSt' = utxoSt {utxosGovState = govState'}
     ls' = ls {lsUTxOState = utxoSt'}
     es' = es {esLState = ls'}
     nes' = nes {nesEs = es'}
 
+solidifyProposals ::
+  forall era.
+  EraGov era =>
+  ChainState era ->
+  ChainState era
+solidifyProposals cs = cs {chainNes = nes {nesEs = es}}
+  where
+    nes = chainNes cs
+    es = nesEs nes & futurePParamsEpochStateL %~ solidifyFuturePParams
+
 -- | = Set the Protocol Proposals
 --
 -- Set the protocol parameters.

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/GenesisDelegation.hs

@@ -249,6 +249,7 @@ expectedStEx2 =
     . C.newLab blockEx2
     . C.adoptFutureGenDeleg newGenDeleg
     . C.pulserUpdate pulserEx2
+    . C.solidifyProposals
     $ expectedStEx1
 
 -- === Block 2, Slot 50, Epoch 0

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Mir.hs

@@ -306,7 +306,7 @@ expectedStEx2 pot =
   C.evolveNonceUnfrozen (getBlockNonce (blockEx2 @c pot))
     . C.newLab (blockEx2 pot)
     . C.pulserUpdate (pulserEx2 pot)
-    $ (expectedStEx1 pot)
+    $ expectedStEx1 pot
 
 -- === Block 2, Slot 50, Epoch 0
 --
@@ -319,7 +319,7 @@ mir2 pot =
   CHAINExample
     (expectedStEx1 pot)
     (blockEx2 pot)
-    (Right $ expectedStEx2 pot)
+    (Right $ C.solidifyProposals (expectedStEx2 pot))
 
 --
 -- Block 3, Slot 110, Epoch 1
@@ -361,7 +361,7 @@ expectedStEx3 pot =
     . C.newSnapshot emptySnapShot feeTx1
     . C.applyRewardUpdate emptyRewardUpdate
     . C.applyMIR pot (Map.singleton Cast.aliceSHK aliceMIRCoin)
-    $ (expectedStEx2 pot)
+    $ expectedStEx2 pot
 
 -- === Block 3, Slot 110, Epoch 1
 --

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolLifetime.hs

@@ -390,7 +390,7 @@ expectedStEx2 =
 --
 -- In the second block Alice and Bob both delegation to Alice's Pool.
 poolLifetime2 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
-poolLifetime2 = CHAINExample expectedStEx1 blockEx2 (Right expectedStEx2)
+poolLifetime2 = CHAINExample expectedStEx1 blockEx2 (Right (C.solidifyProposals expectedStEx2))
 
 --
 -- Block 3, Slot 110, Epoch 1
@@ -531,7 +531,7 @@ expectedStEx4 =
 -- preparing the way for the first non-empty pool distribution in this running example.
 -- Additionally, in order to have the stake distribution change, Carl delegates his stake.
 poolLifetime4 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
-poolLifetime4 = CHAINExample expectedStEx3 blockEx4 (Right expectedStEx4)
+poolLifetime4 = CHAINExample expectedStEx3 blockEx4 (Right (C.solidifyProposals expectedStEx4))
 
 epoch2Nonce :: forall c. ExMock (EraCrypto (ShelleyEra c)) => Nonce
 epoch2Nonce =
@@ -647,7 +647,7 @@ expectedStEx6 =
 --
 -- Create a decentralized Praos block (ie one not in the overlay schedule)
 poolLifetime6 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
-poolLifetime6 = CHAINExample expectedStEx5 blockEx6 (Right expectedStEx6)
+poolLifetime6 = CHAINExample expectedStEx5 blockEx6 (Right (C.solidifyProposals expectedStEx6))
 
 --
 -- Block 7, Slot 310, Epoch 3
@@ -784,7 +784,7 @@ expectedStEx8 =
 --
 -- Create the first non-trivial reward update.
 poolLifetime8 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
-poolLifetime8 = CHAINExample expectedStEx7 blockEx8 (Right expectedStEx8)
+poolLifetime8 = CHAINExample expectedStEx7 blockEx8 (Right (C.solidifyProposals expectedStEx8))
 
 --
 -- Block 9, Slot 410, Epoch 4
@@ -1006,7 +1006,7 @@ expectedStEx11 =
 --
 -- Stage the retirement of Alice's stake pool.
 poolLifetime11 :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
-poolLifetime11 = CHAINExample expectedStEx10 blockEx11 (Right expectedStEx11)
+poolLifetime11 = CHAINExample expectedStEx10 blockEx11 (Right (C.solidifyProposals expectedStEx11))
 
 --
 -- Block 12, Slot 510, Epoch 5

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/PoolReReg.hs

@@ -262,7 +262,7 @@ blockEx2B = blockEx2 90
 -- In the second block Alice re-registers with new pool parameters
 -- late in the epoch.
 poolReReg2B :: ExMock (EraCrypto (ShelleyEra c)) => CHAINExample (BHeader c) (ShelleyEra c)
-poolReReg2B = CHAINExample expectedStEx1 blockEx2B (Right expectedStEx2B)
+poolReReg2B = CHAINExample expectedStEx1 blockEx2B (Right (C.solidifyProposals expectedStEx2B))
 
 --
 -- Block 3, Slot 110, Epoch 1

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/TwoPools.hs

@@ -721,6 +721,7 @@ expectedStEx9 pp =
     . C.newLab blockEx9
     . C.setOCertCounter coreNodeHK 2
     . C.pulserUpdate (pulserEx9 pp)
+    . C.solidifyProposals
     $ expectedStEx8
   where
     coreNodeHK = coerceKeyRole . aikColdKeyHash $ coreNodeKeysBySchedule @C ppEx 390
@@ -753,7 +754,7 @@ expectedStEx8Agg :: ChainState C
 expectedStEx8Agg = C.setPrevPParams ppProtVer3 expectedStEx8
 
 expectedStEx9Agg :: ChainState C
-expectedStEx9Agg = C.setPrevPParams ppProtVer3 (expectedStEx9 ppProtVer3)
+expectedStEx9Agg = C.solidifyProposals $ C.setPrevPParams ppProtVer3 (expectedStEx9 ppProtVer3)
 
 -- Create the first non-trivial reward update. The rewards demonstrate the
 -- results of the delegation scenario that was constructed in the first and only transaction.

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Examples/Updates.hs

@@ -328,6 +328,7 @@ expectedStEx3 =
     . C.newUTxO txbodyEx3
     . C.pulserUpdate pulserEx3
     . C.setFutureProposals (collectVotes ppVoteB [1])
+    . C.solidifyProposals
     $ expectedStEx2
 
 -- === Block 3, Slot 80, Epoch 0

eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/Serialisation/Golden/Encoding.hs

@@ -1122,12 +1122,12 @@ tests =
             mconcat
               [ "8700a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b047b0825410aa158"
               , "1ca646474b8f5431261506b6c273d307c7569a4eb6c96b42dd4a29520a03848219271019"
-              , "03e8828383a0a00084a0a0a0a08482a0a0a0a084a0a0000086a1825820ee155ace9c"
-              , "40292074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e250082583900cb935852"
-              , "9df4729c3246a2a033cb9821abbfd16de4888005904abc410d6a577e9441ad8ed9663931"
-              , "906e4d43ece8f82c712b1d0235affb060a1903e80184a0a0920000001908000000000018"
-              , "64d81e820001d81e820001d81e820001d81e820001810002000100920000001908000000"
-              , "00001864d81e820001d81e820001d81e820001d81e82000181000200000082a0a0008483"
+              , "03e8828383a0a00084a0a0a0a08482a0a0a0a084a0a0000086a1825820ee155ace9c4029"
+              , "2074cb6aff8c9ccdd273c81648ff1149ef36bcea6ebb8a3e250082583900cb9358529df4"
+              , "729c3246a2a033cb9821abbfd16de4888005904abc410d6a577e9441ad8ed9663931906e"
+              , "4d43ece8f82c712b1d0235affb060a1903e80185a0a092000000190800000000001864d8"
+              , "1e820001d81e820001d81e820001d81e8200018100020001009200000019080000000000"
+              , "1864d81e820001d81e820001d81e820001d81e820001810002000000810082a0a0008483"
               , "a0a0a083a0a0a083a0a0a00082a000818300880082020082a000000000a0a0840185a080"
               , "00820200a0a082a0a0a1581ce0a714319812c3f773ba04ec5d6b3ffcd5aad85006805b04"
               , "7b082541828201015820c5e21ab1c9f6022d81c3b25e3436cb7f1df77f9652ae3e1310c2"