diff --git a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs index 53cb6ad7ca5..34a4582d853 100644 --- a/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs +++ b/hydra-cardano-api/src/Hydra/Cardano/Api/Pretty.hs @@ -36,6 +36,8 @@ renderTxWithUTxO utxo (Tx body _wits) = <> [""] <> referenceInputLines <> [""] + <> collateralInputLines + <> [""] <> outputLines <> [""] <> validityLines @@ -69,6 +71,15 @@ renderTxWithUTxO utxo (Tx body _wits) = Api.TxInsReferenceNone -> [] Api.TxInsReference refInputs -> refInputs + collateralInputLines = + "== COLLATERAL INPUTS (" <> show (length collateralInputs) <> ")" + : (("- " <>) . prettyTxIn <$> sort collateralInputs) + + collateralInputs = + case txInsCollateral content of + Api.TxInsCollateralNone -> [] + Api.TxInsCollateral refInputs -> refInputs + prettyTxIn i = case UTxO.resolve i utxo of Nothing -> T.unpack $ renderTxIn i diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 93e98b38e59..9570102d5ef 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -34,13 +34,15 @@ import Hydra.API.HTTPServer ( TransactionSubmitted (..), ) import Hydra.Cardano.Api ( - txSpendingUTxO, Coin (..), + CtxTx, + CtxUTxO, File (File), Key (SigningKey), PaymentKey, Tx, TxId, + TxOut, UTxO, getTxBody, getTxId, @@ -57,6 +59,7 @@ import Hydra.Cardano.Api ( signTx, toScriptData, txOutValue, + txSpendingUTxO, utxoFromTx, writeFileTextEnvelope, pattern BuildTxWith, @@ -66,13 +69,14 @@ import Hydra.Cardano.Api ( pattern TxOut, pattern TxOutDatumNone, ) +import Hydra.Cardano.Api.Pretty (renderTxWithUTxO) import Hydra.Cluster.Faucet (FaucetLog, createOutputAtAddress, seedFromFaucet, seedFromFaucet_) import Hydra.Cluster.Faucet qualified as Faucet import Hydra.Cluster.Fixture (Actor (..), actorName, alice, aliceSk, aliceVk, bob, bobSk, bobVk, carol, carolSk) 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 (addInputs, addOutputs, emptyTxBody, mkSimpleTx, mkTransferTx, setInputsCollateral, unsafeBuildTransaction) import Hydra.Logging (Tracer, traceWith) import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom) import Hydra.Tx (HeadId, IsTx (balance), Party, txId) @@ -393,7 +397,8 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId = aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] $ UnsafeContestationPeriod 100 let hydraNodeId = 1 let hydraTracer = contramap FromHydraNode tracer - (_, walletSk) <- keysFor AliceFunds + (walletVk, walletSk) <- keysFor AliceFunds + collateralUTxO <- seedFromFaucet node walletVk 10_000_000 (contramap FromFaucet tracer) withHydraNode hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do send n1 $ input "Init" [] headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice]) @@ -444,10 +449,80 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId = waitFor hydraTracer 10 [n1] $ output "GetUTxOResponse" ["headId" .= headId, "utxo" .= (scriptUTxO <> scriptUTxO')] - let tx' = txSpendingUTxO scriptUTxO + res'' <- + runReq defaultHttpConfig $ + req + POST + (http "127.0.0.1" /: "commit") + (ReqBodyJson collateralUTxO) + (Proxy :: Proxy (JsonResponse Tx)) + (port $ 4000 + hydraNodeId) + + let depositTransaction' = responseBody res'' + let tx' = signTx walletSk depositTransaction' + + submitTx node tx' + + waitFor hydraTracer 10 [n1] $ + output "CommitApproved" ["headId" .= headId, "utxoToCommit" .= collateralUTxO] + waitFor hydraTracer 10 [n1] $ + output "CommitFinalized" ["headId" .= headId, "theDeposit" .= getTxId (getTxBody tx')] + + send n1 $ input "GetUTxO" [] + + waitFor hydraTracer 10 [n1] $ + output "GetUTxOResponse" ["headId" .= headId, "utxo" .= (scriptUTxO <> scriptUTxO' <> collateralUTxO)] + + let aliceAddress = mkVkAddress networkId walletVk + let someOutput = + TxOut + aliceAddress + (lovelaceToValue $ selectLovelace (foldMap (txOutValue . snd) $ UTxO.pairs (scriptUTxO <> scriptUTxO' <> collateralUTxO))) + TxOutDatumNone + ReferenceScriptNone + + let tx'' = mkScriptSpendingTx collateralUTxO (scriptUTxO <> scriptUTxO') [someOutput] - send n1 $ input "NewTx" ["transaction" .= tx'] + let tx''' = signTx walletSk tx'' + + putStrLn $ renderTxWithUTxO (scriptUTxO <> scriptUTxO' <> collateralUTxO) tx''' + + send n1 $ input "NewTx" ["transaction" .= tx'''] + + waitMatch 10 n1 $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + + -- Close and Fanout whatever is left in the Head back to L1 + send n1 $ input "Close" [] + deadline <- waitMatch (10 * blockTime) n1 $ \v -> do + guard $ v ^? key "tag" == Just "HeadIsClosed" + v ^? key "contestationDeadline" . _JSON + remainingTime <- diffUTCTime deadline <$> getCurrentTime + waitFor hydraTracer (remainingTime + 3 * blockTime) [n1] $ + output "ReadyToFanout" ["headId" .= headId] + send n1 $ input "Fanout" [] + waitMatch (10 * blockTime) n1 $ \v -> + guard $ v ^? key "tag" == Just "HeadIsFinalized" where + mkScriptSpendingTx :: UTxO -> UTxO.UTxO' (TxOut CtxUTxO) -> [TxOut CtxTx] -> Tx + mkScriptSpendingTx collateralUTxO scriptUTxO outputs = + let script = dummyValidatorScript + serializedScript = PlutusScriptSerialised script + scriptWitness = + BuildTxWith $ + ScriptWitness scriptWitnessInCtx $ + mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ()) + scriptInputs = (\x -> (fst x, scriptWitness)) <$> UTxO.pairs scriptUTxO + + spendingTx = + unsafeBuildTransaction $ + emptyTxBody + & addInputs scriptInputs + & setInputsCollateral (fst <$> UTxO.pairs collateralUTxO) + & addOutputs outputs + in spendingTx + + prepareScriptPayload :: IO (Value, UTxO.UTxO' (TxOut CtxUTxO)) prepareScriptPayload = do let script = dummyValidatorScript let serializedScript = PlutusScriptSerialised script diff --git a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs index bd996c69643..833787b29c8 100644 --- a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs +++ b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs @@ -83,6 +83,13 @@ addInputs :: TxIns BuildTx -> TxBodyContent BuildTx -> TxBodyContent BuildTx addInputs ins tx = tx{txIns = txIns tx <> ins} + +-- | Add new collateral inputs to an ongoing builder. +setInputsCollateral :: [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx +setInputsCollateral ins tx = + tx{txInsCollateral = TxInsCollateral ins} + + addReferenceInputs :: [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx addReferenceInputs refs' tx = tx