Schnorrkel 1.37 wip

cabal.project

@@ -12,8 +12,8 @@ repository cardano-haskell-packages
 
 -- See CONTRIBUTING.md for information about when and how to update these.
 index-state:
-  , hackage.haskell.org 2024-11-22T14:59:16Z
-  , cardano-haskell-packages 2024-12-20T15:52:56Z
+  , hackage.haskell.org 2025-01-15T13:32:16Z
+  , cardano-haskell-packages 2025-01-15T09:59:24Z
 
 packages:
   hydra-prelude
@@ -42,6 +42,32 @@ test-show-details: direct
 program-options
   ghc-options: -fwrite-ide-info
 
-constraints:
-  quickcheck-instances==0.3.31,
-  data-default==0.7.1.3
+--source-repository-package
+--  type: git
+--  location: https://github.com/IntersectMBO/cardano-api
+--  tag: 271099ce20b9767367fc0ecdb1a6f2d0f71a00f7
+--  --sha256: sha256-6PImVY8AHDPHk76wADaV+JIjtTVlKM9rwKw2sBFxD14=
+--  subdir:
+--    cardano-api
+
+source-repository-package
+  type: git
+  location: https://github.com/locallycompact/cardano-base
+  tag: 1a800a0c1392935256aebabf6c1fdefe5e8b34ae
+  --sha256: sha256-LXYzVyWHWBS361NR4pL/Jbilnv48z6ZozltaL2/ym2s=
+  subdir:
+    cardano-crypto-class
+
+source-repository-package
+  type: git
+  location: https://github.com/locallycompact/plutus
+  tag: d4f1bc056e4db3f3d71af9069f355a97d326b29b
+  --sha256: sha256-w3vtZ8v4nGAkeGoNjd5kZly7fv4QPm/iEgyg3EasZAM=
+  subdir:
+    -- prettyprinter-configurable
+    plutus-core
+    plutus-ledger-api
+    plutus-tx-plugin
+    plutus-tx
+
+allow-newer: cardano-crypto-class

hydra-cardano-api/hydra-cardano-api.cabal

@@ -77,7 +77,7 @@ library
     , aeson                      >=2
     , base                       >=4.16
     , bytestring
-    , cardano-api                ^>=10.5
+    , cardano-api                ^>=10.6
     , cardano-api:gen
     , cardano-binary
     , cardano-crypto-class

hydra-cardano-api/src/Hydra/Cardano/Api/Prelude.hs

@@ -40,7 +40,7 @@ import Cardano.Crypto.Hash.Class qualified as CC
 import Cardano.Ledger.Binary qualified as Ledger
 import Cardano.Ledger.Core qualified as Ledger
 import Cardano.Ledger.Crypto (StandardCrypto)
-import Cardano.Ledger.Era (EraCrypto)
+import Cardano.Ledger.Core (EraCrypto)
 import Data.Aeson (FromJSON (..), ToJSON (..))
 import Data.ByteString (ByteString)
 import Data.ByteString.Lazy (fromStrict, toStrict)

hydra-cardano-api/src/Hydra/Cardano/Api/ScriptData.hs

@@ -4,7 +4,7 @@ module Hydra.Cardano.Api.ScriptData where
 
 import Hydra.Cardano.Api.Prelude hiding (left)
 
-import Cardano.Ledger.Era qualified as Ledger
+import Cardano.Ledger.Core qualified as Ledger
 import Cardano.Ledger.Plutus.Data qualified as Ledger
 import PlutusLedgerApi.V3 qualified as Plutus
 

hydra-cluster/src/Hydra/Cluster/Scenarios.hs

@@ -11,6 +11,8 @@ import CardanoClient (
   QueryPoint (QueryTip),
   RunningNode (..),
   buildTransaction,
+  buildTransactionWithBody,
+  queryProtocolParameters,
   queryTip,
   queryUTxOFor,
   submitTx,
@@ -42,6 +44,9 @@ import Hydra.Cardano.Api (
   TxId,
   UTxO,
   addTxIns,
+  addTxInsCollateral,
+  addTxOuts,
+  createAndValidateTransactionBody,
   defaultTxBodyContent,
   getTxBody,
   getTxId,
@@ -51,10 +56,13 @@ import Hydra.Cardano.Api (
   mkScriptAddress,
   mkScriptDatum,
   mkScriptWitness,
+  mkTxIn,
+  mkTxOutAutoBalance,
   mkTxOutDatumHash,
   mkVkAddress,
   scriptWitnessInCtx,
   selectLovelace,
+  setTxFee,
   signTx,
   toScriptData,
   txOutValue,
@@ -66,6 +74,7 @@ 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)
@@ -77,7 +86,7 @@ import Hydra.Logging (Tracer, traceWith)
 import Hydra.Options (DirectChainConfig (..), networkId, startChainFrom)
 import Hydra.Tx (HeadId, IsTx (balance), Party, txId)
 import Hydra.Tx.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod), fromNominalDiffTime)
