diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 81d568dec6c..ad0d49d88d0 100644 --- 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,13 +500,16 @@ 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 @@ -470,7 +517,8 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId = & 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 index 1ae65b52f61..47b561fa7b4 100644 --- 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 index bd53b730042..282a828e5c6 100644 --- 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