Skip to content

Commit c763c03

Browse files
neilmayhewneilmayhew
committed
Implement submittingTxsAsBlock test functions
1 parent 14b247e commit c763c03

File tree

7 files changed

+162
-79
lines changed

7 files changed

+162
-79
lines changed

‎eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Bbody.hs‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,10 @@ newtype AlonzoBbodyEvent era
9090
= ShelleyInAlonzoEvent (ShelleyBbodyEvent era)
9191
deriving (Generic)
9292

93+
deriving instance
94+
Eq (Event (EraRule "LEDGERS" era)) =>
95+
Eq (AlonzoBbodyEvent era)
96+
9397
type instance EraRuleFailure "BBODY" AlonzoEra = AlonzoBbodyPredFailure AlonzoEra
9498

9599
instance InjectRuleFailure "BBODY" AlonzoBbodyPredFailure AlonzoEra

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

Lines changed: 25 additions & 33 deletions
Original file line numberDiff line numberDiff line change
@@ -21,11 +21,12 @@ import Cardano.Ledger.Plutus (SLanguage (..), hashPlutusScript)
2121
import Cardano.Ledger.Shelley.Scripts (
2222
pattern RequireSignature,
2323
)
24-
import Cardano.Ledger.TxIn
25-
import Control.Monad (forM)
24+
import Data.Foldable (for_)
2625
import Data.List.NonEmpty (NonEmpty (..))
2726
import qualified Data.List.NonEmpty as NE
2827
import qualified Data.Sequence.Strict as SSeq
28+
import qualified Data.Set as Set
29+
import Data.Traversable (for)
2930
import Data.Word (Word32)
3031
import Lens.Micro ((&), (.~), (^.))
3132
import Test.Cardano.Ledger.Babbage.ImpTest
@@ -48,24 +49,26 @@ spec = do
4849
let
4950
maxRefScriptSizePerTx = fromIntegral @Word32 @Int $ pp ^. ppMaxRefScriptSizePerTxG
5051
maxRefScriptSizePerBlock = fromIntegral @Word32 @Int $ pp ^. ppMaxRefScriptSizePerBlockG
52+
5153
txScriptCounts <-
5254
genNumAdditionsExceeding
5355
scriptSize
5456
maxRefScriptSizePerTx
5557
maxRefScriptSizePerBlock
5658

57-
let mkTxWithNScripts n = do
58-
-- Instead of using the rootTxIn, we're creating an input for each transaction
59-
-- so that they're independent of each other
60-
txIn <- freshKeyAddr_ >>= \addr -> sendCoinTo addr (Coin 100_000_000)
61-
refIns <- replicateM n $ produceRefScript (fromPlutusScript plutusScript)
62-
pure $ mkTxWithRefInputs txIn (NE.fromList refIns)
59+
allInputs <- for txScriptCounts $ \n -> do
60+
-- Instead of using the rootTxIn, we're creating an input for each transaction
61+
-- so that they're independent of each other
62+
txIn <- freshKeyAddr_ >>= \addr -> sendCoinTo addr (Coin 100_000_000)
63+
refIns <- replicateM n $ produceRefScript (fromPlutusScript plutusScript)
64+
pure (txIn, NE.fromList refIns)
6365

64-
txs <- forM txScriptCounts mkTxWithNScripts
65-
fixedUpTxs <- simulateThenRestore $ forM txs submitTx
66+
let
67+
-- These txs will be grouped into a block
68+
buildTxs = for_ allInputs $ uncurry submitTxWithRefInputs
6669

