collateral wip

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

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