diff --git a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs index 00dd62d3e76..433d15b14e1 100644 --- a/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs +++ b/eras/alonzo/impl/src/Cardano/Ledger/Alonzo.hs @@ -71,6 +71,7 @@ import Cardano.Ledger.Shelley.LedgerState LedgerState (..), NewEpochState (..), UTxOState (..), + IncrementalStake(..), _genDelegs, ) import Cardano.Ledger.Shelley.Metadata (validMetadatum) @@ -158,7 +159,7 @@ instance (Coin 0) (Coin 0) def - (Stake mempty) + (IStake mempty mempty) ) (DPState (def {_genDelegs = GenDelegs genDelegs}) def) ) diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs index fd82cf4a015..dc5cabec8f1 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Allegra.hs @@ -64,7 +64,7 @@ instance (Coin 0) (Coin 0) def - (Stake mempty) + (IStake mempty mempty) ) (DPState (def {_genDelegs = GenDelegs genDelegs}) def) ) diff --git a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs index 94f1946965b..f94aabba2ee 100644 --- a/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs +++ b/eras/shelley-ma/impl/src/Cardano/Ledger/Mary.hs @@ -57,7 +57,7 @@ instance Crypto c => CanStartFromGenesis (MaryEra c) where (Coin 0) (Coin 0) def - (Stake mempty) + (IStake mempty mempty) ) (DPState (def {_genDelegs = GenDelegs genDelegs}) def) ) diff --git a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs index ee27a90d1b4..b2acd0f22ba 100644 --- a/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs +++ b/eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/Snap.hs @@ -94,17 +94,21 @@ snapTransition = do -- if there were no rewards bigAggNoRewards = aggregateUtxoCoinByCredential (forwards . _ptrs $ dstate) utxo mempty - doExplode = False + doExplode = True msg = [ "\nBOOM!\n" - , "snapshotted stake\n" - , show (_stake stake) + , "\nsnapshotted stake\n" + , unlines (map show (Map.toList (unStake(_stake stake)))) , "\nincremental stake (filtered & w/ rewards)\n" - , show sd3 + , unlines (map show (Map.toList (unStake sd3))) , "\nagged in spot\n" - , show bigAggNoRewards + , unlines (map show (Map.toList bigAggNoRewards)) , "\nrewards\n" - , show rws + , unlines (map show (Map.toList rws)) + , "\n PTRS\n" + , unlines (map show (Map.toList (forwards (_ptrs dstate)))) + , "\n DANGLING\n" + , unlines (map show (Map.toList dangle)) ] newMarkSnapshot = if doExplode && (_stake stake) /= sd3 diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs index dae3c29fa27..27706713244 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Address/Bootstrap.hs @@ -46,10 +46,10 @@ import Cardano.Ledger.Keys import Cardano.Ledger.SafeHash (extractHash, hashAnnotated) import Cardano.Ledger.Shelley (ShelleyEra) import Cardano.Ledger.Shelley.Address.Bootstrap -import Cardano.Ledger.Shelley.EpochBoundary (Stake (..)) import Cardano.Ledger.Shelley.LedgerState ( PPUPState (..), UTxOState (..), + IncrementalStake(..), ) import Cardano.Ledger.Shelley.PParams ( PParams' (..), @@ -158,7 +158,7 @@ utxoState0 = _deposited = Coin 0, _fees = Coin 0, _ppups = PPUPState (ProposedPPUpdates mempty) (ProposedPPUpdates mempty), - _stakeDistro = Stake mempty + _stakeDistro = IStake mempty mempty } tx :: Tx C @@ -174,7 +174,7 @@ utxoState1 = _deposited = Coin 0, _fees = Coin 10, _ppups = PPUPState (ProposedPPUpdates mempty) (ProposedPPUpdates mempty), - _stakeDistro = Stake mempty + _stakeDistro = IStake mempty mempty } where txid = TxId $ hashAnnotated txBody diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs index d231c096ed7..a7040f57852 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs @@ -37,7 +37,6 @@ import Cardano.Ledger.BaseTypes import Cardano.Ledger.Coin (Coin (..)) import qualified Cardano.Ledger.Core as Core import Cardano.Ledger.Credential (Credential (..)) -import Cardano.Ledger.Shelley.EpochBoundary (Stake (..)) import Cardano.Ledger.Crypto (Crypto (..)) import Cardano.Ledger.Keys ( Hash, @@ -58,6 +57,7 @@ import Cardano.Ledger.Shelley.LedgerState ( AccountState (..), DPState, UTxOState (..), + IncrementalStake(..), ) import Cardano.Ledger.Shelley.PParams (PParams, PParams' (..), emptyPParams) import Cardano.Ledger.Shelley.Rules.Ledger (LEDGER, LedgerEnv (..)) @@ -155,7 +155,7 @@ initUTxO n = (Coin 0) (Coin 0) def - (Stake mempty) + (IStake mempty mempty) -- Protocal Parameters used for the benchmarknig tests. -- Note that the fees and deposits are set to zero for diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs index 685680cc04a..458a62ea9d9 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Examples/Consensus.hs @@ -325,7 +325,7 @@ exampleNewEpochState value ppp pp = _deposited = Coin 1000, _fees = Coin 1, _ppups = def, - _stakeDistro = Stake mempty + _stakeDistro = IStake mempty mempty }, _delegationState = def }, diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs index 6eb773c7355..f7cbc12b906 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/Chain.hs @@ -55,7 +55,7 @@ import Cardano.Ledger.Shelley.API.Wallet totalAdaPotsES, ) import Cardano.Ledger.Shelley.Constraints (UsesValue) -import Cardano.Ledger.Shelley.EpochBoundary (aggregateUtxoCoinByCredential, emptySnapShots, Stake (..)) +import Cardano.Ledger.Shelley.EpochBoundary (aggregateUtxoCoinByCredential, emptySnapShots) import Cardano.Ledger.Shelley.LedgerState ( AccountState (..), DPState (..), @@ -66,6 +66,7 @@ import Cardano.Ledger.Shelley.LedgerState PState (..), TransUTxOState, UTxOState (..), + IncrementalStake(..), updateNES, _genDelegs, ) @@ -206,7 +207,7 @@ initialShelleyState lab e utxo reserves genDelegs pp initNonce = (Coin 0) (Coin 0) def - (Stake $ aggregateUtxoCoinByCredential mempty utxo mempty) + (IStake (aggregateUtxoCoinByCredential mempty utxo mempty) mempty) ) (DPState (def {_genDelegs = GenDelegs genDelegs}) def) ) diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs index e876774fb0a..1d788226ece 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rules/TestChain.hs @@ -48,7 +48,7 @@ import Cardano.Ledger.Shelley.API GetLedgerView, ) import Cardano.Ledger.Shelley.Constraints (UsesPParams, UsesValue) -import Cardano.Ledger.Shelley.EpochBoundary (obligation, Stake (unStake)) +import Cardano.Ledger.Shelley.EpochBoundary (obligation) import Cardano.Ledger.Shelley.LedgerState hiding (circulation) import Cardano.Ledger.Shelley.Rewards (sumRewards) import Cardano.Ledger.Shelley.Rules.Deleg (DelegEnv (..)) @@ -251,7 +251,7 @@ incrStakeComp SourceSignalTarget {source = chainSt, signal = block} = counterExampleTooBig x = Map.size (unUTxO x) > 50 utxoBal = Val.coin $ balance u' - incrStakeBal = fold (unStake sd') + incrStakeBal = fold (getStake sd') <> fold (dangling sd') ptrs = _ptrs . _dstate $ dp ptrs' = _ptrs . _dstate $ dp' diff --git a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs index 6a43be3d97d..bac73939123 100644 --- a/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs +++ b/eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Serialisation/EraIndepGenerators.hs @@ -501,6 +501,10 @@ instance arbitrary = genericArbitraryU shrink = recursivelyShrink +instance CC.Crypto c => Arbitrary (IncrementalStake c) where + arbitrary = IStake <$> arbitrary <*>arbitrary + shrink = genericShrink + -- The 'genericShrink' function returns first the immediate subterms of a -- value (in case it is a recursive data-type), and then shrinks the value -- itself. Since 'UTxOState' is not a recursive data-type, there are no diff --git a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs index 8dfbb7391ac..2aa20a3741e 100644 --- a/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs +++ b/eras/shelley/test-suite/test/Test/Cardano/Ledger/Shelley/UnitTests.hs @@ -36,7 +36,6 @@ import Cardano.Ledger.Keys vKey, ) import Cardano.Ledger.SafeHash (hashAnnotated) -import Cardano.Ledger.Shelley.EpochBoundary (Stake (..)) import Cardano.Ledger.Shelley.API ( DCert (..), LEDGER, @@ -47,6 +46,7 @@ import Cardano.Ledger.Shelley.LedgerState ( AccountState (..), DPState (..), UTxOState (..), + IncrementalStake(..), WitHashes (..), _dstate, _rewards, @@ -376,7 +376,7 @@ utxoState = (Coin 0) (Coin 0) def - (Stake mempty) + (IStake mempty mempty) dpState :: DPState C_Crypto dpState = DPState def def diff --git a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs index cbde6ae9b6d..0650b9fd9e8 100644 --- a/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs +++ b/libs/cardano-ledger-pretty/src/Cardano/Ledger/Pretty.hs @@ -91,6 +91,7 @@ import Cardano.Ledger.Shelley.LedgerState PPUPState (..), PState (..), UTxOState (..), + IncrementalStake(..), ) import Cardano.Ledger.Shelley.Metadata (Metadata (..), Metadatum (..)) import Cardano.Ledger.Shelley.PParams @@ -651,6 +652,14 @@ ppReward (Reward rt pool amt) = ("rewardAmount", ppCoin amt) ] + +ppIncrementalStake:: IncrementalStake crypto -> PDoc +ppIncrementalStake (IStake st dangle) = + ppRecord "IncrementalStake" + [("getStake",ppStake(Stake st)) + ,("dangling",ppMap ppPtr ppCoin dangle) + ] + ppUTxOState :: CanPrettyPrintLedgerState era => UTxOState era -> @@ -662,7 +671,7 @@ ppUTxOState (UTxOState u dep fee ppup sd) = ("deposited", ppCoin dep), ("fees", ppCoin fee), ("ppups", prettyA ppup), - ("stakeDistro", ppStake sd) + ("stakeDistro", ppIncrementalStake sd) ] ppEpochState :: CanPrettyPrintLedgerState era => EpochState era -> PDoc @@ -756,6 +765,9 @@ instance where prettyA = ppUTxOState +instance PrettyA (IncrementalStake c) where + prettyA = ppIncrementalStake + -- ================================= -- Cardano.Ledger.Shelley.Rewards