Skip to content

Commit 3464d8f

Browse files
lehinslehins
authored
Merge pull request #4897 from IntersectMBO/ldan/rename-imp-helpers
Rename `ImpTest` helpers
2 parents 88a3f9f + d88fcdc commit 3464d8f

File tree

16 files changed

+81
-70
lines changed

16 files changed

+81
-70
lines changed

‎eras/alonzo/impl/CHANGELOG.md‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,9 @@
2727

2828
### `testlib`
2929

30+
* Renamed:
31+
* `impLookupPlutusScriptMaybe` -> `impLookupPlutusScript`
32+
* `impGetScriptContextMaybe` -> `impLookupScriptContext`
3033
* Add `DecCBOR` instances for `TranslationInstance`
3134
* Converted `CertState` to a type family
3235
* Expose `alonzoFixupFees`

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/Imp/UtxoSpec.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ spec = describe "UTXO" $ do
6464
scriptInput <- produceScript $ hashPlutusScript $ alwaysSucceedsWithDatum slang
6565
collateralAddr <- freshKeyAddr_
6666
collateralInput <- sendCoinTo collateralAddr mempty -- 0 will be changed to MinUTxO
67-
collateral <- (^. coinTxOutL) <$> impLookupUTxO collateralInput
67+
collateral <- (^. coinTxOutL) <$> impGetUTxO collateralInput
6868
-- We need to artificially blow up the fee to increase the required collateral.
6969
-- Unfortunately we do not have expensive enough scripts yet, so one other way
7070
-- to achieve the same thing is by increasing the size of the transactions by

‎eras/alonzo/impl/testlib/Test/Cardano/Ledger/Alonzo/ImpTest.hs‎

