Merge pull request #2538 from input-output-hk/jc/incremental-stake-di…

…stribution

Introduced IncrementalStake, for all Eras

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

@@ -68,6 +68,7 @@ import Cardano.Ledger.Shelley.LedgerState
   ( AccountState (..),
     DPState (..),
     EpochState (..),
+    IncrementalStake (..),
     LedgerState (..),
     NewEpochState (..),
     UTxOState (..),
@@ -156,6 +157,7 @@ instance
                   (Coin 0)
                   (Coin 0)
                   def
+                  (IStake mempty mempty)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )

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

@@ -22,7 +22,6 @@ module Cardano.Ledger.Alonzo.PlutusScriptApi
 where
 
 import Cardano.Binary (FromCBOR (..), ToCBOR (..))
-import Cardano.Ledger.Address (Addr)
 import Cardano.Ledger.Alonzo.Data (getPlutusData)
 import Cardano.Ledger.Alonzo.Language (Language (..))
 import Cardano.Ledger.Alonzo.Scripts (CostModel (..), ExUnits (..))
@@ -268,7 +267,6 @@ scriptsNeeded ::
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era)),
     HasField "body" tx (Core.TxBody era)
   ) =>
   UTxO era ->
@@ -293,8 +291,7 @@ scriptsNeededFromBody ::
   ( Era era,
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "wdrls" (Core.TxBody era) (Wdrl (Crypto era)),
-    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era)))
   ) =>
   UTxO era ->
   Core.TxBody era ->

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

@@ -319,7 +319,7 @@ utxoTransition ::
   TransitionRule (AlonzoUTXO era)
 utxoTransition = do
   TRC (Shelley.UtxoEnv slot pp stakepools _genDelegs, u, tx) <- judgmentContext
-  let Shelley.UTxOState utxo _deposits _fees _ppup = u
+  let Shelley.UTxOState utxo _deposits _fees _ppup _ = u
 
   {-   txb := txbody tx   -}
   {-   (,i_f) := txvldttx   -}

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

@@ -53,13 +53,13 @@ import qualified Cardano.Ledger.Core as Core
 import Cardano.Ledger.Era (Crypto, Era, ValidateScript)
 import Cardano.Ledger.Mary.Value (Value)
 import Cardano.Ledger.Rules.ValidationMode (lblStatic)
-import Cardano.Ledger.Shelley.LedgerState (PPUPState (..), UTxOState (..), keyRefunds)
+import Cardano.Ledger.Shelley.LedgerState (PPUPState (..), UTxOState (..), keyRefunds, updateStakeDistribution)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import Cardano.Ledger.Shelley.PParams (Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupPredicateFailure)
 import Cardano.Ledger.Shelley.Rules.Utxo (UtxoEnv (..))
 import Cardano.Ledger.Shelley.TxBody (DCert, Wdrl)
-import Cardano.Ledger.Shelley.UTxO (balance, totalDeposits)
+import Cardano.Ledger.Shelley.UTxO (UTxO (..), balance, totalDeposits)
 import Cardano.Ledger.TxIn (TxIn (..))
 import Cardano.Ledger.Val as Val
 import Control.Monad.Except (MonadError (throwError))
@@ -174,7 +174,7 @@ scriptsValidateTransition ::
 scriptsValidateTransition = do
   TRC
     ( UtxoEnv slot pp poolParams genDelegs,
-      UTxOState utxo deposited fees pup,
+      UTxOState utxo deposited fees pup incStake,
       tx
       ) <-
     judgmentContext
@@ -217,12 +217,18 @@ scriptsValidateTransition = do
     trans @(Core.EraRule "PPUP" era) $
       TRC
         (PPUPEnv slot pp genDelegs, pup, strictMaybeToMaybe $ getField @"update" txb)
+
+  let utxoAdd = txouts @era txb -- These will be inserted into the UTxO
+  let utxoDel = eval (getField @"inputs" txb ◁ utxo) -- These will be deleted fromthe UTxO
+  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd
+
   pure $
     UTxOState
-      { _utxo = eval ((getField @"inputs" txb ⋪ utxo) ∪ txouts @era txb),
+      { _utxo = eval ((getField @"inputs" txb ⋪ utxo) ∪ utxoAdd),
         _deposited = deposited <> depositChange,
         _fees = fees <> getField @"txfee" txb,
-        _ppups = pup'
+        _ppups = pup',
+        _stakeDistro = newIncStakeDistro
       }
 
 scriptsNotValidateTransition ::
@@ -249,7 +255,7 @@ scriptsNotValidateTransition ::
   ) =>
   TransitionRule (UTXOS era)
 scriptsNotValidateTransition = do
