Skip to content

Commit aca97f2

Browse files
aniketdaniketd
committed
Address review comments
1 parent 46b916d commit aca97f2

File tree

30 files changed

+98
-79
lines changed

30 files changed

+98
-79
lines changed

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

-1
Original file line numberDiff line numberDiff line change
@@ -119,7 +119,6 @@ import Test.Cardano.Ledger.Shelley.Generator.ScriptClass (Quantifier (..), Scrip
119119
import Test.Cardano.Ledger.Shelley.Generator.Update (genM, genShelleyPParamsUpdate)
120120
import qualified Test.Cardano.Ledger.Shelley.Generator.Update as Shelley (genPParams)
121121
import Test.Cardano.Ledger.Shelley.Generator.Utxo (encodedLen)
122-
import Test.Cardano.Ledger.Shelley.Utils (unsafeBoundRational)
123122
import Test.QuickCheck hiding ((><))
124123

125124
-- ============================================================

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

+21-4
Original file line numberDiff line numberDiff line change
@@ -53,9 +53,10 @@ import Cardano.Ledger.Slot (EpochNo (EpochNo))
5353
import Cardano.Ledger.State
5454
import qualified Cardano.Ledger.Val as Val
5555
import Control.DeepSeq (NFData)
56-
import Control.Exception (assert)
56+
import Control.Monad.Reader (runReaderT)
5757
import Control.State.Transition
5858
import Data.Default (Default (..))
59+
import Data.Functor.Identity (runIdentity)
5960
import qualified Data.Map.Strict as Map
6061
import Data.Set (Set)
6162
import Data.Void (Void)
@@ -131,6 +132,24 @@ instance
131132
def
132133
]
133134

