diff --git a/.github/workflows/docker.yaml b/.github/workflows/docker.yaml index a3897885ed4..35741701a37 100644 --- a/.github/workflows/docker.yaml +++ b/.github/workflows/docker.yaml @@ -11,7 +11,7 @@ concurrency: on: push: - branches: [ "master" ] + branches: [ "master", "hydra/sha512"] tags: [ "*.*.*" ] workflow_dispatch: inputs: diff --git a/cabal.project b/cabal.project index 26b4934d711..53dbcf4bdd9 100644 --- a/cabal.project +++ b/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 2025-04-12T10:35:52Z - , cardano-haskell-packages 2025-04-11T16:42:25Z + , hackage.haskell.org 2025-04-22T10:01:33Z + , cardano-haskell-packages 2025-04-22T10:01:33Z packages: hydra-prelude @@ -50,3 +50,13 @@ allow-newer: , ouroboros-network-api:network , ouroboros-network-framework:network , ouroboros-network-protocols:network + +source-repository-package + type: git + location: https://github.com/cardano-scaling/plutus + tag: bdc9b541023906674fe54015638fc9cb2aa4a83b + --sha256: sha256-ibg4jC+YpsYz/753+89VkU3dc3adrjTHrqaBtl2301M= + subdir: + plutus-core + plutus-tx + plutus-tx-plugin diff --git a/flake.lock b/flake.lock index a62e686c553..9faea0459be 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1744391509, - "narHash": "sha256-eUpBbF1XDzpkFWLjGSHqtBzny0zAWe1euTJFj/ZEMLo=", + "lastModified": 1745317107, + "narHash": "sha256-mnctX3WY7zqy9QS4bSdpluCpq4MdSEe8XEOD+opYRhk=", "owner": "IntersectMBO", "repo": "cardano-haskell-packages", - "rev": "bddc33bdbbdcb9035a9ccd87e10a8c88d7c4c992", + "rev": "39c2a07ca686c111f11c81eca826c3f7b78d9ed7", "type": "github" }, "original": { @@ -898,11 +898,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1744417476, - "narHash": "sha256-qpZnGvtHSTNqBIj0VgnAfxt6PueNpaBP/kSjLcyPyTY=", + "lastModified": 1745367943, + "narHash": "sha256-uNeFIEnFGqmbLZk5UXLdWRKsyBvwLb4At3QrnH2HN4Y=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "b0bca298e2679df328930a34cafe87c02f71efbf", + "rev": "f12db0c941e509f8a9334418f0ccb38bfa0efe8c", "type": "github" }, "original": { @@ -914,11 +914,11 @@ "hackage-for-stackage": { "flake": false, "locked": { - "lastModified": 1744417466, - "narHash": "sha256-0u+al6wxDAoMgai7hnbSTWDRbMCNyXMUrcMZGhQWlnU=", + "lastModified": 1745367932, + "narHash": "sha256-3wuje6j3cwmfvqkau5Qvg/ffV8c1OeOTDrCpOJWvbe0=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "61ed6b7a2250796fa67acab39354eacfec2aa886", + "rev": "b808c8edf5031fcc26a22306eafb2e037d2ec094", "type": "github" }, "original": { @@ -1039,11 +1039,11 @@ "stackage": "stackage_2" }, "locked": { - "lastModified": 1744419112, - "narHash": "sha256-c3GgMPwUojakoTDwDImwLm5A1KRU9rvJ0pfFBPCG0u0=", + "lastModified": 1745371029, + "narHash": "sha256-tBO1idwmBNceWutYrGCmD1cqdVWlH+Ys9DLZs1QH9dA=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "abc9bfa73f6346f0457e43b807bba85fe99fd0d1", + "rev": "ac4d74385d1e2848ca011a4fc905fec1e4600346", "type": "github" }, "original": { @@ -2606,11 +2606,11 @@ "stackage_2": { "flake": false, "locked": { - "lastModified": 1744416721, - "narHash": "sha256-mTSilWUuHOThJvLiOVKS/CEwwgZ48RN6mUfJQs05iVQ=", + "lastModified": 1745367162, + "narHash": "sha256-Kt75CsTcck1d38A33LxgY8/n8kiqfs9LINLASXfdHH8=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "e01525c7b01d5ae76333ee4e311230f29731c094", + "rev": "b50895aadf07291c8cd806fc246489a492c1f76f", "type": "github" }, "original": { diff --git a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs index b221eeffc5b..0f487f7ddc2 100644 --- a/hydra-cluster/src/Hydra/Cluster/Scenarios.hs +++ b/hydra-cluster/src/Hydra/Cluster/Scenarios.hs @@ -103,6 +103,7 @@ import Hydra.Cluster.Mithril (MithrilLog) import Hydra.Cluster.Options (Options) import Hydra.Cluster.Util (chainConfigFor, keysFor, modifyConfig, setNetworkId) import Hydra.Contract.Dummy (dummyRewardingScript) +import Hydra.Contract.Sha512Example qualified as Sha512 import Hydra.Ledger.Cardano (mkSimpleTx, mkTransferTx, unsafeBuildTransaction) import Hydra.Ledger.Cardano.Evaluate (maxTxExecutionUnits) import Hydra.Logging (Tracer, traceWith) @@ -759,6 +760,184 @@ singlePartyUsesWithdrawZeroTrick tracer workDir node hydraScriptsTxId = where RunningNode{networkId, nodeSocket, blockTime} = node +singlePartyUsesSha512ScriptOnL2 :: + Tracer IO EndToEndLog -> + FilePath -> + RunningNode -> + [TxId] -> + IO () +singlePartyUsesSha512ScriptOnL2 tracer workDir node hydraScriptsTxId = + ( `finally` + do + returnFundsToFaucet tracer node Alice + returnFundsToFaucet tracer node AliceFunds + ) + $ do + refuelIfNeeded tracer node Alice 250_000_000 + let contestationPeriod = UnsafeContestationPeriod 1 + let depositDeadline = UnsafeDepositDeadline 1 + aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod depositDeadline + 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 + let commitAmount = 100_000_000 + utxoToCommit <- seedFromFaucet node walletVk commitAmount (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 <- getProtocolParameters n1 + + -- Send the UTxO to a script; in preparation for running the script + let serializedScript = Sha512.dummyValidatorScript + let scriptAddress = mkScriptAddress networkId serializedScript + let scriptOutput = + mkTxOutAutoBalance + pparams + scriptAddress + (lovelaceToValue 0) + (mkTxOutDatumHash ()) + ReferenceScriptNone + + Right tx <- buildTransactionWithPParams pparams 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 outAmt = foldMap txOutValue (txOuts' tx) + let body = + defaultTxBodyContent + & addTxIns [(txIn, scriptWitness), (remainder, BuildTxWith $ KeyWitness KeyWitnessForSpending)] + & addTxInsCollateral [remainder] + & addTxOuts [TxOut (mkVkAddress networkId walletVk) outAmt TxOutDatumNone ReferenceScriptNone] + & setTxProtocolParams (BuildTxWith $ Just $ LedgerProtocolParameters pparams) + + -- 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 spendTx' = makeSignedTransaction [] txBody + spendTx = fromLedgerTx $ recomputeIntegrityHash pparams [PlutusV3] (toLedgerTx spendTx') + let signedTx = signTx walletSk spendTx + + send n1 $ input "NewTx" ["transaction" .= signedTx] + + waitMatch 10 n1 $ \v -> do + guard $ v ^? key "tag" == Just "SnapshotConfirmed" + guard $ + toJSON signedTx + `elem` (v ^.. key "snapshot" . key "confirmed" . values) + + -- And check that we can close and fanout the head successfully + 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" + + -- Assert final wallet balance + (balance <$> queryUTxOFor networkId nodeSocket QueryTip walletVk) + `shouldReturn` lovelaceToValue commitAmount + where + RunningNode{networkId, nodeSocket, blockTime} = node + +-- | Open a head and run a script using 'Rewarding' script purpose and a zero +-- lovelace withdrawal. +singlePartyUsesWithdrawZeroTrickUsingSha512Script :: Tracer IO EndToEndLog -> FilePath -> RunningNode -> [TxId] -> IO () +singlePartyUsesWithdrawZeroTrickUsingSha512Script tracer workDir node hydraScriptsTxId = + -- Seed/return fuel + bracket_ (refuelIfNeeded tracer node Alice 250_000_000) (returnFundsToFaucet tracer node Alice) $ do + -- Seed/return funds + (walletVk, walletSk) <- keysFor AliceFunds + bracket + (seedFromFaucet node walletVk 100_000_000 (contramap FromFaucet tracer)) + (\_ -> returnFundsToFaucet tracer node AliceFunds) + $ \utxoToCommit -> do + -- Start hydra-node and open a head + let contestationPeriod = UnsafeContestationPeriod 1 + let depositDeadline = UnsafeDepositDeadline 1 + aliceChainConfig <- chainConfigFor Alice workDir nodeSocket hydraScriptsTxId [] contestationPeriod depositDeadline + 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]) + requestCommitTx n1 utxoToCommit <&> signTx walletSk >>= submitTx node + waitFor hydraTracer (10 * blockTime) [n1] $ + output "HeadIsOpen" ["utxo" .= toJSON utxoToCommit, "headId" .= headId] + + -- Prepare a tx that re-spends everything owned by walletVk + pparams <- getProtocolParameters n1 + let change = mkVkAddress networkId walletVk + Right tx <- buildTransactionWithPParams pparams networkId nodeSocket change utxoToCommit [] [] + + -- Modify the tx to run a script via the withdraw 0 trick + let redeemer = toLedgerData $ toScriptData () + exUnits = toLedgerExUnits maxTxExecutionUnits + rewardAccount = RewardAccount Testnet (ScriptHashObj scriptHash) + scriptHash = hashScript script + script = toLedgerScript @_ @Era Sha512.dummyRewardingScript + let tx' = + fromLedgerTx $ + recomputeIntegrityHash pparams [PlutusV3] $ + toLedgerTx tx + & bodyTxL . collateralInputsTxBodyL .~ Set.map toLedgerTxIn (UTxO.inputSet utxoToCommit) + & bodyTxL . totalCollateralTxBodyL .~ SJust (foldMap (selectLovelace . txOutValue) utxoToCommit) + & bodyTxL . withdrawalsTxBodyL .~ Withdrawals (Map.singleton rewardAccount 0) + & witsTxL . rdmrsTxWitsL .~ Redeemers (Map.singleton (ConwayRewarding $ AsIx 0) (redeemer, exUnits)) + & witsTxL . scriptTxWitsL .~ Map.singleton scriptHash script + + 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 + -- | Compute the integrity hash of a transaction using a list of plutus languages. recomputeIntegrityHash :: (AlonzoEraPParams ppera, AlonzoEraTxWits txera, AlonzoEraTxBody txera, EraTx txera) => @@ -838,7 +1017,7 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId = getSnapshotUTxO n1 `shouldReturn` scriptUTxO <> scriptUTxO' where prepareScriptPayload lovelaceAmt = do - let scriptAddress = mkScriptAddress networkId dummyValidatorScript + let scriptAddress = mkScriptAddress networkId Sha512.dummyValidatorScript let datumHash = mkTxOutDatumHash () (scriptIn, scriptOut) <- createOutputAtAddress node scriptAddress datumHash (lovelaceToValue lovelaceAmt) let scriptUTxO = UTxO.singleton (scriptIn, scriptOut) @@ -846,7 +1025,7 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId = let scriptWitness = BuildTxWith $ ScriptWitness scriptWitnessInCtx $ - mkScriptWitness dummyValidatorScript (mkScriptDatum ()) (toScriptData ()) + mkScriptWitness Sha512.dummyValidatorScript (mkScriptDatum ()) (toScriptData ()) let spendingTx = unsafeBuildTransaction $ defaultTxBodyContent diff --git a/hydra-cluster/test/Test/EndToEndSpec.hs b/hydra-cluster/test/Test/EndToEndSpec.hs index a7b0e97a677..b1fb435b26f 100644 --- a/hydra-cluster/test/Test/EndToEndSpec.hs +++ b/hydra-cluster/test/Test/EndToEndSpec.hs @@ -71,7 +71,9 @@ import Hydra.Cluster.Scenarios ( singlePartyCommitsScriptBlueprint, singlePartyHeadFullLifeCycle, singlePartyUsesScriptOnL2, + singlePartyUsesSha512ScriptOnL2, singlePartyUsesWithdrawZeroTrick, + singlePartyUsesWithdrawZeroTrickUsingSha512Script, threeNodesNoErrorsOnOpen, threeNodesWithMirrorParty, ) @@ -222,6 +224,16 @@ spec = around (showLogsOnFailure "EndToEndSpec") $ do withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> publishHydraScriptsAs node Faucet >>= singlePartyUsesWithdrawZeroTrick tracer tmpDir node + it "can spend from a script using sha512 on L2" $ \tracer -> do + withClusterTempDir $ \tmpDir -> do + withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> + publishHydraScriptsAs node Faucet + >>= singlePartyUsesSha512ScriptOnL2 tracer tmpDir node + it "can use withdraw zero on L2 using sha512 script" $ \tracer -> do + withClusterTempDir $ \tmpDir -> do + withCardanoNodeDevnet (contramap FromCardanoNode tracer) tmpDir $ \node -> + publishHydraScriptsAs node Faucet + >>= singlePartyUsesWithdrawZeroTrickUsingSha512Script 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-plutus/hydra-plutus.cabal b/hydra-plutus/hydra-plutus.cabal index 4ef1a03287a..0050c88642f 100644 --- a/hydra-plutus/hydra-plutus.cabal +++ b/hydra-plutus/hydra-plutus.cabal @@ -58,6 +58,7 @@ library Hydra.Contract.Initial Hydra.Contract.InitialError Hydra.Contract.MintAction + Hydra.Contract.Sha512Example Hydra.Contract.Util Hydra.Data.ContestationPeriod Hydra.Data.Party diff --git a/hydra-plutus/src/Hydra/Contract/Sha512Example.hs b/hydra-plutus/src/Hydra/Contract/Sha512Example.hs new file mode 100644 index 00000000000..0ec30dbe4d8 --- /dev/null +++ b/hydra-plutus/src/Hydra/Contract/Sha512Example.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin PlutusTx.Plugin #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:defer-errors #-} +{-# OPTIONS_GHC -fplugin-opt PlutusTx.Plugin:target-version=1.1.0 #-} + +-- | Simple asserting validators that are primarily useful for testing. +module Hydra.Contract.Sha512Example where + +import Hydra.Prelude + +import Hydra.Cardano.Api (PlutusScript, pattern PlutusScriptSerialised) +import PlutusLedgerApi.V3 (ScriptContext (..), ScriptInfo (..), serialiseCompiledCode, unsafeFromBuiltinData) +import PlutusTx (compile) +import PlutusTx.Builtins (sha3_512) +import PlutusTx.Prelude (Eq (..), check) + +trivialCheck :: Bool +trivialCheck = + let x = sha3_512 "aaaaaaaa" + in x PlutusTx.Prelude.== x + +dummyValidatorScript :: PlutusScript +dummyValidatorScript = + PlutusScriptSerialised $ + serialiseCompiledCode + $$( PlutusTx.compile + [|| + \ctx -> + check $ case unsafeFromBuiltinData ctx of + ScriptContext{scriptContextScriptInfo = SpendingScript{}} -> trivialCheck + _ -> False + ||] + ) + +dummyRewardingScript :: PlutusScript +dummyRewardingScript = + PlutusScriptSerialised $ + serialiseCompiledCode + $$( PlutusTx.compile + [|| + \ctx -> + check $ case unsafeFromBuiltinData ctx of + ScriptContext{scriptContextScriptInfo = CertifyingScript{}} -> trivialCheck + ScriptContext{scriptContextScriptInfo = RewardingScript{}} -> trivialCheck + _ -> False + ||] + )