-  TRC (UtxoEnv _ pp _ _, us@(UTxOState utxo _ fees _), tx) <- judgmentContext
+  TRC (UtxoEnv _ pp _ _, us@(UTxOState utxo _ fees _ _), tx) <- judgmentContext
   let txb = body tx
   sysSt <- liftSTS $ asks systemStart
   ei <- liftSTS $ asks epochInfo
@@ -280,7 +286,12 @@ scriptsNotValidateTransition = do
   pure $
     us
       { _utxo = eval (getField @"collateral" txb ⋪ utxo),
-        _fees = fees <> Val.coin (balance @era (eval (getField @"collateral" txb ◁ utxo)))
+        _fees = fees <> Val.coin (balance @era (eval (getField @"collateral" txb ◁ utxo))),
+        _stakeDistro =
+          updateStakeDistribution @era
+            (_stakeDistro us)
+            (eval (getField @"collateral" txb ◁ utxo))
+            (UTxO Map.empty)
       }
 
 data TagMismatchDescription

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

@@ -360,8 +360,7 @@ witsVKeyNeeded ::
     HasField "certs" (Core.TxBody era) (StrictSeq (DCert (Crypto era))),
     HasField "inputs" (Core.TxBody era) (Set (TxIn (Crypto era))),
     HasField "collateral" (Core.TxBody era) (Set (TxIn (Crypto era))),
-    HasField "update" (Core.TxBody era) (StrictMaybe (Update era)),
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "update" (Core.TxBody era) (StrictMaybe (Update era))
   ) =>
   UTxO era ->
   tx ->

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

@@ -161,7 +161,8 @@ instance Crypto c => TranslateEra (AlonzoEra c) API.UTxOState where
         { API._utxo = translateEra' ctxt $ API._utxo us,
           API._deposited = API._deposited us,
           API._fees = API._fees us,
-          API._ppups = translateEra' ctxt $ API._ppups us
+          API._ppups = translateEra' ctxt $ API._ppups us,
+          API._stakeDistro = API._stakeDistro us
         }
 
 instance Crypto c => TranslateEra (AlonzoEra c) API.UTxO where

eras/alonzo/test-suite/src/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs

@@ -460,15 +460,15 @@ instance Mock c => EraGen (AlonzoEra c) where
         minimumFee = minfee @(AlonzoEra c) pp tx
      in if (minimumFee <= theFee)
           then (pure tx)
-          else myDiscard "MinFeee violation: genEraDne: AlonzoEraGem.hs"
+          else myDiscard "MinFeee violation: genEraDne: AlonzoEraGen.hs"
 
   genEraTweakBlock pp txns =
     let txTotal, ppMax :: ExUnits
         txTotal = Prelude.foldr (<>) mempty (fmap totExUnits txns)
         ppMax = getField @"_maxBlockExUnits" pp
      in if pointWiseExUnits (<=) txTotal ppMax
           then pure txns
-          else myDiscard "TotExUnits violation: genEraTweakBlock: AlonzoEraGem.hs"
+          else myDiscard "TotExUnits violation: genEraTweakBlock: AlonzoEraGen.hs"
 
   hasFailedScripts = (== IsValid False) . (getField @"isValid")
 

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Trials.hs

@@ -136,6 +136,7 @@ import Test.Cardano.Ledger.Shelley.PropertyTests
     removedAfterPoolreap,
   )
 import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
+import Test.Cardano.Ledger.Shelley.Rules.TestChain (incrementalStakeProp)
 import Test.Tasty
 import Test.Tasty.QuickCheck
 
@@ -147,7 +148,9 @@ import Test.Tasty.QuickCheck
 --     versions of all these inputs, and lets the user select which of these inputs he needs to make a generator.
 --     See genAlonzoTx and genAlonzoBlock as examples of its use.
 genstuff ::
-  (EraGen era, Default (State (Core.EraRule "PPUP" era))) =>
+  ( EraGen era,
+    Default (State (Core.EraRule "PPUP" era))
+  ) =>
   Proxy era ->
   ( GenEnv era ->
     ChainState era ->
@@ -304,7 +307,10 @@ alonzoPropertyTests =
   testGroup
     "Alonzo property tests"
     [ propertyTests @A @L,
-      Alonzo.propertyTests
+      Alonzo.propertyTests,
+      testProperty
+        "Incremental stake distribution at epoch boundaries agrees"
+        (incrementalStakeProp (Proxy :: Proxy A))
     ]
 
 -- | A select subset of all the property tests

eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs

@@ -64,6 +64,7 @@ instance
                   (Coin 0)
                   (Coin 0)
                   def
+                  (IStake mempty mempty)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )

eras/shelley-ma/impl/src/Cardano/Ledger/Allegra/Translation.hs

