Skip to content

Commit b0fb6c6

Browse files
noonionoonio
authored
Refactor minting in cluster tests (#2265)
fix #2252 We want to split test code and code that is used to publish hydra transactions as per @ffakenz request. <!-- Describe your change here --> --- <!-- Consider each and tick it off one way or the other --> * [x] CHANGELOG updated or not needed * [x] Documentation updated or not needed * [x] Haddocks updated or not needed * [x] No new TODOs introduced or explained herafter
2 parents 9f91925 + 1731e8a commit b0fb6c6

File tree

4 files changed

+83
-39
lines changed

4 files changed

+83
-39
lines changed

‎hydra-cluster/src/Hydra/Cluster/Faucet.hs‎

Lines changed: 18 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ import Control.Tracer (Tracer, traceWith)
1919
import Data.Set qualified as Set
2020
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
2121
import GHC.IO.Exception (IOErrorType (ResourceExhausted), IOException (ioe_type))
22-
import Hydra.Chain.Backend (ChainBackend, buildTransaction, buildTransactionWithPParams')
22+
import Hydra.Chain.Backend (ChainBackend, buildTransaction, buildTransactionWithMintingScript, buildTransactionWithPParams')
2323
import Hydra.Chain.Backend qualified as Backend
2424
import Hydra.Chain.Blockfrost.Client qualified as Blockfrost
2525
import Hydra.Chain.ScriptRegistry (
@@ -44,8 +44,6 @@ data FaucetLog
4444
deriving stock (Eq, Show, Generic)
4545
deriving anyclass (ToJSON)
4646

47-
-- | Create a specially marked "seed" UTXO containing requested 'Value' by
48-
-- redeeming funds available to the well-known faucet.
4947
seedFromFaucet ::
5048
ChainBackend backend =>
5149
backend ->
@@ -56,6 +54,21 @@ seedFromFaucet ::
5654
Tracer IO FaucetLog ->
5755
IO UTxO
5856
seedFromFaucet backend receivingVerificationKey val tracer = do
57+
seedFromFaucetWithMinting backend receivingVerificationKey val tracer Nothing
58+
59+
-- | Create a specially marked "seed" UTXO containing requested 'Value' by
60+
-- redeeming funds available to the well-known faucet.
61+
seedFromFaucetWithMinting ::
62+
ChainBackend backend =>
63+
backend ->
64+
-- | Recipient of the funds
65+
VerificationKey PaymentKey ->
66+
-- | Value to get from faucet
67+
Value ->
68+
Tracer IO FaucetLog ->
69+
Maybe PlutusScript ->
70+
IO UTxO
71+
seedFromFaucetWithMinting backend receivingVerificationKey val tracer mintingScript = do
5972
(faucetVk, faucetSk) <- keysFor Faucet
6073
networkId <- Backend.queryNetworkId backend
6174
seedTx <- retryOnExceptions tracer $ submitSeedTx faucetVk faucetSk networkId
@@ -66,7 +79,7 @@ seedFromFaucet backend receivingVerificationKey val tracer = do
6679
faucetUTxO <- findFaucetUTxO networkId backend (selectLovelace val)
6780
let changeAddress = mkVkAddress networkId faucetVk
6881

69-
buildTransaction backend changeAddress faucetUTxO (toList $ UTxO.inputSet faucetUTxO) [theOutput networkId] >>= \case
82+
buildTransactionWithMintingScript backend changeAddress faucetUTxO (toList $ UTxO.inputSet faucetUTxO) [theOutput networkId] mintingScript >>= \case
7083
Left e -> throwIO $ FaucetFailedToBuildTx{reason = e}
7184
Right tx -> do
7285
let signedTx = sign faucetSk $ getTxBody tx
@@ -121,7 +134,7 @@ seedFromFaucetBlockfrost receivingVerificationKey lovelace = do
121134
let systemStart = SystemStart $ posixSecondsToUTCTime systemStart'
122135
eraHistory <- Blockfrost.queryEraHistory
123136
foundUTxO <- findUTxO networkId changeAddress lovelace
124-
case buildTransactionWithPParams' pparams systemStart eraHistory stakePools (mkVkAddress networkId faucetVk) foundUTxO [] [theOutput] of
137+
case buildTransactionWithPParams' pparams systemStart eraHistory stakePools (mkVkAddress networkId faucetVk) foundUTxO [] [theOutput] Nothing of
125138
Left e -> liftIO $ throwIO $ FaucetFailedToBuildTx{reason = e}
126139
Right tx -> do
127140
let signedTx = signTx faucetSk tx

‎hydra-cluster/src/Hydra/Cluster/Scenarios.hs‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,7 @@ import Hydra.Cardano.Api.TxOut (modifyTxOutValue)
101101
import Hydra.Chain (PostTxError (..))
102102
import Hydra.Chain.Backend (ChainBackend, buildTransaction, buildTransactionWithPParams, buildTransactionWithPParams')
103103
import Hydra.Chain.Backend qualified as Backend
104-
import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucet_)
104+
import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucetWithMinting, seedFromFaucet_)
105105
import Hydra.Cluster.Faucet qualified as Faucet
106106
import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk, carol, carolSk, carolVk)
107107
import Hydra.Cluster.Mithril (MithrilLog)
@@ -647,7 +647,7 @@ singlePartyUsesScriptOnL2 tracer workDir backend hydraScriptsTxId =
647647
systemStart <- Backend.querySystemStart backend QueryTip
648648
eraHistory <- Backend.queryEraHistory backend QueryTip
649649
stakePools <- Backend.queryStakePools backend QueryTip
650-
case buildTransactionWithPParams' pparams systemStart eraHistory stakePools (mkVkAddress networkId walletVk) utxoToCommit [] [scriptOutput] of
650+
case buildTransactionWithPParams' pparams systemStart eraHistory stakePools (mkVkAddress networkId walletVk) utxoToCommit [] [scriptOutput] Nothing of
651651
Left e -> error $ show e
652652
Right tx -> do
653653
let signedL2tx = signTx walletSk tx
@@ -745,7 +745,7 @@ singlePartyUsesWithdrawZeroTrick tracer workDir backend hydraScriptsTxId =
745745
-- Prepare a tx that re-spends everything owned by walletVk
746746
pparams <- getProtocolParameters n1
747747
let change = mkVkAddress networkId walletVk
748-
Right tx <- buildTransactionWithPParams pparams backend change utxoToCommit [] []
748+
Right tx <- buildTransactionWithPParams pparams backend change utxoToCommit [] [] Nothing
749749

750750
-- Modify the tx to run a script via the withdraw 0 trick
751751
let redeemer = toLedgerData $ toScriptData ()
@@ -1356,7 +1356,7 @@ canDepositPartially tracer workDir blockTime backend hydraScriptsTxId =
13561356
-- and some ADA is added to it after balancing in the wallet, then we have problems matching on the 'CommitApproved' etc.
13571357
let commitAmount = 5_000_000
13581358
commitUTxOWithoutTokens <- seedFromFaucet backend walletVk (lovelaceToValue seedAmount) (contramap FromFaucet tracer)
1359-
commitUTxOWithTokens <- seedFromFaucet backend walletVk (lovelaceToValue seedAmount <> tokenAssetValue) (contramap FromFaucet tracer)
1359+
commitUTxOWithTokens <- seedFromFaucetWithMinting backend walletVk (lovelaceToValue seedAmount <> tokenAssetValue) (contramap FromFaucet tracer) (Just dummyMintingScript)
13601360
-- This one is expected to fail since there is not enough ADA value
13611361
(requestCommitTx' n1 commitUTxOWithoutTokens (Just 10_000_001) Nothing <&> toJSON)
13621362
`shouldThrow` expectErrorStatus 400 (Just "AmountTooLow")

‎hydra-node/src/Hydra/Chain/Backend.hs‎

Lines changed: 60 additions & 29 deletions
Original file line numberDiff line numberDiff line change
@@ -44,7 +44,24 @@ buildTransaction ::
4444
IO (Either (TxBodyErrorAutoBalance Era) Tx)
4545
buildTransaction backend changeAddress body utxoToSpend outs = do
4646
pparams <- queryProtocolParameters backend CardanoClient.QueryTip
47-
buildTransactionWithPParams pparams backend changeAddress body utxoToSpend outs
47+
buildTransactionWithPParams pparams backend changeAddress body utxoToSpend outs Nothing
48+
49+
buildTransactionWithMintingScript ::
50+
ChainBackend backend =>
51+
backend ->
52+
-- | Change address to send
53+
AddressInEra ->
54+
-- | Unspent transaction outputs to spend.
55+
UTxO ->
56+
-- | Collateral inputs.
57+
[TxIn] ->
58+
-- | Outputs to create.
59+
[TxOut CtxTx] ->
60+
Maybe PlutusScript ->
61+
IO (Either (TxBodyErrorAutoBalance Era) Tx)
62+
buildTransactionWithMintingScript backend changeAddress body utxoToSpend outs mintingScript = do
63+
pparams <- queryProtocolParameters backend CardanoClient.QueryTip
64+
buildTransactionWithPParams pparams backend changeAddress body utxoToSpend outs mintingScript
4865

4966
-- | Construct a simple payment consuming some inputs and producing some
5067
-- outputs (no certificates or withdrawals involved).
@@ -64,15 +81,17 @@ buildTransactionWithPParams ::
6481
[TxIn] ->
6582
-- | Outputs to create.
6683
[TxOut CtxTx] ->
84+
Maybe PlutusScript ->
6785
IO (Either (TxBodyErrorAutoBalance Era) Tx)
68-
buildTransactionWithPParams pparams backend changeAddress utxoToSpend collateral outs = do
86+
buildTransactionWithPParams pparams backend changeAddress utxoToSpend collateral outs mintingScript = do
6987
systemStart <- querySystemStart backend CardanoClient.QueryTip
7088
eraHistory <- queryEraHistory backend CardanoClient.QueryTip
7189
stakePools <- queryStakePools backend CardanoClient.QueryTip
72-
pure $ buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs
90+
pure $ buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs mintingScript
7391

74-
-- | NOTE: If there are any non ADA assets present in the output 'Value'
75-
-- this function will mint them using 'dummyValidatorScript' as the script witness.
92+
-- | NOTE: If there are any non ADA assets present in the output 'Value' and
93+
-- minting scrips is specified this function will mint them using provided
94+
-- script as the script witness.
7695
buildTransactionWithPParams' ::
7796
-- | Protocol parameters
7897
PParams LedgerEra ->
@@ -87,30 +106,45 @@ buildTransactionWithPParams' ::
87106
[TxIn] ->
88107
-- | Outputs to create.
89108
[TxOut CtxTx] ->
109+
Maybe PlutusScript ->
90110
Either (TxBodyErrorAutoBalance Era) Tx
91-
buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs = do
111+
buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxoToSpend collateral outs mintingScript = do
92112
buildTransactionWithBody pparams systemStart eraHistory stakePools changeAddress bodyContent utxoToSpend
93113
where
94-
dummyMintingWitness :: ScriptWitness WitCtxMint
95-
dummyMintingWitness =
96-
mkScriptWitness dummyMintingScript NoScriptDatumForMint (toScriptData ())
97-
98-
setMintValue =
99-
let toMint = valueToPolicyAssets (foldMap txOutValue outs)
100-
in if null toMint
101-
then TxMintValueNone
102-
else
103-
TxMintValue $
104-
Map.fromList $
105-
( \(pid, assets) ->
106-
( pid
107-
,
108-
( assets
109-
, BuildTxWith dummyMintingWitness
110-
)
114+
mintValue =
115+
case mintingScript of
116+
Nothing -> TxMintValueNone
117+
Just _ ->
118+
let mintingWitness =
119+
mkScriptWitness dummyMintingScript NoScriptDatumForMint (toScriptData ())
120+
toMint = valueToPolicyAssets (foldMap txOutValue outs)
121+
in if null toMint
122+
then TxMintValueNone
123+
else
124+
TxMintValue $
125+
Map.fromList $
126+
( \(pid, assets) ->
127+
( pid
128+
,
129+
( assets
130+
, BuildTxWith mintingWitness
131+
)
132+
)
111133
)
134+
<$> Map.toList toMint
135+
auxScripts =
136+
if mintValue == TxMintValueNone
137+
then TxAuxScriptsNone
138+
else
139+
TxAuxScripts
140+
( maybeToList $
141+
toScriptInEra
142+
ShelleyBasedEraConway
143+
( toScriptInAnyLang $
144+
PlutusScript $
145+
fromMaybe dummyMintingScript mintingScript
112146
)
113-
<$> Map.toList toMint
147+
)
114148
-- NOTE: 'makeTransactionBodyAutoBalance' overwrites this.
115149
bodyContent =
116150
TxBodyContent
@@ -124,16 +158,13 @@ buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAdd
124158
, txValidityLowerBound = TxValidityNoLowerBound
125159
, txValidityUpperBound = TxValidityNoUpperBound
126160
, txMetadata = TxMetadataNone
127-
, txAuxScripts =
128-
if setMintValue == TxMintValueNone
129-
then TxAuxScriptsNone
130-
else TxAuxScripts (maybeToList $ toScriptInEra ShelleyBasedEraConway (toScriptInAnyLang $ PlutusScript dummyMintingScript))
161+
, txAuxScripts = auxScripts
131162
, txExtraKeyWits = TxExtraKeyWitnessesNone
132163
, txProtocolParams = BuildTxWith $ Just $ LedgerProtocolParameters pparams
133164
, txWithdrawals = TxWithdrawalsNone
134165
, txCertificates = TxCertificatesNone
135166
, txUpdateProposal = TxUpdateProposalNone
136-
, txMintValue = setMintValue
167+
, txMintValue = mintValue
137168
, txScriptValidity = TxScriptValidityNone
138169
, txProposalProcedures = Nothing
139170
, txVotingProcedures = Nothing

‎hydra-node/src/Hydra/Chain/ScriptRegistry.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -117,7 +117,7 @@ buildScriptPublishingTxs pparams systemStart networkId eraHistory stakePools ava
117117
-- Note that we spend the entire UTxO set to cover the deposit scripts, resulting in a squashed UTxO at the end.
118118
go _ [] = pure []
119119
go utxo (out : rest) = do
120-
tx <- case buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxo [] [out] of
120+
tx <- case buildTransactionWithPParams' pparams systemStart eraHistory stakePools changeAddress utxo [] [out] Nothing of
121121
Left err -> throwIO $ FailedToBuildPublishingTx err
122122
Right tx -> pure $ signTx sk tx
123123

0 commit comments

Comments
 (0)