hydra/sha512

.github/workflows/docker.yaml

@@ -11,7 +11,7 @@ concurrency:
 
 on:
   push:
-    branches: [ "master" ]
+    branches: [ "master", "hydra/sha512"]
     tags: [ "*.*.*" ]
   workflow_dispatch:
     inputs:

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

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,15 +1017,15 @@ 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)
 
     let scriptWitness =
           BuildTxWith $
             ScriptWitness scriptWitnessInCtx $
-              mkScriptWitness dummyValidatorScript (mkScriptDatum ()) (toScriptData ())
+              mkScriptWitness Sha512.dummyValidatorScript (mkScriptDatum ()) (toScriptData ())
     let spendingTx =
           unsafeBuildTransaction $
             defaultTxBodyContent

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 ->

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