@@ -146,7 +146,8 @@ instance Crypto c => TranslateEra (AllegraEra c) UTxOState where
         { _utxo = translateEra' ctxt $ _utxo us,
           _deposited = _deposited us,
           _fees = _fees us,
-          _ppups = translateEra' ctxt $ _ppups us
+          _ppups = translateEra' ctxt $ _ppups us,
+          _stakeDistro = _stakeDistro us
         }
 
 instance Crypto c => TranslateEra (AllegraEra c) LedgerState where

eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs

@@ -57,6 +57,7 @@ instance Crypto c => CanStartFromGenesis (MaryEra c) where
                   (Coin 0)
                   (Coin 0)
                   def
+                  (IStake mempty mempty)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )

eras/shelley-ma/impl/src/Cardano/Ledger/Mary/Translation.hs

@@ -145,7 +145,8 @@ instance Crypto c => TranslateEra (MaryEra c) UTxOState where
         { _utxo = translateEra' ctxt $ _utxo us,
           _deposited = _deposited us,
           _fees = _fees us,
-          _ppups = translateEra' ctxt $ _ppups us
+          _ppups = translateEra' ctxt $ _ppups us,
+          _stakeDistro = _stakeDistro us
         }
 
 instance Crypto c => TranslateEra (MaryEra c) TxOut where

eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Rules/Utxo.hs

@@ -39,7 +39,7 @@ import Cardano.Ledger.Shelley.Constraints
     UsesTxOut,
     UsesValue,
   )
-import Cardano.Ledger.Shelley.LedgerState (PPUPState)
+import Cardano.Ledger.Shelley.LedgerState (PPUPState, updateStakeDistribution)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
 import Cardano.Ledger.Shelley.PParams (PParams, PParams' (..), Update)
 import Cardano.Ledger.Shelley.Rules.Ppup (PPUP, PPUPEnv (..), PpupPredicateFailure)
@@ -248,7 +248,7 @@ utxoTransition ::
   TransitionRule (UTXO era)
 utxoTransition = do
   TRC (Shelley.UtxoEnv slot pp stakepools genDelegs, u, tx) <- judgmentContext
-  let Shelley.UTxOState utxo deposits' fees ppup = u
+  let Shelley.UTxOState utxo deposits' fees ppup incStake = u
   let txb = getField @"body" tx
 
   inInterval slot (getField @"vldt" txb)
@@ -336,13 +336,17 @@ utxoTransition = do
   let refunded = Shelley.keyRefunds pp txb
   let txCerts = toList $ getField @"certs" txb
   let depositChange = totalDeposits pp (`Map.notMember` stakepools) txCerts Val.<-> refunded
+  let utxoAdd = txouts txb -- These will be inserted into the UTxO
+  let utxoDel = eval (txins @era txb ◁ utxo) -- These will be deleted from the UTxO
+  let newIncStakeDistro = updateStakeDistribution @era incStake utxoDel utxoAdd
 
   pure
     Shelley.UTxOState
-      { Shelley._utxo = eval ((txins @era txb ⋪ utxo) ∪ txouts txb),
+      { Shelley._utxo = eval ((txins @era txb ⋪ utxo) ∪ utxoAdd),
         Shelley._deposited = deposits' <> depositChange,
         Shelley._fees = fees <> getField @"txfee" txb,
-        Shelley._ppups = ppup'
+        Shelley._ppups = ppup',
+        Shelley._stakeDistro = newIncStakeDistro
       }
 
 --------------------------------------------------------------------------------

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

@@ -8,11 +8,13 @@ where
 
 -- obtaining orphan STS (UTXOW (ShelleyMAEra ma c))
 
+import Cardano.Ledger.Coin (Coin (..))
 import Cardano.Ledger.Mary (MaryEra)
 import Cardano.Ledger.Shelley.API (LEDGER, LedgerEnv (..))
 import Cardano.Ledger.Shelley.LedgerState
   ( DPState (..),
     UTxOState (..),
+    smartUTxOState,
   )
 import Cardano.Ledger.Shelley.PParams (PParams' (..))
 import Cardano.Ledger.Shelley.Tx (Tx (..))
@@ -31,7 +33,7 @@ type MaryTest = MaryEra TestCrypto
 ignoreAllButUTxO ::
   Either [PredicateFailure (LEDGER MaryTest)] (UTxOState MaryTest, DPState TestCrypto) ->
   Either [PredicateFailure (LEDGER MaryTest)] (UTxO MaryTest)
-ignoreAllButUTxO = fmap (\(UTxOState utxo _ _ _, _) -> utxo)
+ignoreAllButUTxO = fmap (\(UTxOState utxo _ _ _ _, _) -> utxo)
 
 testMaryNoDelegLEDGER ::
   UTxO MaryTest ->
@@ -41,10 +43,13 @@ testMaryNoDelegLEDGER ::
   Assertion
 testMaryNoDelegLEDGER utxo tx env (Right expectedUTxO) = do
   checkTrace @(LEDGER MaryTest) runShelleyBase env $
-    pure (def {_utxo = utxo}, def) .- tx .-> expectedSt'
+    pure (smartUTxOState utxo (Coin 0) (Coin 0) def, def) .- tx .-> expectedSt'
   where
     txFee = getField @"txfee" (getField @"body" tx)
-    expectedSt' = (def {_utxo = expectedUTxO, _fees = txFee}, def)
+    expectedSt' = (smartUTxOState expectedUTxO (Coin 0) txFee def, def)
 testMaryNoDelegLEDGER utxo tx env predicateFailure@(Left _) = do
-  let st = runShelleyBase $ applySTSTest @(LEDGER MaryTest) (TRC (env, (def {_utxo = utxo}, def), tx))
+  let st =
+        runShelleyBase $
+          applySTSTest @(LEDGER MaryTest)
+            (TRC (env, (smartUTxOState utxo (Coin 0) (Coin 0) def, def), tx))
   ignoreAllButUTxO st @?= predicateFailure

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

@@ -148,7 +148,8 @@ translateToShelleyLedgerState genesisShelley epochNo cvs =
               { _utxo = utxoShelley,
                 _deposited = Coin 0,
                 _fees = Coin 0,
-                _ppups = def
+                _ppups = def,
+                _stakeDistro = IStake mempty Map.empty
               },
           _delegationState =
             DPState

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

@@ -27,6 +27,8 @@ import Cardano.Ledger.Shelley.API.Types
     word64ToCoin,
   )
 import Cardano.Ledger.Shelley.EpochBoundary (emptySnapShots)
+import Cardano.Ledger.Shelley.LedgerState (updateStakeDistribution)
+import Cardano.Ledger.Shelley.UTxO (UTxO (..))
 import Cardano.Ledger.Val (Val ((<->)))
 import Control.State.Transition (STS (State))
 import Data.Default.Class (Default, def)
@@ -67,6 +69,7 @@ instance
                   (Coin 0)
                   (Coin 0)
                   def
+                  (updateStakeDistribution mempty (UTxO mempty) initialUtxo)
               )
               (DPState (def {_genDelegs = GenDelegs genDelegs}) def)
           )

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