-import Hydra.Tx.Utils (dummyValidatorScript, verificationKeyToOnChainId)
+import Hydra.Tx.Utils (dummyValidatorScript, schnorrkelValidatorScript, verificationKeyToOnChainId)
 import HydraNode (
   HydraClient (..),
   HydraNodeLog,
@@ -381,6 +390,99 @@ singlePartyCommitsFromExternal tracer workDir node hydraScriptsTxId =
  where
   RunningNode{nodeSocket, blockTime} = node
 
+singlePartyUsesSchnorrkelScriptOnL2 ::
+  Tracer IO EndToEndLog ->
+  FilePath ->
+  RunningNode ->
+  [TxId] ->
+  IO ()
+singlePartyUsesSchnorrkelScriptOnL2 tracer workDir node hydraScriptsTxId =
+  ( `finally`
+      do
+        returnFundsToFaucet tracer node Alice
+        returnFundsToFaucet tracer node AliceFunds
+  )
+    $ do
+      refuelIfNeeded tracer node Alice 250_000_000
+      aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] $ UnsafeContestationPeriod 100
+      let hydraNodeId = 1
+      let hydraTracer = contramap FromHydraNode tracer
+      withHydraNode hydraTracer aliceChainConfig workDir hydraNodeId aliceSk [] [1] $ \n1 -> do
+        send n1 $ input "Init" []
+        headId <- waitMatch (10 * blockTime) n1 $ headIsInitializingWith (Set.fromList [alice])
+
+        (walletVk, walletSk) <- keysFor AliceFunds
+
+        -- Create money on L1
+        utxoToCommit <- seedFromFaucet node walletVk 100_000_000 (contramap FromFaucet tracer)
+
+        -- Push it into L2
+        requestCommitTx n1 utxoToCommit
+          <&> signTx walletSk >>= \tx -> do
+            submitTx node tx
+
+        -- Check UTxO is present in L2
+        waitFor hydraTracer (10 * blockTime) [n1] $
+          output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId]
+
+        pparams <- queryProtocolParameters networkId nodeSocket QueryTip
+
+        -- Send the UTxO to a script; in preparation for running the script
+        let serializedScript = dummyValidatorScript
+        -- TODO: Use this one.
+        -- let serializedScript = schnorrkelValidatorScript
+        let scriptAddress = mkScriptAddress networkId serializedScript
+        let scriptOutput =
+              mkTxOutAutoBalance
+                pparams
+                scriptAddress
+                (lovelaceToValue 0) -- Autobalanced
+                (mkTxOutDatumHash ())
+                ReferenceScriptNone
+
+        Right tx <- buildTransaction networkId nodeSocket (mkVkAddress networkId walletVk) utxoToCommit [] [scriptOutput]
+
+        let signedL2tx = signTx walletSk tx
+        send n1 $ input "NewTx" ["transaction" .= signedL2tx]
+
+        waitMatch 10 n1 $ \v -> do
+          guard $ v ^? key "tag" == Just "SnapshotConfirmed"
+          guard $
+            toJSON signedL2tx
+              `elem` (v ^.. key "snapshot" . key "confirmed" . values)
+
+        -- Finally, take money from the script
+        let scriptWitness =
+              BuildTxWith $
+                ScriptWitness scriptWitnessInCtx $
+                  mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
+
+        let txIn = mkTxIn signedL2tx 0
+        let body =
+              defaultTxBodyContent
+                & addTxIns [(txIn, scriptWitness)]
+
+        -- Note: Bug! autobalancing breaks the script business
+        tx <- either (failure . show) pure =<< buildTransactionWithBody networkId nodeSocket (mkVkAddress networkId walletVk) body utxoToCommit
+
+        -- Note: Fix! Use `createAndValidateTransactionBody` instead. This
+        -- means we _can_ construct the tx; but it doesn't submit (because it
+        -- isn't balanced! And it's missing collateral, etc...
+        -- txBody <- either (failure . show) pure (createAndValidateTransactionBody body)
+        -- let tx = makeSignedTransaction [] txBody
+
+        let signedL2tx = signTx walletSk tx
+
+        send n1 $ input "NewTx" ["transaction" .= signedL2tx]
+
+        waitMatch 10 n1 $ \v -> do
+          guard $ v ^? key "tag" == Just "SnapshotConfirmed"
+          guard $
+            toJSON signedL2tx
+              `elem` (v ^.. key "snapshot" . key "confirmed" . values)
+ where
+  RunningNode{networkId, nodeSocket, blockTime} = node
+
 singlePartyCommitsScriptBlueprint ::
   Tracer IO EndToEndLog ->
   FilePath ->

hydra-cluster/test/Test/EndToEndSpec.hs

@@ -67,6 +67,7 @@ import Hydra.Cluster.Scenarios (
   singlePartyCommitsFromExternalTxBlueprint,
   singlePartyCommitsScriptBlueprint,
   singlePartyHeadFullLifeCycle,
+  singlePartyUsesSchnorrkelScriptOnL2,
   testPreventResumeReconfiguredPeer,
   threeNodesNoErrorsOnOpen,
  )
@@ -178,6 +179,11 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
             publishHydraScriptsAs node Faucet
               >>= singlePartyCommitsFromExternal tracer tmpDir node
+      it "can use a schnorrkel script on L2" $ \tracer -> do
+        withClusterTempDir $ \tmpDir -> do
+          withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->
+            publishHydraScriptsAs node Faucet
+              >>= singlePartyUsesSchnorrkelScriptOnL2 tracer tmpDir node
       it "can submit a signed user transaction" $ \tracer -> do
         withClusterTempDir $ \tmpDir -> do
           withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node ->

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

hydra-node/src/Hydra/Ledger/Cardano.hs

@@ -96,6 +96,7 @@ newLedgerEnv protocolParams =
       Ledger.ledgerAccount = Ledger.AccountState mempty mempty
     , Ledger.ledgerPp = protocolParams
     , Ledger.ledgerMempool = False
+    , Ledger.ledgerEpochNo = Nothing
     }
 
 -- * Conversions and utilities

hydra-node/src/Hydra/Network.hs

@@ -31,7 +31,7 @@ import Cardano.Ledger.Orphans ()
 import Data.IP (IP, toIPv4w)
 import Data.Text (pack, unpack)
 import Network.Socket (PortNumber, close)
-import Network.TypedProtocol.Pipelined ()
+-- import Network.TypedProtocol.Pipelined ()
 import Test.QuickCheck (elements, listOf, suchThat)
 import Text.Read (Read (readsPrec))
 import Text.Show (Show (show))