collateral wip

cardano-scaling · Nov 25, 2024 · 0ee8e78 · 0ee8e78
1 parent 0e843b1
commit 0ee8e78
Show file tree

Hide file tree

Showing 3 changed files with 73 additions and 3 deletions.
diff --git 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
@@ -35,6 +35,9 @@ import Hydra.API.HTTPServer (
  )
 import Hydra.Cardano.Api (
   txSpendingUTxO,
+  CtxUTxO,
+  CtxTx,
+  TxOut,
   Coin (..),
   File (File),
   Key (SigningKey),
@@ -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, setInputsCollateral, addOutputs, emptyTxBody, mkSimpleTx, mkTransferTx, 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,57 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId =
       waitFor hydraTracer 10 [n1] $
         output "GetUTxOResponse" ["headId" .= headId, "utxo" .= (scriptUTxO <> scriptUTxO')]
 
-      let tx' = txSpendingUTxO scriptUTxO
+      --let tx' = txSpendingUTxO (scriptUTxO <> scriptUTxO')
+
+      let aliceAddress = mkVkAddress networkId walletVk
+      let someOutput =
+            TxOut
+              aliceAddress
+              (lovelaceToValue $ selectLovelace (foldMap (txOutValue . snd) $ UTxO.pairs ((scriptUTxO))))
+              TxOutDatumNone
+              ReferenceScriptNone
+
+      let tx' = mkScriptSpendingTx collateralUTxO (scriptUTxO <> scriptUTxO')  [someOutput]
+
+      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 utxo utxo' outputs =
+    let script = dummyValidatorScript
+        serializedScript = PlutusScriptSerialised script
+        scriptWitness =
+          BuildTxWith $
+            ScriptWitness scriptWitnessInCtx $
+              mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
+        scriptInputs = (\x -> (fst x, scriptWitness)) <$> UTxO.pairs utxo'
+
+        spendingTx =
+          unsafeBuildTransaction $
+            emptyTxBody
+              & addInputs scriptInputs
+              & setInputsCollateral (fst <$> UTxO.pairs utxo)
+              & 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
@@ -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