Merge pull request #652 from input-output-hk/task/reduce_cost_commit_tx

Reduce cost of commitTx

CHANGELOG.md

@@ -26,6 +26,8 @@ changes.
   + Changed logs of `BeginInitialize` and `EndInitialize`.
   + Added `SkipUpdate` constructor to the wallet logs.
 
+- Reduce cost of `commitTx` by using the initial script as input reference.
+
 ## [0.8.1] - 2022-11-17
 
 - **BREAKING** Implemented [ADR18](https://hydra.family/head-protocol/adr/18) to keep only a single state:

hydra-node/exe/tx-cost/TxCost.hs

@@ -102,7 +102,7 @@ computeCommitCost = do
     -- NOTE: number of parties is irrelevant for commit tx
     ctx <- genHydraContextFor 1
     (cctx, stInitial) <- genStInitial ctx
-    pure (commit cctx stInitial utxo, getKnownUTxO stInitial)
+    pure (commit cctx stInitial utxo, getKnownUTxO stInitial <> getKnownUTxO cctx)
 
 computeCollectComCost :: IO [(NumParties, TxSize, MemUnit, CpuUnit, Lovelace)]
 computeCollectComCost =

hydra-node/src/Hydra/Chain/Direct/State.hs

@@ -292,13 +292,13 @@ commit ctx st utxo = do
       case UTxO.pairs utxo of
         [aUTxO] -> do
           rejectByronAddress aUTxO
-          Right $ commitTx networkId ownParty (Just aUTxO) initial
+          Right $ commitTx scriptRegistry networkId ownParty (Just aUTxO) initial
         [] -> do
-          Right $ commitTx networkId ownParty Nothing initial
+          Right $ commitTx scriptRegistry networkId ownParty Nothing initial
         _ ->
           Left (MoreThanOneUTxOCommitted @Tx)
  where
-  ChainContext{networkId, ownParty, ownVerificationKey} = ctx
+  ChainContext{networkId, ownParty, ownVerificationKey, scriptRegistry} = ctx
 
   InitialState
     { initialInitials

hydra-node/src/Hydra/Chain/Direct/Tx.hs

@@ -165,6 +165,8 @@ mkInitialOutput networkId tokenPolicyId (verificationKeyHash -> pkh) =
 
 -- | Craft a commit transaction which includes the "committed" utxo as a datum.
 commitTx ::
+  -- | Published Hydra scripts to reference.
+  ScriptRegistry ->
   NetworkId ->
   Party ->
   -- | A single UTxO to commit to the Head
@@ -174,18 +176,23 @@ commitTx ::
   -- locked by initial script
   (TxIn, TxOut CtxUTxO, Hash PaymentKey) ->
   Tx
-commitTx networkId party utxo (initialInput, out, vkh) =
+commitTx scriptRegistry networkId party utxo (initialInput, out, vkh) =
   unsafeBuildTransaction $
     emptyTxBody
-      & addInputs [(initialInput, initialWitness_)]
+      & addInputs [(initialInput, initialWitness)]
+      & addReferenceInputs [initialScriptRef]
       & addVkInputs (maybeToList mCommittedInput)
       & addExtraRequiredSigners [vkh]
       & addOutputs [commitOutput]
  where
-  initialWitness_ =
-    BuildTxWith $ ScriptWitness scriptWitnessCtx $ mkScriptWitness initialScript initialDatum initialRedeemer
+  initialWitness =
+    BuildTxWith $
+      ScriptWitness scriptWitnessCtx $
+        mkScriptReference initialScriptRef initialScript initialDatum initialRedeemer
   initialScript =
     fromPlutusScript @PlutusScriptV2 Initial.validatorScript
+  initialScriptRef =
+    fst (initialReference scriptRegistry)
   initialDatum =
     mkScriptDatum $ Initial.datum ()
   initialRedeemer =

hydra-node/src/Hydra/Chain/Direct/Wallet.hs

@@ -16,7 +16,8 @@ import Cardano.Ledger.Alonzo.Tools (TransactionScriptFailure, evaluateTransactio
 import Cardano.Ledger.Alonzo.TxInfo (TranslationError)
 import Cardano.Ledger.Alonzo.TxWitness (RdmrPtr (RdmrPtr), Redeemers (..), TxWitness (txrdmrs), txdats, txscripts)
 import Cardano.Ledger.Babbage.PParams (PParams, PParams' (..))
-import Cardano.Ledger.Babbage.Tx (ValidatedTx (..), getLanguageView, hashData, hashScriptIntegrity)
+import Cardano.Ledger.Babbage.Scripts (refScripts)
+import Cardano.Ledger.Babbage.Tx (ValidatedTx (..), getLanguageView, hashData, hashScriptIntegrity, referenceInputs)
 import Cardano.Ledger.Babbage.TxBody (Datum (..), collateral, inputs, outputs, outputs', scriptIntegrityHash, txfee)
 import qualified Cardano.Ledger.Babbage.TxBody as Ledger.Babbage
 import qualified Cardano.Ledger.BaseTypes as Ledger
@@ -141,7 +142,7 @@ newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo = do
   pure
     TinyWallet
       { getUTxO
-      , getSeedInput = (fmap (fromLedgerTxIn . fst) . findFuelUTxO) <$> getUTxO
+      , getSeedInput = fmap (fromLedgerTxIn . fst) . findFuelUTxO <$> getUTxO
       , sign = Util.signWith sk
       , coverFee = \lookupUTxO partialTx -> do
           -- XXX: We should query pparams here. If not, we likely will have
@@ -239,8 +240,9 @@ coverFee_ pparams systemStart epochInfo lookupUTxO walletUTxO partialTx@Validate
   let inputs' = inputs body <> Set.singleton input
   resolvedInputs <- traverse resolveInput (toList inputs')
 
+  let utxo = lookupUTxO <> walletUTxO
   estimatedScriptCosts <-
-    estimateScriptsCost pparams systemStart epochInfo (lookupUTxO <> walletUTxO) partialTx
+    estimateScriptsCost pparams systemStart epochInfo utxo partialTx
   let adjustedRedeemers =
         adjustRedeemers
           (inputs body)
@@ -258,11 +260,12 @@ coverFee_ pparams systemStart epochInfo lookupUTxO walletUTxO partialTx@Validate
         needlesslyHighFee
 
   let newOutputs = outputs body <> StrictSeq.singleton (mkSized change)
+      referenceScripts = refScripts @LedgerEra (referenceInputs body) (Ledger.UTxO utxo)
       langs =
         [ getLanguageView pparams l
-        | (_hash, script) <- Map.toList (txscripts wits)
+        | (_hash, script) <- Map.toList $ Map.union (txscripts wits) referenceScripts
         , (not . isNativeScript @LedgerEra) script
-        , Just l <- [language script]
+        , l <- maybeToList (language script)
         ]
       finalBody =
         body

hydra-node/test/Hydra/Chain/Direct/Contract/Commit.hs

@@ -15,6 +15,7 @@ import Hydra.Chain.Direct.Contract.Mutation (
   SomeMutation (..),
  )
 import qualified Hydra.Chain.Direct.Fixture as Fixture
+import Hydra.Chain.Direct.ScriptRegistry (genScriptRegistry, registryUTxO)
 import Hydra.Chain.Direct.Tx (commitTx, headPolicyId, mkInitialOutput)
 import Hydra.Ledger.Cardano (
   genAddressInEra,
@@ -36,13 +37,17 @@ healthyCommitTx =
   lookupUTxO =
     UTxO.singleton (initialInput, toUTxOContext initialOutput)
       <> UTxO.singleton healthyCommittedUTxO
+      <> registryUTxO scriptRegistry
   tx =
     commitTx
+      scriptRegistry
       Fixture.testNetworkId
       commitParty
       (Just healthyCommittedUTxO)
       (initialInput, toUTxOContext initialOutput, initialPubKeyHash)
 
+  scriptRegistry = genScriptRegistry `generateWith` 42
+
   initialInput = generateWith arbitrary 42
 
   initialOutput = mkInitialOutput Fixture.testNetworkId policyId commitVerificationKey