Property test now works, pretty print explosion.

IntersectMBO · Oct 26, 2021 · 8608afb · 8608afb
1 parent a767219
commit 8608afb
Show file tree

Hide file tree

Showing 12 changed files with 44 additions and 22 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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