diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index fd8b91fb324..ced5cc55fec 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -11,12 +11,14 @@ import CardanoClient ( QueryPoint (QueryTip), RunningNode (..), buildTransaction, + buildTransactionWithBody, queryProtocolParameters, queryTip, queryUTxOFor, submitTx, waitForUTxO, ) +import Hydra.Cardano.Api.Pretty (renderTxWithUTxO) import CardanoNode (NodeLog) import Control.Concurrent.Async (mapConcurrently_) import Control.Lens ((^..), (^?)) @@ -36,6 +38,7 @@ import Hydra.API.HTTPServer ( ) import Hydra.Cardano.Api ( Coin (..), + mkTxIn, File (File), Key (SigningKey), KeyWitnessInCtx (KeyWitnessForSpending), @@ -403,7 +406,7 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId = returnFundsToFaucet tracer node AliceFunds ) $ do - refuelIfNeeded tracer node Alice 25_000_000 + refuelIfNeeded tracer node Alice 250_000_000 aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] $ UnsafeContestationPeriod 100 let hydraNodeId = 1 let hydraTracer = contramap FromHydraNode tracer @@ -411,149 +414,68 @@ singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId = send n1 $ input "Init" [] headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice]) - -- Commit nothing just to open - requestCommitTx n1 mempty >>= submitTx node - waitFor hydraTracer (10 * blockTime) [n1] $ - output "HeadIsOpen" ["utxo" .= object mempty, "headId" .= headId] - - -- Then commit a Tx with the schnorrkel validator (walletVk, walletSk) <- keysFor AliceFunds - let amt = 5_000_000 - fee = 173_465 - - -- L1 setup to (incrementally) commit funds - -- Script - (clientPayload, scriptUTxO) <- 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) + -- Create money on L1 + utxoToCommit <- seedFromFaucet node walletVk 100_000_000 (contramap FromFaucet tracer) - -- "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) + -- Push it into L2 + requestCommitTx n1 utxoToCommit <&> signTx walletSk >>= \tx -> do + putStrLn $ renderTxWithUTxO utxoToCommit tx + submitTx node tx - let commitTx = responseBody res - submitTx node commitTx + -- Check UTxO is present in L2 + waitFor hydraTracer (10 * blockTime) [n1] $ + output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId] - 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 - -- Note: Here is the first time we use the schnorrkel validator - let serializedScript = PlutusScriptSerialised schnorrkelValidatorScript + -- Send the UTxO to a script; in preparation for running the script + let serializedScript = PlutusScriptSerialised dummyValidatorScript + -- let serializedScript = PlutusScriptSerialised schnorrkelValidatorScript let scriptAddress = mkScriptAddress networkId serializedScript let scriptOutput = mkTxOutAutoBalance pparams scriptAddress - (lovelaceToValue 0) + (lovelaceToValue 0) -- Autobalanced (mkTxOutDatumHash ()) ReferenceScriptNone - let returnOutput = - TxOut (mkVkAddress networkId walletVk) (lovelaceToValue (amt - fee)) TxOutDatumNone ReferenceScriptNone + Right tx <- buildTransaction networkId nodeSocket (mkVkAddress networkId walletVk) utxoToCommit [] [scriptOutput] + + let signedL2tx = signTx walletSk tx + send n1 $ input "NewTx" ["transaction" .= signedL2tx] + + putStrLn $ renderTxWithUTxO utxoToCommit signedL2tx + + waitMatch 10 n1 $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + guard $ + toJSON signedL2tx + `elem` (v ^.. key "snapshot" . key "confirmed" . values) - let normalInput = (,BuildTxWith $ KeyWitness KeyWitnessForSpending) <$> [normalInput'] + -- Finally, take money from the script 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 fee) + -- TODO: Include the script as an input! + let body = + defaultTxBodyContent + & addTxIns [(mkTxIn signedL2tx 0, scriptWitness)] + tx <- either (failure . show) pure =<< buildTransactionWithBody networkId nodeSocket (mkVkAddress networkId walletVk) body utxoToCommit 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 + toJSON signedL2tx `elem` (v ^.. key "snapshot" . key "confirmed" . values) - v ^? key "snapshot" . key "utxo" >>= parseMaybe parseJSON where RunningNode{networkId, nodeSocket, blockTime} = node - -- TODO: extract this to standalone function - prepareScriptPayload lovelaceAmt = do - let script = dummyValidatorScript - let serializedScript = PlutusScriptSerialised script - let scriptAddress = mkScriptAddress networkId serializedScript - let datumHash = mkTxOutDatumHash () - (scriptIn, scriptOut) <- createOutputAtAddress node scriptAddress datumHash (lovelaceToValue lovelaceAmt) - let scriptUTxO = UTxO.singleton (scriptIn, scriptOut) - - let scriptWitness = - BuildTxWith $ - ScriptWitness scriptWitnessInCtx $ - mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ()) - let spendingTx = - unsafeBuildTransaction $ - defaultTxBodyContent - & addTxIns [(scriptIn, scriptWitness)] - pure - ( Aeson.object - [ "blueprintTx" .= spendingTx - , "utxo" .= scriptUTxO - ] - , scriptUTxO - ) singlePartyCommitsScriptBlueprint :: Tracer IO EndToEndLog -> diff --git a/hydra-node/src/Hydra/Chain/CardanoClient.hs b/hydra-node/src/Hydra/Chain/CardanoClient.hs index fd724190dde..8a3aac6c677 100644 --- a/hydra-node/src/Hydra/Chain/CardanoClient.hs +++ b/hydra-node/src/Hydra/Chain/CardanoClient.hs @@ -63,26 +63,19 @@ mkCardanoClient networkId nodeSocket = -- * Tx Construction / Submission --- | Construct a simple payment consuming some inputs and producing some --- outputs (no certificates or withdrawals involved). --- --- On success, the returned transaction is fully balanced. On error, return --- `TxBodyErrorAutoBalance`. -buildTransaction :: +buildTransactionWithBody :: -- | Current network identifier NetworkId -> -- | Filepath to the cardano-node's domain socket SocketPath -> -- | Change address to send AddressInEra -> + -- | Body + TxBodyContent BuildTx -> -- | Unspent transaction outputs to spend. UTxO -> - -- | Collateral inputs. - [TxIn] -> - -- | Outputs to create. - [TxOut CtxTx] -> IO (Either (TxBodyErrorAutoBalance Era) Tx) -buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do +buildTransactionWithBody networkId socket changeAddress body utxoToSpend = do pparams <- queryProtocolParameters networkId socket QueryTip systemStart <- querySystemStart networkId socket QueryTip eraHistory <- queryEraHistory networkId socket QueryTip @@ -98,9 +91,32 @@ buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do mempty mempty (UTxO.toApi utxoToSpend) - (bodyContent pparams) + body changeAddress Nothing + +-- | Construct a simple payment consuming some inputs and producing some +-- outputs (no certificates or withdrawals involved). +-- +-- On success, the returned transaction is fully balanced. On error, return +-- `TxBodyErrorAutoBalance`. +buildTransaction :: + -- | Current network identifier + NetworkId -> + -- | Filepath to the cardano-node's domain socket + SocketPath -> + -- | Change address to send + AddressInEra -> + -- | Unspent transaction outputs to spend. + UTxO -> + -- | Collateral inputs. + [TxIn] -> + -- | Outputs to create. + [TxOut CtxTx] -> + IO (Either (TxBodyErrorAutoBalance Era) Tx) +buildTransaction networkId socket changeAddress utxoToSpend collateral outs = do + pparams <- queryProtocolParameters networkId socket QueryTip + buildTransactionWithBody networkId socket changeAddress (bodyContent pparams) utxoToSpend where -- NOTE: 'makeTransactionBodyAutoBalance' overwrites this. dummyFeeForBalancing = TxFeeExplicit 0