Lines changed: 13 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -18,14 +18,14 @@
1818
module Test.Cardano.Ledger.Alonzo.ImpTest (
1919
module Test.Cardano.Ledger.Mary.ImpTest,
2020
AlonzoEraImp (..),
21-
impLookupPlutusScriptMaybe,
21+
impLookupPlutusScript,
2222
malformedPlutus,
2323
addCollateralInput,
2424
impGetPlutusContexts,
2525
alonzoFixupTx,
2626
plutusTestScripts,
2727
impGetScriptContext,
28-
impGetScriptContextMaybe,
28+
impLookupScriptContext,
2929
impPlutusWithContexts,
3030
impScriptPredicateFailure,
3131
submitPhase2Invalid_,
@@ -146,13 +146,13 @@ addCollateralInput tx
146146
collateralInput <- makeCollateralInput
147147
pure $ tx & bodyTxL . collateralInputsTxBodyL <>~ Set.singleton collateralInput
148148

149-
impLookupPlutusScriptMaybe ::
149+
impLookupPlutusScript ::
150150
forall era.
151151
AlonzoEraImp era =>
152152
ScriptHash ->
153153
Maybe (PlutusScript era)
154-
impLookupPlutusScriptMaybe sh =
155-
(\(ScriptTestContext plutus _) -> mkPlutusScript plutus) =<< impGetScriptContextMaybe @era sh
154+
impLookupPlutusScript sh =
155+
(\(ScriptTestContext plutus _) -> mkPlutusScript plutus) =<< impLookupScriptContext @era sh
156156

157157
impGetPlutusContexts ::
158158
forall era.
@@ -164,7 +164,7 @@ impGetPlutusContexts tx = do
164164
utxo <- getsNES utxoL
165165
let AlonzoScriptsNeeded asn = getScriptsNeeded utxo txBody
166166
mbyContexts <- forM asn $ \(prp, sh) -> do
167-
pure $ (prp,sh,) <$> impGetScriptContextMaybe @era sh
167+
pure $ (prp,sh,) <$> impLookupScriptContext @era sh
168168
pure $ catMaybes mbyContexts
169169

170170
fixupRedeemerIndices ::
@@ -173,7 +173,7 @@ fixupRedeemerIndices ::
173173
Tx era ->
174174
ImpTestM era (Tx era)
175175
fixupRedeemerIndices tx = impAnn "fixupRedeemerIndices" $ do
176-
(rootTxIn, _) <- lookupImpRootTxOut
176+
(rootTxIn, _) <- getImpRootTxOut
177177
let
178178
txInputs = tx ^. bodyTxL . inputsTxBodyL
179179
rootTxIndex = toEnum $ Set.findIndex rootTxIn txInputs
@@ -285,7 +285,7 @@ fixupDatums tx = impAnn "fixupDatums" $ do
285285
collectDatums :: PlutusPurpose AsIxItem era -> ImpTestM era (Maybe (Data era))
286286
collectDatums purpose = do
287287
let txIn = unAsItem <$> toSpendingPurpose (hoistPlutusPurpose toAsItem purpose)
288-
txOut <- traverse (impLookupUTxO @era) txIn
288+
txOut <- traverse (impGetUTxO @era) txIn
289289
pure $ getData =<< txOut
290290

291291
getData :: TxOut era -> Maybe (Data era)
@@ -312,7 +312,7 @@ fixupPPHash tx = impAnn "fixupPPHash" $ do
312312
scriptHashes :: Set ScriptHash
313313
scriptHashes = getScriptsHashesNeeded . getScriptsNeeded utxo $ tx ^. bodyTxL
314314
plutusLanguage sh = do
315-
let mbyPlutus = impLookupPlutusScriptMaybe sh
315+
let mbyPlutus = impLookupPlutusScript sh
316316
pure $ getLanguageView pp . plutusScriptLanguage @era <$> mbyPlutus
317317
langs <- traverse plutusLanguage $ Set.toList scriptHashes
318318
let
@@ -335,7 +335,7 @@ fixupOutputDatums tx = impAnn "fixupOutputDatums" $ do
335335
addDatum txOut =
336336
case txOut ^. addrTxOutL of
337337
Addr _ (ScriptHashObj sh) _
338-
| Just (ScriptTestContext _ (PlutusArgs _ (Just spendDatum))) <- impGetScriptContextMaybe @era sh
338+
| Just (ScriptTestContext _ (PlutusArgs _ (Just spendDatum))) <- impLookupScriptContext @era sh
339339
, NoDatum <- txOut ^. datumTxOutF ->
340340
txOut & dataHashTxOutL .~ SJust (hashData @era $ Data spendDatum)
341341
_ -> txOut
@@ -447,12 +447,12 @@ instance MaryEraImp AlonzoEra
447447
instance MaryEraImp AlonzoEra => AlonzoEraImp AlonzoEra where
448448
scriptTestContexts = plutusTestScripts SPlutusV1
449449

450-
impGetScriptContextMaybe ::
450+
impLookupScriptContext ::
451451
forall era.
452452
AlonzoEraImp era =>
453453
ScriptHash ->
454454
Maybe ScriptTestContext
455-
impGetScriptContextMaybe sh = Map.lookup sh $ scriptTestContexts @era
455+
impLookupScriptContext sh = Map.lookup sh $ scriptTestContexts @era
456456

457457
impGetScriptContext ::
458458
forall era.
@@ -462,7 +462,7 @@ impGetScriptContext ::
462462
impGetScriptContext sh =
463463
impAnn ("Getting script context for " <> show sh)
464464
. expectJust
465-
$ impGetScriptContextMaybe @era sh
465+
$ impLookupScriptContext @era sh
466466

467467
impPlutusWithContexts ::
468468
(HasCallStack, AlonzoEraImp era) => Tx era -> ImpTestM era [PlutusWithContext]

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -111,5 +111,5 @@ spec = do
111111
let cred = KeyHashObj kh
112112
ra <- registerStakeCredential cred
113113
submitAndExpireProposalToMakeReward cred
114-
rw <- lookupReward cred
114+
rw <- getReward cred
115115
pure (ra, rw, kh)

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -164,7 +164,7 @@ spec = do
164164

165165
submitAndExpireProposalToMakeReward cred
166166

167-
reward <- lookupReward cred
167+
reward <- getReward cred
168168
submitFailingTx
169169
( mkBasicTx mkBasicTxBody
170170
& bodyTxL . certsTxBodyL .~ [UnRegDepositTxCert cred expectedDeposit]
@@ -208,7 +208,7 @@ spec = do
208208
expectRegisteredRewardAddress rewardAccount
209209
expectRegisteredRewardAddress otherRewardAccount
210210
submitAndExpireProposalToMakeReward otherStakeCred
211-
lookupReward otherStakeCred `shouldReturn` govActionDeposit
211+
getReward otherStakeCred `shouldReturn` govActionDeposit
212212
unRegTxCert <- genUnRegTxCert stakeCred
213213
submitTx_ . mkBasicTx $
214214
mkBasicTxBody
@@ -221,7 +221,7 @@ spec = do
221221
, (otherRewardAccount, govActionDeposit)
222222
]
223223
)
224-
lookupReward otherStakeCred `shouldReturn` Coin 0
224+
getReward otherStakeCred `shouldReturn` Coin 0
225225
expectNotRegisteredRewardAddress rewardAccount
226226