@@ -79,6 +79,7 @@ import Cardano.Ledger.Shelley.LedgerState as X
     DPState (..),
     DState (..),
     EpochState (..),
+    IncrementalStake (..),
     InstantaneousRewards (..),
     KeyPairs,
     LedgerState (..),

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

@@ -210,7 +210,7 @@ getPoolParameters = Map.restrictKeys . f
 -- This is not based on any snapshot, but uses the current ledger state.
 poolsByTotalStakeFraction ::
   forall era.
-  (UsesValue era, HasField "address" (Core.TxOut era) (Addr (Crypto era))) =>
+  (UsesValue era) =>
   Globals ->
   NewEpochState era ->
   PoolDistr (Crypto era)
@@ -245,8 +245,7 @@ getTotalStake globals ss =
 getNonMyopicMemberRewards ::
   ( UsesValue era,
     HasField "_a0" (Core.PParams era) NonNegativeInterval,
-    HasField "_nOpt" (Core.PParams era) Natural,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "_nOpt" (Core.PParams era) Natural
   ) =>
   Globals ->
   NewEpochState era ->
@@ -307,9 +306,7 @@ sumPoolOwnersStake pool stake =
 -- do not want to use one of the regular snapshots, but rather the most recent
 -- ledger state.
 currentSnapshot ::
-  ( UsesValue era,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
-  ) =>
+  (UsesValue era) =>
   NewEpochState era ->
   EB.SnapShot (Crypto era)
 currentSnapshot ss =
@@ -380,8 +377,7 @@ deriving instance ToJSON RewardParams
 getRewardInfoPools ::
   ( UsesValue era,
     HasField "_a0" (Core.PParams era) NonNegativeInterval,
-    HasField "_nOpt" (Core.PParams era) Natural,
-    HasField "address" (Core.TxOut era) (Addr (Crypto era))
+    HasField "_nOpt" (Core.PParams era) Natural
   ) =>
   Globals ->
   NewEpochState era ->
@@ -593,7 +589,7 @@ totalAdaPotsES (EpochState (AccountState treasury_ reserves_) _ ls _ _ _) =
       feesAdaPot = fees_
     }
   where
-    (UTxOState u deposits fees_ _) = _utxoState ls
+    (UTxOState u deposits fees_ _ _) = _utxoState ls
     (DPState ds _) = _delegationState ls
     rewards_ = fold (Map.elems (_rewards ds))
     coins = Val.coin $ balance u