135+
assertions =
136+
[ let checkRewardsBalanced es (RewardUpdate dt dr rs_ df _) =
137+
Val.isZero $
138+
dt <> dr <> toDeltaCoin (sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_) <> df
139+
in PostCondition
140+
"Reward updates balance out"
141+
( \(TRC (_, NewEpochState eL _bPrev _bCur es ru _pd _avvm, eNo)) _newState ->
142+
if eNo /= succ eL
143+
then True
144+
else case ru of
145+
SNothing -> True
146+
SJust p@(Pulsing _ _) ->
147+
let (ru', _event) = runIdentity $ runReaderT (completeRupd p) testGlobals
148+
in checkRewardsBalanced es ru'
149+
SJust (Complete ru') -> checkRewardsBalanced es ru'
150+
)
151+
]
152+
134153
transitionRules = [newEpochTransition]
135154

136155
newEpochTransition ::
@@ -204,9 +223,7 @@ updateRewards ::
204223
EpochNo ->
205224
RewardUpdate ->
206225
Rule (ConwayNEWEPOCH era) 'Transition (EpochState era)
207-
updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do
208-
let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_
209-
in assert (Val.isZero (dt <> dr <> toDeltaCoin totRs <> df)) (pure ())
226+
updateRewards es e ru' = do
210227
let !(!es', filtered) = applyRUpdFiltered ru' es
211228
tellEvent $ RestrainedRewards e (frShelleyIgnored filtered) (frUnregistered filtered)
212229
-- This event (which is only generated once per epoch) must be generated even if the

‎eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Genesis.hs

-1
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,6 @@ import Data.Maybe (fromJust)
2525
import Data.Maybe.Strict (StrictMaybe (..))
2626
import Data.Ratio ((%))
2727
import Test.Cardano.Ledger.Conway.Arbitrary ()
28-
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
2928
import Test.Cardano.Ledger.Plutus (zeroTestingCostModelV3)
3029

3130
credMember :: Credential 'ColdCommitteeRole

‎eras/shelley/impl/src/Cardano/Ledger/Shelley/Rules/NewEpoch.hs

+24-4
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,4 @@
1+
{-# LANGUAGE AllowAmbiguousTypes #-}
12
{-# LANGUAGE BangPatterns #-}
23
{-# LANGUAGE DataKinds #-}
34
{-# LANGUAGE DeriveGeneric #-}
@@ -21,6 +22,7 @@ module Cardano.Ledger.Shelley.Rules.NewEpoch (
2122
updateRewards,
2223
calculatePoolDistr,
2324
calculatePoolDistr',
25+
assertRewardUpdatesBalanceOut,
2426
) where
2527

2628
import Cardano.Ledger.BaseTypes (
@@ -42,9 +44,10 @@ import Cardano.Ledger.Slot (EpochNo (..))
4244
import Cardano.Ledger.State
4345
import qualified Cardano.Ledger.Val as Val
4446
import Control.DeepSeq (NFData)
45-
import Control.Exception (assert)
47+
import Control.Monad.Reader (runReaderT)
4648
import Control.State.Transition
4749
import Data.Default (Default, def)
50+
import Data.Functor.Identity (runIdentity)
4851
import qualified Data.Map.Strict as Map
4952
import Data.Set (Set)
5053
import GHC.Generics (Generic)
@@ -111,6 +114,7 @@ instance
111114
type instance EraRuleEvent "NEWEPOCH" ShelleyEra = ShelleyNewEpochEvent ShelleyEra
112115

113116
instance
117+
forall era.
114118
( EraTxOut era
115119
, EraGov era
116120
, EraStake era
@@ -153,8 +157,26 @@ instance
153157
def
154158
]
155159

160+
assertions = [PostCondition "Reward updates balance out" assertRewardUpdatesBalanceOut]
161+
156162
transitionRules = [newEpochTransition]
157163

164+
assertRewardUpdatesBalanceOut ::
165+
EraGov era => TRC (ShelleyNEWEPOCH era) -> State (ShelleyNEWEPOCH era) -> Bool
166+
assertRewardUpdatesBalanceOut (TRC (_, NewEpochState eL _bPrev _bCur es ru _pd _avvm, eNo)) _newState =
167+
if eNo /= succ eL
168+
then True
169+
else case ru of
170+
SNothing -> True
171+
SJust p@(Pulsing _ _) ->
172+
let (ru', _event) = runIdentity $ runReaderT (completeRupd p) testGlobals
173+
in checkRewardsBalanced ru'
174+
SJust (Complete ru') -> checkRewardsBalanced ru'
175+
where
176+
checkRewardsBalanced (RewardUpdate dt dr rs_ df _) =
177+
Val.isZero $
178+
dt <> dr <> toDeltaCoin (sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_) <> df
179+
158180
newEpochTransition ::
159181
forall era.
160182
( EraTxOut era
@@ -262,9 +284,7 @@ updateRewards ::
262284
EpochNo ->
263285
RewardUpdate ->
264286
Rule (ShelleyNEWEPOCH era) 'Transition (EpochState era)
265-
updateRewards es e ru'@(RewardUpdate dt dr rs_ df _) = do
266-
let totRs = sumRewards (es ^. prevPParamsEpochStateL . ppProtocolVersionL) rs_
267-
in assert (Val.isZero (dt <> (dr <> toDeltaCoin totRs <> df))) (pure ())
287+
updateRewards es e ru' = do
268288
let !(!es', filtered) = applyRUpdFiltered ru' es
269289
tellEvent $ RestrainedRewards e (frShelleyIgnored filtered) (frUnregistered filtered)
270290
-- This event (which is only generated once per epoch) must be generated even if the

‎eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs

-1
Original file line numberDiff line numberDiff line change
@@ -91,7 +91,6 @@ import Generic.Random (genericArbitraryU)
9191
import Test.Cardano.Chain.UTxO.Gen (genCompactTxOut)
9292
import Test.Cardano.Ledger.Common
9393
import Test.Cardano.Ledger.Core.Arbitrary ()
94-
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
9594
import Test.QuickCheck.Hedgehog (hedgehog)
9695

9796
------------------------------------------------------------------------------------------

‎eras/shelley/test-suite/bench/BenchValidation.hs

-1
Original file line numberDiff line numberDiff line change
@@ -60,7 +60,6 @@ import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen, MinLEDGER_STS)
6060
import Test.Cardano.Ledger.Shelley.Generator.Presets (genEnv)
6161
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
6262
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
63-
import Test.Cardano.Ledger.Shelley.Utils (testGlobals)
6463
import qualified Test.Control.State.Transition.Trace.Generator.QuickCheck as QC
6564

6665
data ValidateInput era = ValidateInput Globals (NewEpochState era) (Block (BHeader MockCrypto) era)

‎eras/shelley/test-suite/bench/Main.hs

-1
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,6 @@ import Test.Cardano.Ledger.Shelley.BenchmarkFunctions (
6666
)
6767

6868
import Test.Cardano.Ledger.Shelley.Rules.IncrementalStake (stakeDistr)
69-
import Test.Cardano.Ledger.Shelley.Utils (testGlobals)
7069
import Test.QuickCheck (arbitrary)
7170
import Test.QuickCheck.Gen as QC
7271

‎eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/BenchmarkFunctions.hs

-1
Original file line numberDiff line numberDiff line change
@@ -86,7 +86,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
8686
mkKeyPair',
8787
mkVRFKeyPair,
8888
runShelleyBase,
89-
unsafeBoundRational,
9089
)
9190

9291
-- =========================================================

‎eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Block.hs

-1
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
6666
maxKESIterations,
6767
runShelleyBase,
6868
slotFromEpoch,
69-
testGlobals,
7069
)
7170
import Test.Cardano.Protocol.TPraos.Create (VRFKeyPair (..))
7271
import Test.Control.State.Transition.Trace.Generator.QuickCheck (sigGen)

‎eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Generator/Trace/TxCert.hs

+1-1
Original file line numberDiff line numberDiff line change
@@ -65,7 +65,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Core (GenEnv (..), KeySpace (..))
6565
import Test.Cardano.Ledger.Shelley.Generator.EraGen (EraGen (..))
6666
import Test.Cardano.Ledger.Shelley.Generator.ScriptClass (scriptKeyCombination)
6767
import Test.Cardano.Ledger.Shelley.Generator.TxCert (CertCred (..), genTxCert)
68-
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, testGlobals)
68+
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo)
6969
import Test.Control.State.Transition.Trace (TraceOrder (OldestFirst), lastState, traceSignals)
7070
import qualified Test.Control.State.Transition.Trace.Generator.QuickCheck as QC
7171
import Test.QuickCheck (Gen)

‎eras/shelley/test-suite/src/Test/Cardano/Ledger/Shelley/Rewards.hs

+1-5
Original file line numberDiff line numberDiff line change
@@ -129,11 +129,7 @@ import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainEvent (..), ChainState (..)
129129
import Test.Cardano.Ledger.Shelley.Rules.TestChain (forAllChainTrace, forEachEpochTrace)
130130
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators ()
131131
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
132-
import Test.Cardano.Ledger.Shelley.Utils (
133-
runShelleyBase,
134-
testGlobals,
135-
unsafeBoundRational,
136-
)
132+
import Test.Cardano.Ledger.Shelley.Utils (runShelleyBase)
137133
import Test.Cardano.Ledger.TerseTools (Terse (..), tersemapdiffs)
138134
import Test.Control.State.Transition.Trace (SourceSignalTarget (..), getEvents, sourceSignalTargets)
139135
import Test.Tasty (TestTree, defaultMain, testGroup)

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

-1
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
7777
ChainProperty,
7878
epochFromSlotNo,
7979
runShelleyBase,
80-
testGlobals,
8180
)
8281
import Test.Control.State.Transition.Trace (
8382
SourceSignalTarget (..),

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -109,7 +109,7 @@ import Lens.Micro ((%~), (&), (.~), (^.))
109109
import Lens.Micro.Extras (view)
110110
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
111111
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
112-
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce, testGlobals)
112+
import Test.Cardano.Ledger.Shelley.Utils (epochFromSlotNo, getBlockNonce)
113113

114114
-- ======================================================
115115

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ import Test.Cardano.Ledger.Shelley.Rules.Chain (
4343
ChainState (..),
4444
initialShelleyState,
4545
)
46-
import Test.Cardano.Ledger.Shelley.Utils (maxLLSupply, mkHash, unsafeBoundRational)
46+
import Test.Cardano.Ledger.Shelley.Utils (maxLLSupply, mkHash)
4747

4848
-- | Initial Protocol Parameters
4949
ppEx :: (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) => PParams era

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

-3
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,6 @@
44
{-# LANGUAGE GADTs #-}
55
{-# LANGUAGE NumericUnderscores #-}
66
{-# LANGUAGE OverloadedLists #-}
7-
{-# LANGUAGE PatternSynonyms #-}
87
{-# LANGUAGE ScopedTypeVariables #-}
98
{-# LANGUAGE TypeApplications #-}
109

@@ -121,8 +120,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
121120
getBlockNonce,
122121
maxLLSupply,
123122
runShelleyBase,
124-
testGlobals,
125-
unsafeBoundRational,
126123
)
127124
import Test.Tasty (TestTree, testGroup)
128125
import Test.Tasty.HUnit (testCase)

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

+1-1
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,7 @@ import Test.Cardano.Ledger.Shelley.Generator.Core (
6767
import Test.Cardano.Ledger.Shelley.Generator.EraGen (genesisId)
6868
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
6969
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
70-
import Test.Cardano.Ledger.Shelley.Utils (getBlockNonce, testGlobals)
70+
import Test.Cardano.Ledger.Shelley.Utils (getBlockNonce)
7171
import Test.Tasty (TestTree, testGroup)
7272
import Test.Tasty.HUnit (testCase)
7373

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

-2
Original file line numberDiff line numberDiff line change
@@ -128,8 +128,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
128128
getBlockNonce,
129129
maxLLSupply,
130130
runShelleyBase,
131-
testGlobals,
132-
unsafeBoundRational,
133131
)
134132
import Test.Tasty (TestTree, testGroup)
135133
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

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

-1
Original file line numberDiff line numberDiff line change
@@ -73,7 +73,6 @@ import Test.Cardano.Ledger.Shelley.Utils (
7373
RawSeed (..),
7474
mkKeyPair,
7575
mkVRFKeyPair,
76-
unsafeBoundRational,
7776
)
7877
import Test.Tasty (TestTree, testGroup)
7978
import Test.Tasty.HUnit (Assertion, testCase, (@?=))

‎libs/cardano-ledger-core/cardano-ledger-core.cabal

-2
Original file line numberDiff line numberDiff line change
@@ -197,7 +197,6 @@ library testlib
197197
cardano-ledger-binary:{cardano-ledger-binary, testlib} >=1.5,
198198
cardano-ledger-byron:{cardano-ledger-byron, testlib},
199199
cardano-ledger-core,
200-
cardano-slotting,
201200
containers,
202201
cuddle,
203202
data-default,
@@ -217,7 +216,6 @@ library testlib
217216
random ^>=1.2,
218217
small-steps >=1.1,
219218
text,
220-
time,
221219
tree-diff,
222220
unliftio,
223221
vector-map:{vector-map, testlib},

‎libs/cardano-ledger-core/src/Cardano/Ledger/Core.hs

+40-1
Original file line numberDiff line numberDiff line change
@@ -53,6 +53,10 @@ module Cardano.Ledger.Core (
5353
RewardType (..),
5454
Reward (..),
5555

56+
-- * Test utils
57+
unsafeBoundRational,
58+
testGlobals,
59+
5660
-- * Re-exports
5761
module Cardano.Ledger.Hashes,
5862
module Cardano.Ledger.Core.TxCert,
@@ -71,7 +75,16 @@ import Cardano.Ledger.Address (
7175
decompactAddr,
7276
isBootstrapCompactAddr,
7377
)
74-
import Cardano.Ledger.BaseTypes (ProtVer (..))
78+
import Cardano.Ledger.BaseTypes (
79+
BoundedRational,
80+
EpochSize (..),
81+
Globals (..),
82+
Network (..),
83+
ProtVer (..),
84+
boundRational,
85+
knownNonZeroBounded,
86+
mkActiveSlotCoeff,
87+
)
7588
import Cardano.Ledger.Binary (
7689
DecCBOR,
7790
DecShareCBOR (Share),
@@ -99,6 +112,8 @@ import Cardano.Ledger.Metadata
99112
import Cardano.Ledger.Rewards (Reward (..), RewardType (..))
100113
import Cardano.Ledger.TxIn (TxId (..), TxIn (..))
101114
import Cardano.Ledger.Val (Val (..), inject)
115+
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
116+
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
102117
import Control.DeepSeq (NFData)
103118
import Data.Aeson (ToJSON)
104119
import qualified Data.ByteString as BS
@@ -108,9 +123,12 @@ import qualified Data.Map.Strict as Map
108123
import Data.Maybe (fromMaybe, isJust)
109124
import Data.Maybe.Strict (StrictMaybe, strictMaybe)
110125
import Data.MemPack
126+
import Data.Proxy (Proxy (..))
111127
import Data.Sequence.Strict (StrictSeq)
112128
import Data.Set (Set)
113129
import qualified Data.Set as Set
130+
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
131+
import Data.Typeable (Typeable, typeRep)
114132
import Data.Void (Void)
115133
import Data.Word (Word32, Word64)
116134
import GHC.Stack (HasCallStack)
@@ -633,3 +651,24 @@ txIdTx tx = txIdTxBody (tx ^. bodyTxL)
633651

634652
txIdTxBody :: EraTxBody era => TxBody era -> TxId
635653
txIdTxBody = TxId . hashAnnotated
654+
655+
testGlobals :: Globals
656+
testGlobals =
657+
Globals
658+
{ epochInfo = fixedEpochInfo (EpochSize 100) (mkSlotLength 1)
659+
, slotsPerKESPeriod = 20
660+
, stabilityWindow = 33
661+
, randomnessStabilisationWindow = 33
662+
, securityParameter = knownNonZeroBounded @10
663+
, maxKESEvo = 10
664+
, quorum = 5
665+
, maxLovelaceSupply = 45 * 1000 * 1000 * 1000 * 1000 * 1000
666+
, activeSlotCoeff = mkActiveSlotCoeff . unsafeBoundRational $ 0.9
667+
, networkId = Testnet
668+
, systemStart = SystemStart $ posixSecondsToUTCTime 0
669+
}
670+
671+
unsafeBoundRational :: forall r. (HasCallStack, Typeable r, BoundedRational r) => Rational -> r
672+
unsafeBoundRational x = fromMaybe (error errMessage) $ boundRational x
673+
where
674+
errMessage = show (typeRep (Proxy :: Proxy r)) <> " is out of bounds: " <> show x

‎libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs

-1
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,6 @@ import System.Random.Stateful (StatefulGen, uniformRM)
133133
import qualified Test.Cardano.Chain.Common.Gen as Byron
134134
import Test.Cardano.Ledger.Binary.Arbitrary
135135
import Test.Cardano.Ledger.Binary.Random (QC (..))
136-
import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational)
137136
import Test.QuickCheck
138137
import Test.QuickCheck.Hedgehog (hedgehog)
139138

‎libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Rational.hs

+6-10
Original file line numberDiff line numberDiff line change
@@ -2,27 +2,23 @@
22
{-# LANGUAGE FlexibleInstances #-}
33
{-# LANGUAGE ScopedTypeVariables #-}
44

5-
module Test.Cardano.Ledger.Core.Rational where
5+
module Test.Cardano.Ledger.Core.Rational (
6+
module Test.Cardano.Ledger.Core.Rational,
7+
unsafeBoundRational,
8+
) where
69

710
import Cardano.Ledger.BaseTypes (
811
BoundedRational (..),
912
NonNegativeInterval,
1013
PositiveInterval,
1114
PositiveUnitInterval,
1215
UnitInterval,
13-
boundRational,
1416
)
15-
import Data.Maybe (fromMaybe)
16-
import Data.Proxy (Proxy (..))
17+
import Cardano.Ledger.Core (unsafeBoundRational)
1718
import qualified Data.Ratio
18-
import Data.Typeable (Typeable, typeRep)
19+
import Data.Typeable (Typeable)
1920
import GHC.Stack (HasCallStack)
2021

21-
unsafeBoundRational :: forall r. (HasCallStack, Typeable r, BoundedRational r) => Rational -> r
22-
unsafeBoundRational x = fromMaybe (error errMessage) $ boundRational x
23-
where
24-
errMessage = show (typeRep (Proxy :: Proxy r)) <> " is out of bounds: " <> show x
25-
2622
-- | polymorphic rationals that agree with the Show instances of UnitInterval
2723
-- and friends.
2824
class IsRatio r where

0 commit comments

Comments
 (0)