227227
describe "Delegate stake" $ do

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

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -433,14 +433,14 @@ treasuryWithdrawalExpectation extraWithdrawals = do
433433
submitYesVoteCCs_ committeeHotCreds govActionId
434434
passEpoch -- 1st epoch crossing starts DRep pulser
435435
impAnn "Withdrawal should not be received yet" $
436-
lookupReward (raCredential rewardAccount) `shouldReturn` mempty
436+
getReward (raCredential rewardAccount) `shouldReturn` mempty
437437
passEpoch -- 2nd epoch crossing enacts all the ratified actions
438438
expectMissingGovActionId govActionId
439439
treasuryEnd <- getsNES $ nesEsL . esAccountStateL . asTreasuryL
440440
impAnn "Withdrawal deducted from treasury" $
441441
treasuryStart <-> treasuryEnd `shouldBe` withdrawalAmount
442442
impAnn "Withdrawal received by reward account" $
443-
lookupReward (raCredential rewardAccount) `shouldReturn` withdrawalAmount
443+
getReward (raCredential rewardAccount) `shouldReturn` withdrawalAmount
444444

445445
depositMovesToTreasuryWhenStakingAddressUnregisters :: ConwayEraImp era => ImpTestM era ()
446446
depositMovesToTreasuryWhenStakingAddressUnregisters = do

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

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -72,7 +72,7 @@ spec = do
7272
let cred = KeyHashObj kh
7373
ra <- registerStakeCredential cred
7474
submitAndExpireProposalToMakeReward cred
75-
reward <- lookupReward cred
75+
reward <- getReward cred
7676

7777
let tx = mkBasicTx $ mkBasicTxBody & withdrawalsTxBodyL .~ Withdrawals [(ra, reward)]
7878

@@ -97,7 +97,7 @@ spec = do
9797
let cred = KeyHashObj kh
9898
ra <- registerStakeCredential cred
9999
submitAndExpireProposalToMakeReward cred
100-
reward <- lookupReward cred
100+
reward <- getReward cred
101101

102102
(drep, _, _) <- setupSingleDRep 1_000_000
103103

@@ -111,7 +111,7 @@ spec = do
111111
& withdrawalsTxBodyL
112112
.~ Withdrawals
113113
[(ra, reward)]
114-
ifBootstrap (submitTx_ tx >> (lookupReward cred `shouldReturn` mempty)) $ do
114+
ifBootstrap (submitTx_ tx >> (getReward cred `shouldReturn` mempty)) $ do
115115
submitFailingTx tx [injectFailure $ ConwayWdrlNotDelegatedToDRep [kh]]
116116

117117
it "Withdraw and unregister staking credential in the same transaction" $ do
@@ -126,7 +126,7 @@ spec = do
126126
& ppKeyDepositL .~ Coin newDeposit
127127

128128
submitAndExpireProposalToMakeReward cred
129-
reward <- lookupReward cred
129+
reward <- getReward cred
130130

131131
(drep, _, _) <- setupSingleDRep 1_000_000
132132

@@ -148,7 +148,7 @@ spec = do
148148
let cred = KeyHashObj kh
149149
ra <- registerStakeCredential cred
150150
submitAndExpireProposalToMakeReward cred
151-
reward <- lookupReward cred
151+
reward <- getReward cred
152152

153153
(drep, _, _) <- setupSingleDRep 1_000_000
154154

@@ -175,7 +175,7 @@ spec = do
175175
let cred = KeyHashObj kh
176176
ra <- registerStakeCredential cred
177177
submitAndExpireProposalToMakeReward cred
178-
reward <- lookupReward cred
178+
reward <- getReward cred
179179

180180
(drep, _, _) <- setupSingleDRep 1_000_000
181181

@@ -200,7 +200,7 @@ spec = do
200200
let cred = ScriptHashObj scriptHash
201201
ra <- registerStakeCredential cred
202202
submitAndExpireProposalToMakeReward cred
203-
reward <- lookupReward cred
203+
reward <- getReward cred
204204

