Bring in example that just spends from a script in L2 and closes (#1796)

noonio · web-flow · commit c1c759b6915a · 2025-01-22T13:45:06.000Z
This brings in the bulk of the work from #1742 ; it demonstrates that one can spend from a script on L2. This is useful infrastructure to, say, test a custom ledger operation and check that the Hydra can deal with that on it's own ledger, but still close and go back to L1 successfully. This is a useful test in any case. Note that it contains a `TODO` around a bug we saw with autobalancing, that will hopefully be fixed in subsequent versions of `cardano-api`. We make two further additions: - We attempt to zero-out a few more fee fields in the protocol params - We provide `buildTransactionWithPParams` to explicitly set the pparams instead of using the **L1 pparams**. This is an important observation!
diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal
@@ -85,8 +85,11 @@ library
   build-depends:
     , aeson
     , async
-    , base                  >=4.7 && <5
+    , base                   >=4.7 && <5
     , bytestring
+    , cardano-ledger-alonzo
+    , cardano-ledger-api
+    , cardano-ledger-core
     , cardano-slotting
     , containers
     , contra-tracer
diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
@@ -7,18 +7,26 @@ import Hydra.Prelude
 import Test.Hydra.Prelude
 
 import Cardano.Api.UTxO qualified as UTxO
+import Cardano.Ledger.Alonzo.Tx (hashScriptIntegrity)
+import Cardano.Ledger.Api.PParams (AlonzoEraPParams, PParams, getLanguageView)
+import Cardano.Ledger.Api.Tx (EraTx, bodyTxL, datsTxWitsL, rdmrsTxWitsL, witsTxL)
+import Cardano.Ledger.Api.Tx qualified as Ledger
+import Cardano.Ledger.Api.Tx.Body (AlonzoEraTxBody, scriptIntegrityHashTxBodyL)
+import Cardano.Ledger.Api.Tx.Wits (AlonzoEraTxWits)
+import Cardano.Ledger.Plutus.Language (Language (PlutusV3))
 import CardanoClient (
   QueryPoint (QueryTip),
   RunningNode (..),
   buildTransaction,
+  buildTransactionWithPParams,
   queryTip,
   queryUTxOFor,
   submitTx,
   waitForUTxO,
  )
 import CardanoNode (NodeLog)
 import Control.Concurrent.Async (mapConcurrently_)
-import Control.Lens ((^..), (^?))
+import Control.Lens ((.~), (^.), (^..), (^?))
 import Data.Aeson (Value, object, (.=))
 import Data.Aeson qualified as Aeson
 import Data.Aeson.Lens (key, values, _JSON, _String)
@@ -37,12 +45,17 @@ import Hydra.Cardano.Api (
   Coin (..),
   File (File),
   Key (SigningKey),
+  KeyWitnessInCtx (KeyWitnessForSpending),
   PaymentKey,
   Tx,
   TxId,
   UTxO,
   addTxIns,
+  addTxInsCollateral,
+  addTxOuts,
+  createAndValidateTransactionBody,
   defaultTxBodyContent,
+  fromLedgerTx,
   getTxBody,
   getTxId,
   getVerificationKey,
@@ -51,16 +64,24 @@ import Hydra.Cardano.Api (
   mkScriptAddress,
   mkScriptDatum,
   mkScriptWitness,
+  mkTxIn,
+  mkTxOutAutoBalance,
   mkTxOutDatumHash,
   mkVkAddress,
   scriptWitnessInCtx,
   selectLovelace,
+  setTxProtocolParams,
   signTx,
+  toLedgerTx,
   toScriptData,
   txOutValue,
+  txOuts',
   utxoFromTx,
   writeFileTextEnvelope,
   pattern BuildTxWith,
+  pattern KeyWitness,
+  pattern LedgerProtocolParameters,
+  pattern PlutusScriptWitness,
   pattern ReferenceScriptNone,
   pattern ScriptWitness,
   pattern TxOut,
@@ -73,6 +94,7 @@ import Hydra.Cluster.Mithril (MithrilLog)
 import Hydra.Cluster.Options (Options)
 import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId)
 import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx, unsafeBuildTransaction)
+import Hydra.Ledger.Cardano.Evaluate (maxTxExecutionUnits)
 import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
@@ -381,6 +403,145 @@ singlePartyCommitsFromExternal tracer workDir node hydraScriptsTxId =
  where
   RunningNode{nodeSocket, blockTime} = node
 
+singlePartyUsesScriptOnL2 ::
+  Tracer IO EndToEndLog ->
+  FilePath ->
+  RunningNode ->
+  [TxId] ->
+  IO ()
+singlePartyUsesScriptOnL2 tracer workDir node hydraScriptsTxId =
+  ( `finally`
+      do
+        returnFundsToFaucet tracer node Alice
+        returnFundsToFaucet tracer node AliceFunds
+  )
+    $ do
+      refuelIfNeeded tracer node Alice 250_000_000
+      aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] $ UnsafeContestationPeriod 1
+      let hydraNodeId = 1
+      let hydraTracer = contramap FromHydraNode tracer
+      withHydraNode hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do
+        send n1 $ input "Init" []
+        headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice])
+
+        (walletVk, walletSk) <- keysFor AliceFunds
+
+        -- Create money on L1
+        let commitAmount = 100_000_000
+        utxoToCommit <- seedFromFaucet node walletVk commitAmount (contramap FromFaucet tracer)
+
+        -- Push it into L2
+        requestCommitTx n1 utxoToCommit
+          <&> signTx walletSk >>= \tx -> do
+            submitTx node tx
+
+        -- Check UTxO is present in L2
+        waitFor hydraTracer (10 * blockTime) [n1] $
+          output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId]
+
+        pparamsReq <-
+          parseUrlThrow ("GET " <> hydraNodeBaseUrl n1 <> "/protocol-parameters")
+            >>= httpJSON
+        let pparams = getResponseBody pparamsReq
+
+        -- Send the UTxO to a script; in preparation for running the script
+        let serializedScript = dummyValidatorScript
+        let scriptAddress = mkScriptAddress networkId serializedScript
+        let scriptOutput =
+              mkTxOutAutoBalance
+                pparams
+                scriptAddress
+                (lovelaceToValue 0)
+                (mkTxOutDatumHash ())
+                ReferenceScriptNone
+
+        Right tx <- buildTransactionWithPParams pparams networkId nodeSocket (mkVkAddress networkId walletVk) utxoToCommit [] [scriptOutput]
+
+        let signedL2tx = signTx walletSk tx
+        send n1 $ input "NewTx" ["transaction" .= signedL2tx]
+
+        waitMatch 10 n1 $ \v -> do
+          guard $ v ^? key "tag" == Just "SnapshotConfirmed"
+          guard $
+            toJSON signedL2tx
+              `elem` (v ^.. key "snapshot" . key "confirmed" . values)
+
+        -- Now, spend the money from the script
+        let scriptWitness =
+              BuildTxWith $
+                ScriptWitness scriptWitnessInCtx $
+                  PlutusScriptWitness
+                    serializedScript
+                    (mkScriptDatum ())
+                    (toScriptData ())
+                    maxTxExecutionUnits
+
+        let txIn = mkTxIn signedL2tx 0
+        let remainder = mkTxIn signedL2tx 1
+
+        let outAmt = foldMap txOutValue (txOuts' tx)
+        let body =
+              defaultTxBodyContent
+                & addTxIns [(txIn, scriptWitness), (remainder, BuildTxWith $ KeyWitness KeyWitnessForSpending)]
+                & addTxInsCollateral [remainder]
+                & addTxOuts [TxOut (mkVkAddress networkId walletVk) outAmt TxOutDatumNone ReferenceScriptNone]
+                & setTxProtocolParams (BuildTxWith $ Just $ LedgerProtocolParameters pparams)
+
+        -- TODO: Instead of using `createAndValidateTransactionBody`, we
+        -- should be able to just construct the Tx with autobalancing via
+        -- `buildTransactionWithBody`. Unfortunately this is broken in the
+        -- version of cardano-api that we presently use; in a future upgrade
+        -- of that library we can try again.
+        -- tx' <- either (failure . show) pure =<< buildTransactionWithBody networkId nodeSocket (mkVkAddress networkId walletVk) body utxoToCommit
+        txBody <- either (failure . show) pure (createAndValidateTransactionBody body)
+
+        let spendTx' = makeSignedTransaction [] txBody
+            spendTx = fromLedgerTx $ recomputeIntegrityHash pparams [PlutusV3] (toLedgerTx spendTx')
+        let signedTx = signTx walletSk spendTx
+
+        send n1 $ input "NewTx" ["transaction" .= signedTx]
+
+        waitMatch 10 n1 $ \v -> do
+          guard $ v ^? key "tag" == Just "SnapshotConfirmed"
+          guard $
+            toJSON signedTx
+              `elem` (v ^.. key "snapshot" . key "confirmed" . values)
+
+        -- And check that we can close and fanout the head successfully
+        send n1 $ input "Close" []
+        deadline <- waitMatch (10 * blockTime) n1 $ \v -> do
+          guard $ v ^? key "tag" == Just "HeadIsClosed"
+          v ^? key "contestationDeadline" . _JSON
+        remainingTime <- diffUTCTime deadline <$> getCurrentTime
+        waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $
+          output "ReadyToFanout" ["headId" .= headId]
+        send n1 $ input "Fanout" []
+        waitMatch (10 * blockTime) n1 $ \v ->
+          guard $ v ^? key "tag" == Just "HeadIsFinalized"
+
+        -- Assert final wallet balance
+        (balance <$> queryUTxOFor networkId nodeSocket QueryTip walletVk)
+          `shouldReturn` lovelaceToValue commitAmount
+ where
+  RunningNode{networkId, nodeSocket, blockTime} = node
+  hydraNodeBaseUrl HydraClient{hydraNodeId} = "http://127.0.0.1:" <> show (4000 + hydraNodeId)
+
+-- | Compute the integrity hash of a transaction using a list of plutus languages.
+recomputeIntegrityHash ::
+  (AlonzoEraPParams ppera, AlonzoEraTxWits txera, AlonzoEraTxBody txera, EraTx txera) =>
+  PParams ppera ->
+  [Language] ->
+  Ledger.Tx txera ->
+  Ledger.Tx txera
+recomputeIntegrityHash pp languages tx = do
+  tx & bodyTxL . scriptIntegrityHashTxBodyL .~ integrityHash
+ where
+  integrityHash =
+    hashScriptIntegrity
+      (Set.fromList $ getLanguageView pp <$> languages)
+      (tx ^. witsTxL . rdmrsTxWitsL)
+      (tx ^. witsTxL . datsTxWitsL)
+
 singlePartyCommitsScriptBlueprint ::
   Tracer IO EndToEndLog ->
   FilePath ->
diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs
@@ -350,6 +350,9 @@ withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNo
             & atKey "txFeePerByte" ?~ toJSON (Number 0)
             & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0)
             & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0)
