Trying to be more clear about the UTxOs to pay for things

cardano-scaling · Jan 7, 2025 · 1cce7d3 · 1cce7d3
1 parent 28e24cd
commit 1cce7d3
Show file tree

Hide file tree

Showing 3 changed files with 70 additions and 9 deletions.
diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs
@@ -86,7 +86,7 @@ import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
 import Hydra.Tx.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime)
-import Hydra.Tx.Utils (dummyValidatorScript, verificationKeyToOnChainId)
+import Hydra.Tx.Utils (dummyValidatorScript, schnorrkelValidatorScript, verificationKeyToOnChainId)
 import HydraNode (
   HydraClient (..),
   HydraNodeLog,
@@ -420,9 +420,10 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId =
         (walletVk, walletSk) <- keysFor AliceFunds
 
         let amt = 5_000_000
+            fee = 173_465
 
-        utxoToCommit <- seedFromFaucet node walletVk amt (contramap FromFaucet tracer)
-
+        -- L1 setup to (incrementally) commit funds
+        -- Script
         (clientPayload, scriptUTxO) <- prepareScriptPayload amt
         res <-
           runReq defaultHttpConfig $
@@ -441,13 +442,56 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId =
           guard $ v ^? key "tag" == Just "CommitFinalized"
           pure $ v ^? key "theDeposit"
         depositTxId `shouldBe` Just (toJSON $ getTxId $ getTxBody commitTx)
-        let (collateralInput, _) = List.head $ UTxO.pairs utxoToCommit
 
+        -- "Normal"
+        (clientPayload, utxoToCommit) <- prepareScriptPayload amt
+        res <-
+          runReq defaultHttpConfig $
+            req
+              POST
+              (http "127.0.0.1" /: "commit")
+              (ReqBodyJson clientPayload)
+              (Proxy :: Proxy (JsonResponse Tx))
+              (port $ 4000 + hydraNodeId)
+
+        let commitTx = responseBody res
+        submitTx node commitTx
+
+        depositTxId <- waitMatch (10 * blockTime) n1 $ \v -> do
+          guard $ v ^? key "headId" == Just (toJSON headId)
+          guard $ v ^? key "tag" == Just "CommitFinalized"
+          pure $ v ^? key "theDeposit"
+        depositTxId `shouldBe` Just (toJSON $ getTxId $ getTxBody commitTx)
+
+        -- Collateral
+        (clientPayload, collateralUTxO) <- prepareScriptPayload amt
+        res <-
+          runReq defaultHttpConfig $
+            req
+              POST
+              (http "127.0.0.1" /: "commit")
+              (ReqBodyJson clientPayload)
+              (Proxy :: Proxy (JsonResponse Tx))
+              (port $ 4000 + hydraNodeId)
+
+        let commitTx = responseBody res
+        submitTx node commitTx
+
+        depositTxId <- waitMatch (10 * blockTime) n1 $ \v -> do
+          guard $ v ^? key "headId" == Just (toJSON headId)
+          guard $ v ^? key "tag" == Just "CommitFinalized"
+          pure $ v ^? key "theDeposit"
+        depositTxId `shouldBe` Just (toJSON $ getTxId $ getTxBody commitTx)
+
+        --
+        -- Now, L2 with schnorrkel
         let (scriptInput, _) = List.head $ UTxO.pairs scriptUTxO
         let (normalInput', _) = List.head $ UTxO.pairs utxoToCommit
+        let (collateralInput, _) = List.head $ UTxO.pairs collateralUTxO
         pparams <- queryProtocolParameters networkId nodeSocket QueryTip
 
-        let serializedScript = PlutusScriptSerialised dummyValidatorScript
+        -- Note: Here is the first time we use the schnorrkel validator
+        let serializedScript = PlutusScriptSerialised schnorrkelValidatorScript
         let scriptAddress = mkScriptAddress networkId serializedScript
         let scriptOutput =
               mkTxOutAutoBalance
@@ -456,21 +500,25 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId =
                 (lovelaceToValue 0)
                 (mkTxOutDatumHash ())
                 ReferenceScriptNone
+
         let returnOutput =
-              TxOut (mkVkAddress networkId walletVk) (lovelaceToValue 4_826_535) TxOutDatumNone ReferenceScriptNone
+              TxOut (mkVkAddress networkId walletVk) (lovelaceToValue (amt - fee)) TxOutDatumNone ReferenceScriptNone
+
         let normalInput = (,BuildTxWith $ KeyWitness KeyWitnessForSpending) <$> [normalInput']
         let scriptWitness =
               BuildTxWith $
                 ScriptWitness scriptWitnessInCtx $
                   mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
+
         let tx =
               unsafeBuildTransaction $
                 defaultTxBodyContent
                   & changePParams pparams
                   & addTxIns ([(scriptInput, scriptWitness)] <> normalInput)
                   & addTxInsCollateral [collateralInput]
                   & addTxOuts [scriptOutput, returnOutput]
-                  & setTxFee (TxFeeExplicit $ Coin 173_465)
+                  & setTxFee (TxFeeExplicit fee)
+
         let signedL2tx = signTx walletSk tx
         send n1 $ input "NewTx" ["transaction" .= signedL2tx]
 

diff --git a/hydra-plutus/src/Hydra/Contract/Dummy.hs b/hydra-plutus/src/Hydra/Contract/Dummy.hs
@@ -14,8 +14,20 @@ import PlutusTx (CompiledCode, compile)
 import PlutusTx.Builtins (schnorrkel)
 import PlutusTx.Prelude (Eq (..))
 
+schnorrkelValidator :: BuiltinData -> BuiltinData -> ScriptContext -> Bool
+schnorrkelValidator _ _ _ = "" == schnorrkel ""
+
+schnorrkelValidatorScript :: SerialisedScript
+schnorrkelValidatorScript = serialiseCompiledCode compiledDummyValidator
+
+compiledSchnorrkelValidator :: CompiledCode ValidatorType
+compiledSchnorrkelValidator =
+  $$(PlutusTx.compile [||fakeWrap schnorrkelValidator||])
+ where
+  wrap = wrapValidator @BuiltinData @BuiltinData
+
 dummyValidator :: BuiltinData -> BuiltinData -> ScriptContext -> Bool
-dummyValidator _ _ _ = "" == schnorrkel ""
+dummyValidator _ _ _ = True
 
 compiledDummyValidator :: CompiledCode ValidatorType
 compiledDummyValidator =

diff --git a/hydra-tx/src/Hydra/Tx/Utils.hs b/hydra-tx/src/Hydra/Tx/Utils.hs
@@ -1,6 +1,7 @@
 module Hydra.Tx.Utils (
   module Hydra.Tx.Utils,
   dummyValidatorScript,
+  schnorrkelValidatorScript,
 ) where
 
 import Hydra.Cardano.Api
@@ -13,7 +14,7 @@ import Control.Lens ((.~), (^.))
 import Data.Map.Strict qualified as Map
 import Data.Maybe.Strict (StrictMaybe (..))
 import GHC.IsList (IsList (..))
-import Hydra.Contract.Dummy (dummyValidatorScript)
+import Hydra.Contract.Dummy (dummyValidatorScript, schnorrkelValidatorScript)
 import Hydra.Contract.Util (hydraHeadV1)
 import Hydra.Tx.OnChainId (OnChainId (..))
 import Ouroboros.Consensus.Shelley.Eras qualified as Ledger