From 34a22eaceb56b7b8d6bc345601f96999c72a591f 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 | 109 +++++++++++++++---- hydra-cluster/src/HydraNode.hs | 50 +++++++-- hydra-cluster/test/Test/EndToEndSpec.hs | 2 +- hydra-node/src/Hydra/Chain/Direct/Wallet.hs | 2 + hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs | 5 + 6 files changed, 135 insertions(+), 37 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..570ef2769e6 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, emptyTxBody, mkSimpleTx, mkTransferTx, unsafeBuildTransaction) import Hydra.Logging (Tracer, traceWith) import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom) import Hydra.Tx (HeadId, IsTx (balance), Party, txId) @@ -100,6 +98,7 @@ import HydraNode ( waitMatch, withHydraCluster, withHydraNode, + withHydraNodeRealFee, ) import Network.HTTP.Conduit (parseUrlThrow) import Network.HTTP.Conduit qualified as L @@ -402,32 +401,96 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId = let hydraTracer = contramap FromHydraNode tracer (walletVk, walletSk) <- keysFor AliceFunds utxoToCommit <- seedFromFaucet node walletVk 5_000_000 (contramap FromFaucet tracer) - withHydraNode hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do + withHydraNodeRealFee 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 "queried-from-code-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 + & addInputs ([(spy' "script input" scriptInput, scriptWitness)] <> spy' "normal input" normalInput) + & addCollateralInput collateralInput + & addOutputs [spy' "script output" scriptOutput, spy' "return output" 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..6e7e6f34b90 100644 --- a/hydra-cluster/src/HydraNode.hs +++ b/hydra-cluster/src/HydraNode.hs @@ -310,7 +310,7 @@ withHydraNode :: IO a withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds action = do withLogFile logFilePath $ \logFileHandle -> do - withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds (Just logFileHandle) $ do + withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds (Just logFileHandle) True $ do \_ err processHandle -> do race (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle (Just err)) @@ -319,6 +319,31 @@ withHydraNode tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNod where logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" +-- | Run a hydra-node with given 'ChainConfig', and real protocol parameters (no zero fees). +withHydraNodeRealFee :: + Tracer IO HydraNodeLog -> + ChainConfig -> + FilePath -> + Int -> + SigningKey HydraKey -> + [VerificationKey HydraKey] -> + [Int] -> + (HydraClient -> IO a) -> + IO a +withHydraNodeRealFee tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds action = do + withLogFile logFilePath $ \logFileHandle -> do + withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds (Just logFileHandle) False $ do + \_ err processHandle -> do + race + (checkProcessHasNotDied ("hydra-node (" <> show hydraNodeId <> ")") processHandle (Just err)) + (withConnectionToNode tracer hydraNodeId action) + <&> either absurd id + where + logFilePath = workDir "logs" "hydra-node-" <> show hydraNodeId <.> "log" + +-- | A bit of boolean blindness, if this type is True we should zero the fees in queried protocol parameters. +type ZeroFees = Bool + -- | Run a hydra-node with given 'ChainConfig' and using the config from -- config/. withHydraNode' :: @@ -331,9 +356,10 @@ withHydraNode' :: [Int] -> -- | If given use this as std out. Maybe Handle -> + ZeroFees -> (Handle -> Handle -> ProcessHandle -> IO a) -> IO a -withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds mGivenStdOut action = do +withHydraNode' tracer chainConfig workDir hydraNodeId hydraSKey hydraVKeys allNodeIds mGivenStdOut zeroFees action = do -- NOTE: AirPlay on MacOS uses 5000 and we must avoid it. when (os == "darwin") $ port `shouldNotBe` (5_000 :: Network.PortNumber) withSystemTempDirectory "hydra-node" $ \dir -> do @@ -345,12 +371,18 @@ 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) + if zeroFees + then + 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) + else + protocolParameters + writeFileLBS "queried-pparams.json" (Aeson.encode protocolParameters) let hydraSigningKey = dir (show hydraNodeId <> ".sk") void $ writeFileTextEnvelope (File hydraSigningKey) Nothing hydraSKey @@ -384,14 +416,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-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 783d886ef08..ed37690ee8c 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -520,7 +520,7 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do let hydraTracer = contramap FromHydraNode tracer hydraScriptsTxId <- publishHydraScriptsAs node Faucet chainConfig <- chainConfigFor Alice dir nodeSocket hydraScriptsTxId [] (UnsafeContestationPeriod 1) - withHydraNode' hydraTracer chainConfig dir 1 aliceSk [] [1] Nothing $ \stdOut _ _processHandle -> do + withHydraNode' hydraTracer chainConfig dir 1 aliceSk [] [1] Nothing False $ \stdOut _ _processHandle -> do waitForLog 10 stdOut "JSON object with key NodeOptions" $ \line -> line ^? key "message" . key "tag" == Just (Aeson.String "NodeOptions") 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..31d4919dcea 100644 --- a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs +++ b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs @@ -83,6 +83,11 @@ 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]} + addReferenceInputs :: [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx addReferenceInputs refs' tx = tx