+            & atKey "utxoCostPerByte" ?~ toJSON (Number 0)
+            & atKey "treasuryCut" ?~ toJSON (Number 0)
+            & atKey "minFeeRefScriptCostPerByte" ?~ toJSON (Number 0)
 
     let hydraSigningKey = dir </> (show hydraNodeId <> ".sk")
     void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey
diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs
@@ -67,6 +67,7 @@ import Hydra.Cluster.Scenarios (
   singlePartyCommitsFromExternalTxBlueprint,
   singlePartyCommitsScriptBlueprint,
   singlePartyHeadFullLifeCycle,
+  singlePartyUsesScriptOnL2,
   testPreventResumeReconfiguredPeer,
   threeNodesNoErrorsOnOpen,
  )
@@ -178,6 +179,11 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
             publishHydraScriptsAs node Faucet
               >>= singlePartyCommitsFromExternal tracer tmpDir node
+      it "can spend from a script on L2" $ \tracer -> do
+        withClusterTempDir $ \tmpDir -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
+            publishHydraScriptsAs node Faucet
+              >>= singlePartyUsesScriptOnL2 tracer tmpDir node
       it "can submit a signed user transaction" $ \tracer -> do
         withClusterTempDir $ \tmpDir -> do
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs
@@ -63,27 +63,27 @@ mkCardanoClient networkId nodeSocket =
 
 -- * Tx Construction / Submission
 
