From d180493bd9a0880e6eab9ba2798284baa53bf616 Mon Sep 17 00:00:00 2001 From: Sasha Bogicevic Date: Mon, 9 Dec 2024 19:13:20 +0100 Subject: [PATCH] WIP: Improve schnorkel test cases Still getting PPViewHashesDontMatch but this is the final error to solve --- hydra-cluster/hydra-cluster.cabal | 4 - hydra-cluster/src/Hydra/Cluster/Scenarios.hs | 107 +++++++++++++++---- hydra-cluster/src/HydraNode.hs | 10 +- hydra-node/src/Hydra/Chain/Direct/Wallet.hs | 2 + hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs | 9 ++ 5 files changed, 102 insertions(+), 30 deletions(-) diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 23a7d1d9a06..5fc922554bd 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -88,7 +88,6 @@ library , base >=4.7 && <5 , bytestring , cardano-slotting - , cardano-api , containers , contra-tracer , data-default @@ -99,7 +98,6 @@ library , hydra-cardano-api , hydra-node , hydra-prelude - , hydra-plutus , hydra-test-utils , hydra-tx , hydra-tx:testlib @@ -108,8 +106,6 @@ library , lens , lens-aeson , optparse-applicative - , plutus-ledger-api - , plutus-tx , process , QuickCheck , req diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 8e9f9bb450e..1d27f35fce6 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -6,20 +6,17 @@ module Hydra.Cluster.Scenarios where import Hydra.Prelude import Test.Hydra.Prelude -import qualified Cardano.Api.Shelley as C -import qualified PlutusTx.Prelude as PlutusTx -import qualified PlutusLedgerApi.V1 as PV1 import Cardano.Api.UTxO qualified as UTxO import CardanoClient ( QueryPoint (QueryTip), RunningNode (..), buildTransaction, + queryProtocolParameters, queryTip, queryUTxOFor, submitTx, waitForUTxO, ) -import Hydra.Contract.Dummy (dummyValidatorHash) import CardanoNode (NodeLog) import Control.Concurrent.Async (mapConcurrently_) import Control.Lens ((^..), (^?)) @@ -41,12 +38,9 @@ import Hydra.Cardano.Api ( Coin (..), File (File), Key (SigningKey), + KeyWitnessInCtx (KeyWitnessForSpending), PaymentKey, - StakeAddressReference(..), - PaymentCredential(..), Tx, - shelleyBasedEra, - makeShelleyAddressInEra, TxId, UTxO, getTxBody, @@ -57,19 +51,23 @@ import Hydra.Cardano.Api ( mkScriptAddress, mkScriptDatum, mkScriptWitness, + mkTxOutAutoBalance, mkTxOutDatumHash, mkVkAddress, scriptWitnessInCtx, selectLovelace, + setTxFee, signTx, toScriptData, txOutValue, utxoFromTx, writeFileTextEnvelope, pattern BuildTxWith, + pattern KeyWitness, pattern PlutusScriptSerialised, pattern ReferenceScriptNone, pattern ScriptWitness, + pattern TxFeeExplicit, pattern TxOut, pattern TxOutDatumNone, ) @@ -79,7 +77,7 @@ import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bo import Hydra.Cluster.Mithril (MithrilLog) import Hydra.Cluster.Options (Options) import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId) -import Hydra.Ledger.Cardano (addInputs, emptyTxBody, mkSimpleTx, mkTransferTx, unsafeBuildTransaction) +import Hydra.Ledger.Cardano (addCollateralInput, addInputs, addOutputs, changePParams, emptyTxBody, mkSimpleTx, mkTransferTx, unsafeBuildTransaction) import Hydra.Logging (Tracer, traceWith) import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom) import Hydra.Tx (HeadId, IsTx (balance), Party, txId) @@ -405,29 +403,94 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId = withHydraNode hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do send n1 $ input "Init" [] headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice]) + requestCommitTx n1 utxoToCommit <&> signTx walletSk >>= submitTx node waitFor hydraTracer (10 * blockTime) [n1] $ output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId] - scriptHash <- unTransScriptHash dummyValidatorHash - let scriptAddress = makeShelleyAddressInEra shelleyBasedEra networkId (PaymentCredentialByScript scriptHash) NoStakeAddress - let i = undefined - let o = undefined - let tx = mkSimpleTx (i, o) (scriptAddress, txOutValue o) walletSk - send n1 $ input "NewTx" ["transaction" .= tx] + (clientPayload, scriptUTxO) <- prepareScriptPayload + 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) + let (collateralInput, _) = List.head $ UTxO.pairs utxoToCommit + + let (scriptInput, _) = List.head $ UTxO.pairs scriptUTxO + let (normalInput', _) = List.head $ UTxO.pairs utxoToCommit + pparams <- queryProtocolParameters networkId nodeSocket QueryTip + writeFileLBS "pparams.json" $ Aeson.encode pparams + + let serializedScript = PlutusScriptSerialised dummyValidatorScript + let scriptAddress = mkScriptAddress networkId serializedScript + let scriptOutput = + mkTxOutAutoBalance + pparams + scriptAddress + (lovelaceToValue 0) + (mkTxOutDatumHash ()) + ReferenceScriptNone + let returnOutput = + TxOut (mkVkAddress networkId walletVk) (lovelaceToValue 4_826_535) TxOutDatumNone ReferenceScriptNone + let normalInput = (,BuildTxWith $ KeyWitness KeyWitnessForSpending) <$> [normalInput'] + let scriptWitness = + BuildTxWith $ + ScriptWitness scriptWitnessInCtx $ + mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ()) + let tx = + unsafeBuildTransaction $ + emptyTxBody + & changePParams pparams + & addInputs ([(scriptInput, scriptWitness)] <> normalInput) + & addCollateralInput collateralInput + & addOutputs [scriptOutput, returnOutput] + & setTxFee (TxFeeExplicit $ Coin 173_465) + let signedL2tx = signTx walletSk tx + send n1 $ input "NewTx" ["transaction" .= signedL2tx] + waitMatch 10 n1 $ \v -> do guard $ v ^? key "tag" == Just "SnapshotConfirmed" guard $ toJSON tx `elem` (v ^.. key "snapshot" . key "confirmed" . values) v ^? key "snapshot" . key "utxo" >>= parseMaybe parseJSON - where - RunningNode{networkId, nodeSocket, blockTime} = node - unTransScriptHash :: PV1.ScriptHash -> IO C.ScriptHash - unTransScriptHash (PV1.ScriptHash vh) = - case C.deserialiseFromRawBytes C.AsScriptHash $ PlutusTx.fromBuiltin vh of - Left e -> fail $ show e - Right x -> pure x + where + RunningNode{networkId, nodeSocket, blockTime} = node + -- TODO: extract this to standalone function + prepareScriptPayload = do + let script = dummyValidatorScript + let serializedScript = PlutusScriptSerialised script + let scriptAddress = mkScriptAddress networkId serializedScript + let datumHash = mkTxOutDatumHash () + (scriptIn, scriptOut) <- createOutputAtAddress node scriptAddress datumHash (lovelaceToValue 0) + let scriptUTxO = UTxO.singleton (scriptIn, scriptOut) + let scriptWitness = + BuildTxWith $ + ScriptWitness scriptWitnessInCtx $ + mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ()) + let spendingTx = + unsafeBuildTransaction $ + emptyTxBody + & addInputs [(scriptIn, scriptWitness)] + pure + ( Aeson.object + [ "blueprintTx" .= spendingTx + , "utxo" .= scriptUTxO + ] + , scriptUTxO + ) singlePartyCommitsScriptBlueprint :: Tracer IO EndToEndLog -> diff --git a/hydra-cluster/src/HydraNode.hs b/hydra-cluster/src/HydraNode.hs index 420434566b8..b9d91a7ade0 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -345,12 +345,14 @@ withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNo Direct DirectChainConfig{nodeSocket, networkId} -> do -- NOTE: This implicitly tests of cardano-cli with hydra-node protocolParameters <- cliQueryProtocolParameters nodeSocket networkId + print cardanoLedgerProtocolParametersFile Aeson.encodeFile cardanoLedgerProtocolParametersFile $ protocolParameters & atKey "txFeeFixed" ?~ toJSON (Number 0) & atKey "txFeePerByte" ?~ toJSON (Number 0) - & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0) - & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0) + -- & key "executionUnitPrices" . atKey "priceMemory" ?~ toJSON (Number 0) + -- & key "executionUnitPrices" . atKey "priceSteps" ?~ toJSON (Number 0) + writeFileLBS "queried-pparams.json" (Aeson.encode protocolParameters) let hydraSigningKey = dir (show hydraNodeId <> ".sk") void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey @@ -384,14 +386,14 @@ withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNo } ) { std_out = maybe CreatePipe UseHandle mGivenStdOut - , std_err = CreatePipe + , std_err = Inherit } traceWith tracer $ HydraNodeCommandSpec $ show $ cmdspec p withCreateProcess p $ \_stdin mCreatedStdOut mCreatedStdErr processHandle -> case (mCreatedStdOut <|> mGivenStdOut, mCreatedStdErr) of - (Just out, Just err) -> action out err processHandle + (Just out, Nothing) -> action out stderr processHandle (Nothing, _) -> error "Should not happen™" (_, Nothing) -> error "Should not happen™" where diff --git a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs index b6b3dfc3e7e..97b4826b07e 100644 --- a/hydra-node/src/Hydra/Chain/Direct/Wallet.hs +++ b/hydra-node/src/Hydra/Chain/Direct/Wallet.hs @@ -71,6 +71,7 @@ import Cardano.Slotting.EpochInfo (EpochInfo) import Cardano.Slotting.Time (SystemStart (..)) import Control.Concurrent.Class.MonadSTM (check, newTVarIO, readTVarIO, writeTVar) import Control.Lens (view, (%~), (.~), (^.)) +import Data.Aeson qualified as Aeson import Data.List qualified as List import Data.Map.Strict ((!)) import Data.Map.Strict qualified as Map @@ -179,6 +180,7 @@ newTinyWallet tracer networkId (vk, sk) queryWalletInfo queryEpochInfo querySome -- We query pparams here again as it's possible that a hardfork -- occurred and the pparams changed. pparams <- querySomePParams + writeFileLBS "pparams.json" (Aeson.encode pparams) pure $ fromLedgerTx <$> coverFee_ pparams systemStart epochInfo ledgerLookupUTxO walletUTxO (toLedgerTx partialTx) diff --git a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs index bd996c69643..40e3e2ff612 100644 --- a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs +++ b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs @@ -83,6 +83,15 @@ addInputs :: TxIns BuildTx -> TxBodyContent BuildTx -> TxBodyContent BuildTx addInputs ins tx = tx{txIns = txIns tx <> ins} +-- | Add new inputs to an ongoing builder. +addCollateralInput :: TxIn -> TxBodyContent BuildTx -> TxBodyContent BuildTx +addCollateralInput txin tx = + tx{txInsCollateral = TxInsCollateral [txin]} + +changePParams :: PParams (ShelleyLedgerEra Era) -> TxBodyContent BuildTx -> TxBodyContent BuildTx +changePParams pparams tx = + tx{txProtocolParams = BuildTxWith $ Just $ LedgerProtocolParameters pparams} + addReferenceInputs :: [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx addReferenceInputs refs' tx = tx