Skip to content

Commit b1f6254

Browse files
v0d1chv0d1ch
committed
Refactor minting in cluster tests
We want to split test code and code that is used to publish hydra transactions to reduce tech debt.
1 parent 4ecdd88 commit b1f6254

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)