--- | Construct a simple payment consuming some inputs and producing some
--- outputs (no certificates or withdrawals involved).
---
--- On success, the returned transaction is fully balanced. On error, return
--- `TxBodyErrorAutoBalance`.
-buildTransaction ::
+buildTransactionWithBody ::
+  -- | Protocol parameters
+  PParams LedgerEra ->
   -- | Current network identifier
   NetworkId ->
   -- | Filepath to the cardano-node's domain socket
   SocketPath ->
   -- | Change address to send
   AddressInEra ->
+  -- | Body
+  TxBodyContent BuildTx ->
   -- | Unspent transaction outputs to spend.
   UTxO ->
-  -- | Collateral inputs.
-  [TxIn] ->
-  -- | Outputs to create.
-  [TxOut CtxTx] ->
   IO (Either (TxBodyErrorAutoBalance Era) Tx)
-buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do
-  pparams <- queryProtocolParameters networkId socket QueryTip
+buildTransactionWithBody pparams networkId socket changeAddress body utxoToSpend = do
+  -- XXX: Note minor inconsistency here; we are querying the _socket_ (i.e.
+  -- L1) for this information, but in fact this function may be called for the
+  -- construction of an L2 transaction. For this reason we take the pparams as
+  -- an argument, and at some point we can move these other fields to
+  -- arguments as well; but they are not important for our purposes at
+  -- present.
   systemStart <- querySystemStart networkId socket QueryTip
   eraHistory <- queryEraHistory networkId socket QueryTip
   stakePools <- queryStakePools networkId socket QueryTip