205205
submitTx_ $
206206
mkBasicTx $

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

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -626,7 +626,7 @@ votingSpec =
626626
getLastEnactedCommittee `shouldReturn` SNothing
627627
-- Bump up the UTxO delegated
628628
-- to barely make the threshold (65 %! 100)
629-
stakingKP1 <- lookupKeyPair stakingKH1
629+
stakingKP1 <- getKeyPair stakingKH1
630630
sendCoinTo_ (mkAddr paymentKP1 stakingKP1) (inject $ Coin 858_000_000)
631631
passNEpochs 2
632632
-- The same vote should now successfully ratify the proposal
@@ -673,13 +673,13 @@ votingSpec =
673673
(drepKH1, stakingKH1) <- setupDRepWithoutStake
674674
-- Add rewards to delegation #1
675675
submitAndExpireProposalToMakeReward $ KeyHashObj stakingKH1
676-
lookupReward (KeyHashObj stakingKH1) `shouldReturn` govActionDeposit
676+
getReward (KeyHashObj stakingKH1) `shouldReturn` govActionDeposit
677677
-- Setup DRep delegation #2
678678
(_drepKH2, stakingKH2) <- setupDRepWithoutStake
679679
(spoC, _, _) <- setupPoolWithStake $ Coin 42_000_000
680680
-- Add rewards to delegation #2
681681
submitAndExpireProposalToMakeReward $ KeyHashObj stakingKH2
682-
lookupReward (KeyHashObj stakingKH2) `shouldReturn` govActionDeposit
682+
getReward (KeyHashObj stakingKH2) `shouldReturn` govActionDeposit
683683
-- Submit a committee proposal
684684
cc <- KeyHashObj <$> freshKeyHash
685685
Positive extra <- arbitrary
@@ -695,7 +695,7 @@ votingSpec =
695695
-- Increase the rewards of the delegator to this DRep
696696
-- to barely make the threshold (65 %! 100)
697697
registerAndRetirePoolToMakeReward $ KeyHashObj stakingKH1
698-
lookupReward (KeyHashObj stakingKH1) `shouldReturn` poolDeposit <> govActionDeposit
698+
getReward (KeyHashObj stakingKH1) `shouldReturn` poolDeposit <> govActionDeposit
699699
isDRepAccepted addCCGaid `shouldReturn` True
700700
-- The same vote should now successfully ratify the proposal
701701
passEpoch
@@ -991,12 +991,12 @@ votingSpec =
991991
(poolKH1, delegatorCStaking1) <- setupPoolWithoutStake
992992
-- Add rewards to delegation #1
993993
submitAndExpireProposalToMakeReward delegatorCStaking1
994-
lookupReward delegatorCStaking1 `shouldReturn` govActionDeposit
994+
getReward delegatorCStaking1 `shouldReturn` govActionDeposit
995995
-- Setup Pool delegation #2
996996
(poolKH2, delegatorCStaking2) <- setupPoolWithoutStake
997997
-- Add rewards to delegation #2
998998
submitAndExpireProposalToMakeReward delegatorCStaking2
999-
lookupReward delegatorCStaking2 `shouldReturn` govActionDeposit
999+
getReward delegatorCStaking2 `shouldReturn` govActionDeposit
10001000
-- Submit a committee proposal
10011001
Positive extra <- arbitrary
10021002
cc <- KeyHashObj <$> freshKeyHash
@@ -1017,7 +1017,7 @@ votingSpec =
10171017
-- Add to the rewards of the delegator to this SPO
10181018
-- to barely make the threshold (51 %! 100)
10191019
registerAndRetirePoolToMakeReward delegatorCStaking1
1020-
lookupReward delegatorCStaking1 `shouldReturn` poolDeposit <> govActionDeposit
1020+
getReward delegatorCStaking1 `shouldReturn` poolDeposit <> govActionDeposit
10211021
-- The same vote should now successfully ratify the proposal
10221022
-- NOTE: It takes 2 epochs for SPO votes as opposed to 1 epoch
10231023
-- for DRep votes to ratify a proposal.

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

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -92,10 +92,10 @@ spec =
9292
<$> replicateM 3 nativeScript
9393
let
9494
psh1 = hashPlutusScript $ alwaysSucceedsNoDatum SPlutusV2
95-
ps1 <- impAnn "Expecting Plutus script" . expectJust $ impLookupPlutusScriptMaybe psh1
95+
ps1 <- impAnn "Expecting Plutus script" . expectJust $ impLookupPlutusScript psh1
9696
let
9797
psh2 = hashPlutusScript $ alwaysSucceedsNoDatum SPlutusV3
98-
ps2 <- impAnn "Expecting Plutus script" . expectJust $ impLookupPlutusScriptMaybe psh2
98+
ps2 <- impAnn "Expecting Plutus script" . expectJust $ impLookupPlutusScript psh2
9999
let plutusScripts = [fromPlutusScript ps1, fromPlutusScript ps2]
100100
pure $ nativeScripts ++ plutusScripts
101101

@@ -118,7 +118,7 @@ spec =
118118
createRefScriptsUtxos ::
119119
HasCallStack => [Script era] -> ImpTestM era (Map.Map TxIn (Script era))
120120
createRefScriptsUtxos scripts = do
121-
rootOut <- snd <$> lookupImpRootTxOut
121+
rootOut <- snd <$> getImpRootTxOut
122122
let outs =
123123
scripts
124124
<&> ( \s ->

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

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -640,7 +640,7 @@ mkRefTxOut ::
640640
ImpTestM era (TxOut era)
641641
mkRefTxOut sh = do
642642
addr <- freshKeyAddr_
643-
let mbyPlutusScript = impLookupPlutusScriptMaybe sh
643+
let mbyPlutusScript = impLookupPlutusScript sh
644644
pure $
645645
mkBasicTxOut addr mempty
646646
& referenceScriptTxOutL .~ maybeToStrictMaybe (fromPlutusScript <$> mbyPlutusScript)

0 commit comments

Comments
 (0)