|
| 1 | +{-# LANGUAGE NamedFieldPuns #-} |
| 2 | +{-# LANGUAGE NumericUnderscores #-} |
| 3 | +{-# LANGUAGE OverloadedStrings #-} |
| 4 | +{-# LANGUAGE ScopedTypeVariables #-} |
| 5 | + |
| 6 | +module Cardano.Testnet.Test.Cli.Plutus.BuildRaw ( |
| 7 | + hprop_build_raw_ref_script_spend, |
| 8 | +) |
| 9 | +where |
| 10 | + |
| 11 | +import Cardano.Api hiding (Value) |
| 12 | +import Cardano.Api.Experimental (Some (Some)) |
| 13 | +import Cardano.Api.Ledger (EpochInterval (..)) |
| 14 | + |
| 15 | +import Cardano.Testnet |
| 16 | + |
| 17 | +import Prelude |
| 18 | + |
| 19 | +import Control.Monad (void) |
| 20 | +import Data.Default.Class (Default (def)) |
| 21 | +import qualified Data.Text as Text |
| 22 | +import System.FilePath ((</>)) |
| 23 | +import qualified System.Info as SYS |
| 24 | + |
| 25 | +import Testnet.Components.Query ( |
| 26 | + findLargestUtxoForPaymentKey, |
| 27 | + getEpochStateView, |
| 28 | + getTxIx, |
| 29 | + watchEpochStateUpdate, |
| 30 | + ) |
| 31 | +import qualified Testnet.Defaults as Defaults |
| 32 | +import Testnet.Process.Cli.Transaction ( |
| 33 | + TxOutAddress (..), |
| 34 | + mkSpendOutputsOnlyTx, |
| 35 | + retrieveTransactionId, |
| 36 | + signTx, |
| 37 | + submitTx, |
| 38 | + ) |
| 39 | +import Testnet.Process.Run (execCli', mkExecConfig) |
| 40 | +import Testnet.Property.Util (integrationRetryWorkspace) |
| 41 | +import Testnet.Start.Types (eraToString) |
| 42 | +import Testnet.Types |
| 43 | + |
| 44 | +import Hedgehog (Property) |
| 45 | +import qualified Hedgehog as H |
| 46 | +import qualified Hedgehog.Extras.Test.Base as H |
| 47 | +import qualified Hedgehog.Extras.Test.File as H |
| 48 | +import qualified Hedgehog.Extras.Test.TestWatchdog as H |
| 49 | + |
| 50 | +{- | Test spending a reference script UTxO using @transaction build-raw@. |
| 51 | +@DISABLE_RETRIES=1 cabal test cardano-testnet-test --test-options '-p "/Build Raw Ref Script/"'@ |
| 52 | +-} |
| 53 | +hprop_build_raw_ref_script_spend :: Property |
| 54 | +hprop_build_raw_ref_script_spend = integrationRetryWorkspace 2 "build-raw-ref-script" $ \tempAbsBasePath' -> H.runWithDefaultWatchdog_ $ do |
| 55 | + H.note_ SYS.os |
| 56 | + conf@Conf{tempAbsPath} <- mkConf tempAbsBasePath' |
| 57 | + let tempAbsPath' = unTmpAbsPath tempAbsPath |
| 58 | + work <- H.createDirectoryIfMissing $ tempAbsPath' </> "work" |
| 59 | + |
| 60 | + let |
| 61 | + sbe = ShelleyBasedEraConway |
| 62 | + era = toCardanoEra sbe |
| 63 | + cEra = AnyCardanoEra era |
| 64 | + eraName = eraToString era |
| 65 | + tempBaseAbsPath = makeTmpBaseAbsPath $ TmpAbsolutePath tempAbsPath' |
| 66 | + options = def{cardanoNodeEra = AnyShelleyBasedEra sbe} |
| 67 | + |
| 68 | + TestnetRuntime |
| 69 | + { configurationFile |
| 70 | + , testnetMagic |
| 71 | + , testnetNodes |
| 72 | + , wallets = wallet0 : wallet1 : _ |
| 73 | + } <- |
| 74 | + createAndRunTestnet options def conf |
| 75 | + |
| 76 | + poolNode1 <- H.headM testnetNodes |
| 77 | + poolSprocket1 <- H.noteShow $ nodeSprocket poolNode1 |
| 78 | + execConfig <- mkExecConfig tempBaseAbsPath poolSprocket1 testnetMagic |
| 79 | + epochStateView <- getEpochStateView configurationFile (nodeSocketPath poolNode1) |
| 80 | + |
| 81 | + -- Write PlutusV3 always-succeeds script to file |
| 82 | + let plutusScriptFp = work </> "always-succeeds-script.plutusV3" |
| 83 | + H.writeFile plutusScriptFp $ Text.unpack Defaults.plutusV3Script |
| 84 | + let plutusV3Script = File plutusScriptFp |
| 85 | + |
| 86 | + -- Step 1: Publish reference script at wallet0's address (not the script address) |
| 87 | + refScriptPublishWork <- H.createDirectoryIfMissing $ work </> "ref-script-publish" |
| 88 | + let scriptPublishUTxOAmount = 10_000_000 |
| 89 | + |
| 90 | + txinPublish <- findLargestUtxoForPaymentKey epochStateView sbe wallet0 |
| 91 | + let txBodyPublishFp = File $ refScriptPublishWork </> "tx-body.txbody" |
| 92 | + void $ |
| 93 | + execCli' |
| 94 | + execConfig |
| 95 | + [ eraName |
| 96 | + , "transaction" |
| 97 | + , "build" |
| 98 | + , "--change-address" |
| 99 | + , Text.unpack $ paymentKeyInfoAddr wallet0 |
| 100 | + , "--tx-in" |
| 101 | + , prettyShow txinPublish |
| 102 | + , "--tx-out" |
| 103 | + , Text.unpack (paymentKeyInfoAddr wallet0) <> "+" <> show (unCoin scriptPublishUTxOAmount) |
| 104 | + , "--tx-out-reference-script-file" |
| 105 | + , unFile plutusV3Script |
| 106 | + , "--out-file" |
| 107 | + , unFile txBodyPublishFp |
| 108 | + ] |
| 109 | + signedTxPublishRefScript <- |
| 110 | + signTx |
| 111 | + execConfig |
| 112 | + cEra |
| 113 | + refScriptPublishWork |
| 114 | + "signed-tx" |
| 115 | + txBodyPublishFp |
| 116 | + [Some $ paymentKeyInfoPair wallet0] |
| 117 | + submitTx execConfig cEra signedTxPublishRefScript |
| 118 | + |
| 119 | + txIdPublishRefScript <- retrieveTransactionId execConfig signedTxPublishRefScript |
| 120 | + txIxPublishRefScript <- |
| 121 | + H.evalMaybeM $ |
| 122 | + watchEpochStateUpdate |
| 123 | + epochStateView |
| 124 | + (EpochInterval 2) |
| 125 | + (getTxIx sbe txIdPublishRefScript scriptPublishUTxOAmount) |
| 126 | + |
| 127 | + -- Step 2: Lock funds at script address |
| 128 | + refScriptLock <- H.createDirectoryIfMissing $ work </> "ref-script-lock" |
| 129 | + let transferAmount = 20_000_000 |
| 130 | + |
| 131 | + txBodyLock <- |
| 132 | + mkSpendOutputsOnlyTx |
| 133 | + execConfig |
| 134 | + epochStateView |
| 135 | + sbe |
| 136 | + refScriptLock |
| 137 | + "tx-body" |
| 138 | + wallet0 |
| 139 | + [(ScriptAddress plutusV3Script, transferAmount, Nothing)] |
| 140 | + signedTxLock <- |
| 141 | + signTx execConfig cEra refScriptLock "signed-tx" txBodyLock [Some $ paymentKeyInfoPair wallet0] |
| 142 | + submitTx execConfig cEra signedTxLock |
| 143 | + |
| 144 | + txIdLock <- retrieveTransactionId execConfig signedTxLock |
| 145 | + txIxLock <- |
| 146 | + H.evalMaybeM $ |
| 147 | + watchEpochStateUpdate epochStateView (EpochInterval 2) (getTxIx sbe txIdLock transferAmount) |
| 148 | + |
| 149 | + -- Step 3: Query protocol parameters |
| 150 | + void $ |
| 151 | + execCli' |
| 152 | + execConfig |
| 153 | + [ eraName |
| 154 | + , "query" |
| 155 | + , "protocol-parameters" |
| 156 | + , "--out-file" |
| 157 | + , work </> "pparams.json" |
| 158 | + ] |
| 159 | + |
| 160 | + -- Step 4: Build raw transaction to unlock the script UTxO |
| 161 | + refScriptUnlock <- H.createDirectoryIfMissing $ work </> "ref-script-unlock" |
| 162 | + let unsignedUnlockTx = File $ refScriptUnlock </> "unsigned-tx.tx" |
| 163 | + fee = 500_000 :: Coin |
| 164 | + |
| 165 | + collateralUTxO <- findLargestUtxoForPaymentKey epochStateView sbe wallet1 |
| 166 | + |
| 167 | + void $ |
| 168 | + execCli' |
| 169 | + execConfig |
| 170 | + [ eraName |
| 171 | + , "transaction" |
| 172 | + , "build-raw" |
| 173 | + , "--tx-in" |
| 174 | + , prettyShow (TxIn txIdLock txIxLock) |
| 175 | + , "--spending-reference-tx-in-inline-datum-present" |
| 176 | + , "--spending-tx-in-reference" |
| 177 | + , prettyShow (TxIn txIdPublishRefScript txIxPublishRefScript) |
| 178 | + , "--spending-plutus-script-v3" |
| 179 | + , "--spending-reference-tx-in-redeemer-value" |
| 180 | + , "42" |
| 181 | + , "--spending-reference-tx-in-execution-units" |
| 182 | + , "(200000000, 200000)" |
| 183 | + , "--tx-in-collateral" |
| 184 | + , prettyShow collateralUTxO |
| 185 | + , "--tx-out" |
| 186 | + , Text.unpack (paymentKeyInfoAddr wallet1) <> "+" <> show (unCoin (transferAmount - fee)) |
| 187 | + , "--fee" |
| 188 | + , show (unCoin fee) |
| 189 | + , "--protocol-params-file" |
| 190 | + , work </> "pparams.json" |
| 191 | + , "--out-file" |
| 192 | + , unFile unsignedUnlockTx |
| 193 | + ] |
| 194 | + |
| 195 | + -- Step 5: Sign and submit |
| 196 | + signedUnlockTx <- |
| 197 | + signTx |
| 198 | + execConfig |
| 199 | + cEra |
| 200 | + refScriptUnlock |
| 201 | + "signed-tx" |
| 202 | + unsignedUnlockTx |
| 203 | + [Some $ paymentKeyInfoPair wallet1] |
| 204 | + |
| 205 | + submitTx execConfig cEra signedUnlockTx |
| 206 | + |
| 207 | + -- Verify the transaction landed on chain |
| 208 | + txIdUnlock <- retrieveTransactionId execConfig signedUnlockTx |
| 209 | + void $ |
| 210 | + H.evalMaybeM $ |
| 211 | + watchEpochStateUpdate |
| 212 | + epochStateView |
| 213 | + (EpochInterval 2) |
| 214 | + (getTxIx sbe txIdUnlock (transferAmount - fee)) |
0 commit comments