@@ -98,14 +98,55 @@ buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do
         mempty
         mempty
         (UTxO.toApi utxoToSpend)
-        (bodyContent pparams)
+        body
         changeAddress
         Nothing
+
+buildTransaction ::
+  -- | Current network identifier
+  NetworkId ->
+  -- | Filepath to the cardano-node's domain socket
+  SocketPath ->
+  -- | Change address to send
+  AddressInEra ->
+  -- | Unspent transaction outputs to spend.
+  UTxO ->
+  -- | Collateral inputs.
+  [TxIn] ->
+  -- | Outputs to create.
+  [TxOut CtxTx] ->
+  IO (Either (TxBodyErrorAutoBalance Era) Tx)
+buildTransaction networkId socket changeAddress body utxoToSpend outs = do
+  pparams <- queryProtocolParameters networkId socket QueryTip
+  buildTransactionWithPParams pparams networkId socket changeAddress body utxoToSpend outs
+
+-- | Construct a simple payment consuming some inputs and producing some
+-- outputs (no certificates or withdrawals involved).
+--
+-- On success, the returned transaction is fully balanced. On error, return
+-- `TxBodyErrorAutoBalance`.
+buildTransactionWithPParams ::
+  -- | Protocol parameters
+  PParams LedgerEra ->
+  -- | Current network identifier
+  NetworkId ->
+  -- | Filepath to the cardano-node's domain socket
+  SocketPath ->
+  -- | Change address to send
+  AddressInEra ->
+  -- | Unspent transaction outputs to spend.
+  UTxO ->
+  -- | Collateral inputs.
+  [TxIn] ->
+  -- | Outputs to create.
+  [TxOut CtxTx] ->
+  IO (Either (TxBodyErrorAutoBalance Era) Tx)
+buildTransactionWithPParams pparams networkId socket changeAddress utxoToSpend collateral outs = do
+  buildTransactionWithBody pparams networkId socket changeAddress bodyContent utxoToSpend
  where
   -- NOTE: 'makeTransactionBodyAutoBalance' overwrites this.
   dummyFeeForBalancing = TxFeeExplicit 0
-
-  bodyContent pparams =
+  bodyContent =
     TxBodyContent
       (withWitness <$> toList (UTxO.inputSet utxoToSpend))
       (TxInsCollateral collateral)