67-
submitFailingBlock
68-
fixedUpTxs
70+
submittingTxsAsFailingBlock
71+
buildTxs
6972
[ injectFailure
7073
( BodyRefScriptsSizeTooBig $
7174
Mismatch
@@ -90,27 +93,16 @@ spec = do
9093
maxRefScriptSizePerTx
9194
maxRefScriptSizePerBlock
9295

93-
-- We are creating reference scripts and transaction that depend on them in a "simulation",
94-
-- so the result will be correctly constructed that are not applied to the ledger state
95-
txs :: [Tx TopTx era] <- simulateThenRestore $ do
96-
concat
97-
<$> forM
98-
txScriptCounts
99-
( \n -> do
100-
-- produce reference scripts
101-
refScriptTxs <-
102-
replicateM n $
103-
produceRefScriptsTx (fromPlutusScript plutusScript :| [])
104-
105-
-- spend using the reference scripts
106-
let txIns = (`mkTxInPartial` 0) . txIdTx <$> refScriptTxs
107-
rootIn <- fst <$> getImpRootTxOut
108-
spendTx <- submitTxWithRefInputs rootIn (NE.fromList txIns)
109-
pure $ refScriptTxs ++ [spendTx]
110-
)
96+
let
97+
-- These txs will be grouped into a block
98+
buildTxs = for_ txScriptCounts $ \n -> do
99+
refIns <- replicateM n $ produceRefScript (fromPlutusScript plutusScript)
100+
submitTx $
101+
mkBasicTx mkBasicTxBody
102+
& bodyTxL . referenceInputsTxBodyL .~ Set.fromList refIns
111103

112-
submitFailingBlock
113-
txs
104+
submittingTxsAsFailingBlock
105+
buildTxs
114106
[ injectFailure
115107
( BodyRefScriptsSizeTooBig $
116108
Mismatch
@@ -187,7 +179,7 @@ spec = do
187179
let (txWithSizes, expectedTotalSize) = txsWithRefScriptSizes
188180

189181
-- for each prefix of the list, the accumulated sum should match the sum of the applied transactions
190-
forM_ ([1 .. length txWithSizes] :: [Int]) $ \ix -> do
182+
for_ ([1 .. length txWithSizes] :: [Int]) $ \ix -> do
191183
let slice = take ix txWithSizes
192184

193185
totalRefScriptSizeInBlock protVer (SSeq.fromList (fst <$> slice))

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

Lines changed: 10 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,6 @@ import Cardano.Ledger.Shelley.LedgerState
2323
import Cardano.Ledger.Shelley.Rules (Event, ShelleyTickEvent (..))
2424
import Cardano.Ledger.Val (zero, (<->))
2525
import Control.Monad (forM)
26-
import Control.Monad.Writer (listen)
2726
import Data.Default (def)
2827
import Data.Foldable as F (foldl', traverse_)
2928
import Data.List.NonEmpty (NonEmpty (..))
@@ -219,18 +218,18 @@ hardForkInitiationSpec =
219218
submitYesVote_ (DRepVoter dRep1) govActionId
220219
submitYesVote_ (StakePoolVoter stakePoolId1) govActionId
221220
passNEpochs 2
222-
& listen
223-
>>= expectHardForkEvents . snd <*> pure []
221+
& impSTSEventsFrom
222+
>>= expectHardForkEvents <*> pure []
224223
getProtVer `shouldReturn` curProtVer
225224
submitYesVote_ (DRepVoter dRep2) govActionId
226225
passNEpochs 2
227-
& listen
228-
>>= expectHardForkEvents . snd <*> pure []
226+
& impSTSEventsFrom
227+
>>= expectHardForkEvents <*> pure []
229228
getProtVer `shouldReturn` curProtVer
230229
submitYesVote_ (StakePoolVoter stakePoolId2) govActionId
231230
passNEpochs 2
232-
& listen
233-
>>= expectHardForkEvents . snd
231+
& impSTSEventsFrom
232+
>>= expectHardForkEvents
234233
<*> pure
235234
[ SomeSTSEvent @era @"TICK" . injectEvent $ ConwayHardForkEvent nextProtVer
236235
]
@@ -260,13 +259,13 @@ hardForkInitiationNoDRepsSpec =
260259
submitYesVoteCCs_ committeeMembers' govActionId
261260
submitYesVote_ (StakePoolVoter stakePoolId1) govActionId
262261
passNEpochs 2
263-
& listen
264-
>>= expectHardForkEvents . snd <*> pure []
262+
& impSTSEventsFrom
263+
>>= expectHardForkEvents <*> pure []
265264
getProtVer `shouldReturn` curProtVer
266265
submitYesVote_ (StakePoolVoter stakePoolId2) govActionId
267266
passNEpochs 2
268-
& listen
269-
>>= expectHardForkEvents . snd
267+
& impSTSEventsFrom
268+
>>= expectHardForkEvents
270269
<*> pure
271270
[ SomeSTSEvent @era @"TICK" . injectEvent $ ConwayHardForkEvent nextProtVer
272271
]

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

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -25,7 +25,6 @@ import Cardano.Ledger.Conway.State
2525
import Cardano.Ledger.Shelley.LedgerState
2626
import Cardano.Ledger.Shelley.Rules (Event, ShelleyTickEvent (..))
2727
import Cardano.Ledger.Val
28-
import Control.Monad.Writer (listen)
2928
import Data.Default (Default (..))
3029
import qualified Data.List.NonEmpty as NE
3130
import qualified Data.Map.Strict as Map
@@ -528,7 +527,7 @@ eventsSpec = describe "Events" $ do
528527
| Just (TickNewEpochEvent (EpochEvent (GovInfoEvent {})) :: ShelleyTickEvent era) <- cast ev = True
529528
isGovInfoEvent _ = False
530529
passEpochWithNoDroppedActions = do
531-
(_, evs) <- listen passEpoch
530+
evs <- impSTSEventsFrom passEpoch
532531
filter isGovInfoEvent evs
533532
`shouldBeExpr` [ SomeSTSEvent @era @"TICK" . injectEvent $
534533
GovInfoEvent mempty mempty mempty mempty
@@ -545,7 +544,7 @@ eventsSpec = describe "Events" $ do
545544
& bodyTxL . certsTxBodyL
546545
.~ SSeq.singleton (UnRegDepositTxCert rewardCred keyDeposit)
547546
passEpochWithNoDroppedActions
548-
(_, evs) <- listen passEpoch
547+
evs <- impSTSEventsFrom passEpoch
549548
checkProposedParameterA
550549
let
551550
filteredEvs = filter isGovInfoEvent evs

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -160,6 +160,10 @@ newtype ShelleyBbodyEvent era
160160
= LedgersEvent (Event (EraRule "LEDGERS" era))
161161
deriving (Generic)
162162

163+
deriving instance
164+
Eq (Event (EraRule "LEDGERS" era)) =>
165+
Eq (ShelleyBbodyEvent era)
166+
163167
deriving stock instance
164168
( Era era
165169
, Show (PredicateFailure (EraRule "LEDGERS" era))

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

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -125,6 +125,10 @@ newtype ShelleyLedgersEvent era
125125
= LedgerEvent (Event (EraRule "LEDGER" era))
126126
deriving (Generic)
127127

128+
deriving instance
129+
Eq (Event (EraRule "LEDGER" era)) =>
130+
Eq (ShelleyLedgersEvent era)
131+
128132
deriving stock instance
129133
( Era era
130134
, Show (PredicateFailure (EraRule "LEDGER" era))

0 commit comments

Comments
 (0)