diff --git a/cabal.project b/cabal.project index 818f82bf657..fff10556092 100644 --- a/cabal.project +++ b/cabal.project @@ -45,3 +45,25 @@ program-options constraints: quickcheck-instances==0.3.31, data-default==0.7.1.3 + +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: b117b4460b5b5da2a599db8693b18dacd811bb91 + --sha256: sha256-GUPwIwbTOy/eTBhjOwrR+XwJsML/jmBlAf1qU6zWvd8= + subdir: + prettyprinter-configurable + plutus-core + plutus-ledger-api + plutus-tx-plugin + plutus-tx + +allow-newer: cardano-crypto-class diff --git a/hydra-cluster/hydra-cluster.cabal b/hydra-cluster/hydra-cluster.cabal index 770ac27c1fd..f529c1abe4f 100644 --- a/hydra-cluster/hydra-cluster.cabal +++ b/hydra-cluster/hydra-cluster.cabal @@ -85,8 +85,11 @@ library build-depends: , aeson , async - , base >=4.7 && <5 + , base >=4.7 && <5 , bytestring + , cardano-ledger-alonzo + , cardano-ledger-api + , cardano-ledger-core , cardano-slotting , containers , contra-tracer diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index 8aaba13daf3..f82d8a64cc3 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -7,10 +7,19 @@ import Hydra.Prelude import Test.Hydra.Prelude import Cardano.Api.UTxO qualified as UTxO +import Cardano.Ledger.Alonzo.Tx (hashScriptIntegrity) +import Cardano.Ledger.Api.PParams (AlonzoEraPParams, PParams, getLanguageView) +import Cardano.Ledger.Api.Tx (EraTx, bodyTxL, datsTxWitsL, rdmrsTxWitsL, witsTxL) +import Cardano.Ledger.Api.Tx qualified as Ledger +import Cardano.Ledger.Api.Tx.Body (AlonzoEraTxBody, scriptIntegrityHashTxBodyL) +import Cardano.Ledger.Api.Tx.Wits (AlonzoEraTxWits) +import Cardano.Ledger.Plutus.Language (Language (PlutusV3)) import CardanoClient ( QueryPoint (QueryTip), RunningNode (..), buildTransaction, + buildTransactionWithBody, + queryProtocolParameters, queryTip, queryUTxOFor, submitTx, @@ -18,7 +27,7 @@ import CardanoClient ( ) import CardanoNode (NodeLog) import Control.Concurrent.Async (mapConcurrently_) -import Control.Lens ((^..), (^?)) +import Control.Lens ((.~), (^.), (^..), (^?)) import Data.Aeson (Value, object, (.=)) import Data.Aeson qualified as Aeson import Data.Aeson.Lens (key, values, _JSON, _String) @@ -35,14 +44,21 @@ import Hydra.API.HTTPServer ( ) import Hydra.Cardano.Api ( Coin (..), + ExecutionUnits (..), File (File), Key (SigningKey), + KeyWitnessInCtx (KeyWitnessForSpending), PaymentKey, + PlutusScriptOrReferenceInput (PScript), Tx, TxId, UTxO, addTxIns, + addTxInsCollateral, + addTxOuts, + createAndValidateTransactionBody, defaultTxBodyContent, + fromLedgerTx, getTxBody, getTxId, getVerificationKey, @@ -51,21 +67,33 @@ import Hydra.Cardano.Api ( mkScriptAddress, mkScriptDatum, mkScriptWitness, + mkTxIn, + mkTxOutAutoBalance, mkTxOutDatumHash, mkVkAddress, + negateValue, + plutusScriptVersion, + scriptLanguageInEra, scriptWitnessInCtx, selectLovelace, + setTxFee, signTx, + toLedgerTx, toScriptData, txOutValue, + txOuts', utxoFromTx, writeFileTextEnvelope, pattern BuildTxWith, + pattern KeyWitness, + pattern PlutusScriptWitness, pattern ReferenceScriptNone, pattern ScriptWitness, + pattern TxFeeExplicit, 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) @@ -73,11 +101,12 @@ import Hydra.Cluster.Mithril (MithrilLog) import Hydra.Cluster.Options (Options) import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId) import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx, unsafeBuildTransaction) +import Hydra.Ledger.Cardano.Evaluate (maxTxExecutionUnits) 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 +410,131 @@ 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 = 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) + + -- Now,, spend the money from the script + let scriptWitness = + BuildTxWith $ + ScriptWitness scriptWitnessInCtx $ + PlutusScriptWitness + serializedScript + (mkScriptDatum ()) + (toScriptData ()) + maxTxExecutionUnits + + let txIn = mkTxIn signedL2tx 0 + let remainder = mkTxIn signedL2tx 1 + + let fee = 8_000_000 + let outAmt = foldMap txOutValue (txOuts' tx) <> negateValue (lovelaceToValue fee) + let body = + defaultTxBodyContent + & addTxIns [(txIn, scriptWitness), (remainder, BuildTxWith $ KeyWitness KeyWitnessForSpending)] + & addTxInsCollateral [remainder] + & setTxFee (TxFeeExplicit fee) + & addTxOuts [TxOut (mkVkAddress networkId walletVk) outAmt TxOutDatumNone ReferenceScriptNone] + + -- TODO: Instead of using `createAndValidateTransactionBody`, we + -- should be able to just construct the Tx with autobalancing via + -- `buildTransactionWithBody`. Unfortunately this is broken in the + -- version of cardano-api that we presently use; in a future upgrade + -- of that library we can try again. + -- tx' <- either (failure . show) pure =<< buildTransactionWithBody networkId nodeSocket (mkVkAddress networkId walletVk) body utxoToCommit + txBody <- either (failure . show) pure (createAndValidateTransactionBody body) + + let tx = makeSignedTransaction [] txBody + tx' = fromLedgerTx $ recomputeIntegrityHash pparams [PlutusV3] (toLedgerTx tx) + 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) + + -- And check that we can close the head successfully + send n1 $ input "Close" [] + void $ + waitMatch (10 * blockTime) n1 $ \v -> do + guard $ v ^? key "tag" == Just "HeadIsClosed" + where + RunningNode{networkId, nodeSocket, blockTime} = node + +-- | Compute the integrity hash of a transaction using a list of plutus languages. +recomputeIntegrityHash :: + (AlonzoEraPParams ppera, AlonzoEraTxWits txera, AlonzoEraTxBody txera, EraTx txera) => + PParams ppera -> + [Language] -> + Ledger.Tx txera -> + Ledger.Tx txera +recomputeIntegrityHash pp languages tx = do + tx & bodyTxL . scriptIntegrityHashTxBodyL .~ integrityHash + where + integrityHash = + hashScriptIntegrity + (Set.fromList $ getLanguageView pp <$> languages) + (tx ^. witsTxL . rdmrsTxWitsL) + (tx ^. witsTxL . datsTxWitsL) + singlePartyCommitsScriptBlueprint :: Tracer IO EndToEndLog -> FilePath -> diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index 23cff102141..0dc8f808307 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/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 -> 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 diff --git a/hydra-plutus/src/Hydra/Contract/Dummy.hs b/hydra-plutus/src/Hydra/Contract/Dummy.hs index 2f200252ae0..ac7a0134fb4 100644 --- a/hydra-plutus/src/Hydra/Contract/Dummy.hs +++ b/hydra-plutus/src/Hydra/Contract/Dummy.hs @@ -5,12 +5,28 @@ module Hydra.Contract.Dummy where -import Hydra.Prelude +import Hydra.Cardano.Api (PlutusScriptVersion (PlutusScriptV3)) +import Hydra.Plutus.Extras (ValidatorType, scriptValidatorHash, wrapValidator) +import Hydra.Prelude hiding ((==)) import Hydra.Cardano.Api (PlutusScript, pattern PlutusScriptSerialised) import Hydra.Plutus.Extras (ValidatorType, wrapValidator) import PlutusLedgerApi.V3 (BuiltinData, ScriptContext, serialiseCompiledCode, toOpaque) import PlutusTx (CompiledCode, compile) +import PlutusTx.Builtins (schnorrkel) +import PlutusTx.Prelude (Eq (..)) + +schnorrkelValidator :: BuiltinData -> BuiltinData -> ScriptContext -> Bool +schnorrkelValidator _ _ _ = "" == schnorrkel "" + +schnorrkelValidatorScript :: PlutusScript +schnorrkelValidatorScript = PlutusScriptSerialised $ serialiseCompiledCode compiledDummyValidator + +compiledSchnorrkelValidator :: CompiledCode ValidatorType +compiledSchnorrkelValidator = + $$(PlutusTx.compile [||fakeWrap schnorrkelValidator||]) + where + wrap = wrapValidator @BuiltinData @BuiltinData dummyValidator :: BuiltinData -> BuiltinData -> ScriptContext -> Bool dummyValidator _ _ _ = True diff --git a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs index b9f089771d9..19639e85ccd 100644 --- a/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs +++ b/hydra-tx/src/Hydra/Ledger/Cardano/Builder.hs @@ -38,6 +38,10 @@ addTxInsSpending :: [TxIn] -> TxBodyContent BuildTx -> TxBodyContent BuildTx addTxInsSpending ins = addTxIns ((,BuildTxWith $ KeyWitness KeyWitnessForSpending) <$> ins) +changePParams :: PParams (ShelleyLedgerEra Era) -> TxBodyContent BuildTx -> TxBodyContent BuildTx +changePParams pparams tx = + tx{txProtocolParams = BuildTxWith $ Just $ LedgerProtocolParameters pparams} + -- | Mint tokens with given plutus minting script and redeemer. mintTokens :: ToScriptData redeemer => PlutusScript -> redeemer -> [(AssetName, Quantity)] -> TxBodyContent BuildTx -> TxBodyContent BuildTx mintTokens script redeemer assets = addTxMintValue newTokens diff --git a/hydra-tx/src/Hydra/Tx/Utils.hs b/hydra-tx/src/Hydra/Tx/Utils.hs index bd53b730042..282a828e5c6 100644 --- a/hydra-tx/src/Hydra/Tx/Utils.hs +++ b/hydra-tx/src/Hydra/Tx/Utils.hs @@ -1,6 +1,7 @@ module Hydra.Tx.Utils ( module Hydra.Tx.Utils, dummyValidatorScript, + schnorrkelValidatorScript, ) where import Hydra.Cardano.Api @@ -13,7 +14,7 @@ import Control.Lens ((.~), (^.)) import Data.Map.Strict qualified as Map import Data.Maybe.Strict (StrictMaybe (..)) import GHC.IsList (IsList (..)) -import Hydra.Contract.Dummy (dummyValidatorScript) +import Hydra.Contract.Dummy (dummyValidatorScript, schnorrkelValidatorScript) import Hydra.Contract.Util (hydraHeadV1) import Hydra.Tx.OnChainId (OnChainId (..)) import Ouroboros.Consensus.Shelley.Eras qualified as Ledger