Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Refactor: Use PlutusScript instead of SerialisedScript where possible #1779

Merged
merged 3 commits into from
Jan 9, 2025
Merged

Refactor: Use PlutusScript instead of SerialisedScript where possible #1779

Show file tree
Hide file tree
Changes from 2 commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
565c0b3
Use PlutusScript instead of SerialisedScript where possible
ch1bo Jan 8, 2025
c6f1914
Recompute commit validator hash instead of loading from plutus.json
ch1bo Jan 8, 2025
f7e2bbe
Remove unused plutus-tx helpers
ch1bo Jan 9, 2025
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 2 additions & 15 deletions hydra-cardano-api/src/Hydra/Cardano/Api/ReferenceScript.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,22 +2,9 @@ module Hydra.Cardano.Api.ReferenceScript where

import Hydra.Cardano.Api.Prelude

import PlutusLedgerApi.V3 qualified as Plutus

-- | Construct a 'ReferenceScript' from any given Plutus script.
--
-- NOTE: The script is treated as a 'PlutusScriptV3'
mkScriptRef :: Plutus.SerialisedScript -> ReferenceScript Era
mkScriptRef :: IsPlutusScriptLanguage lang => PlutusScript lang -> ReferenceScript Era
mkScriptRef =
ReferenceScript babbageBasedEra
. toScriptInAnyLang
. PlutusScript PlutusScriptV3
. PlutusScriptSerialised

-- | Construct a PlutusV3 'ReferenceScript' from any given Plutus script.
mkScriptRefV3 :: Plutus.SerialisedScript -> ReferenceScript Era
mkScriptRefV3 =
ReferenceScript babbageBasedEra
. toScriptInAnyLang
. PlutusScript PlutusScriptV3
. PlutusScriptSerialised
. PlutusScript plutusScriptVersion
7 changes: 2 additions & 5 deletions hydra-cluster/src/Hydra/Cluster/Scenarios.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -61,7 +61,6 @@ import Hydra.Cardano.Api (
utxoFromTx,
writeFileTextEnvelope,
pattern BuildTxWith,
pattern PlutusScriptSerialised,
pattern ReferenceScriptNone,
pattern ScriptWitness,
pattern TxOut,
Expand Down Expand Up @@ -446,17 +445,15 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId =
output "GetUTxOResponse" ["headId" .= headId, "utxo" .= (scriptUTxO <> scriptUTxO')]
where
prepareScriptPayload lovelaceAmt = do
let script = dummyValidatorScript
let serializedScript = PlutusScriptSerialised script
let scriptAddress = mkScriptAddress networkId serializedScript
let scriptAddress = mkScriptAddress networkId dummyValidatorScript
let datumHash = mkTxOutDatumHash ()
(scriptIn, scriptOut) <- createOutputAtAddress node scriptAddress datumHash (lovelaceToValue lovelaceAmt)
let scriptUTxO = UTxO.singleton (scriptIn, scriptOut)

let scriptWitness =
BuildTxWith $
ScriptWitness scriptWitnessInCtx $
mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
mkScriptWitness dummyValidatorScript (mkScriptDatum ()) (toScriptData ())
let spendingTx =
unsafeBuildTransaction $
defaultTxBodyContent
Expand Down
47 changes: 12 additions & 35 deletions hydra-node/src/Hydra/Chain/Direct/State.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,6 @@ import Hydra.Cardano.Api (
txOutValue,
txSpendingUTxO,
pattern ByronAddressInEra,
pattern PlutusScriptSerialised,
pattern ShelleyAddressInEra,
pattern TxIn,
pattern TxOut,
Expand Down Expand Up @@ -394,23 +393,17 @@ abort ::
abort ctx seedTxIn spendableUTxO committedUTxO = do
headUTxO <-
maybe (Left CannotFindHeadOutputToAbort) pure $
UTxO.find (isScriptTxOut headScript) utxoOfThisHead'
UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead'

abortTx committedUTxO scriptRegistry ownVerificationKey headUTxO headTokenScript initials commits
where
utxoOfThisHead' = utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO

initials =
UTxO.toMap $ UTxO.filter (isScriptTxOut initialScript) utxoOfThisHead'
UTxO.toMap $ UTxO.filter (isScriptTxOut initialValidatorScript) utxoOfThisHead'

commits =
UTxO.toMap $ UTxO.filter (isScriptTxOut commitScript) utxoOfThisHead'

commitScript = PlutusScriptSerialised commitValidatorScript

headScript = PlutusScriptSerialised Head.validatorScript

initialScript = PlutusScriptSerialised initialValidatorScript
UTxO.toMap $ UTxO.filter (isScriptTxOut commitValidatorScript) utxoOfThisHead'

headTokenScript = mkHeadTokenScript seedTxIn

Expand All @@ -437,15 +430,11 @@ collect ::
collect ctx headId headParameters utxoToCollect spendableUTxO = do
pid <- headIdToPolicyId headId ?> InvalidHeadIdInCollect{headId}
let utxoOfThisHead' = utxoOfThisHead pid spendableUTxO
headUTxO <- UTxO.find (isScriptTxOut headScript) utxoOfThisHead' ?> CannotFindHeadOutputToCollect
let commits = UTxO.toMap $ UTxO.filter (isScriptTxOut commitScript) utxoOfThisHead'
headUTxO <- UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead' ?> CannotFindHeadOutputToCollect
let commits = UTxO.toMap $ UTxO.filter (isScriptTxOut commitValidatorScript) utxoOfThisHead'
pure $
collectComTx networkId scriptRegistry ownVerificationKey headId headParameters headUTxO commits utxoToCollect
where
headScript = PlutusScriptSerialised Head.validatorScript

commitScript = PlutusScriptSerialised commitValidatorScript

ChainContext{networkId, ownVerificationKey, scriptRegistry} = ctx

data IncrementTxError
Expand Down Expand Up @@ -473,11 +462,11 @@ increment ::
increment ctx spendableUTxO headId headParameters incrementingSnapshot depositTxId upperValiditySlot = do
pid <- headIdToPolicyId headId ?> InvalidHeadIdInIncrement{headId}
let utxoOfThisHead' = utxoOfThisHead pid spendableUTxO
headUTxO <- UTxO.find (isScriptTxOut headScript) utxoOfThisHead' ?> CannotFindHeadOutputInIncrement
headUTxO <- UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead' ?> CannotFindHeadOutputInIncrement
(depositedIn, depositedOut) <-
UTxO.findBy
( \(TxIn txid _, txout) ->
isScriptTxOut depositScript txout && txid == depositTxId
isScriptTxOut depositValidatorScript txout && txid == depositTxId
)
spendableUTxO
?> CannotFindDepositOutputInIncrement{depositTxId}
Expand All @@ -489,9 +478,6 @@ increment ctx spendableUTxO headId headParameters incrementingSnapshot depositTx
Left SnapshotIncrementUTxOIsNull
| otherwise -> Right $ incrementTx scriptRegistry ownVerificationKey headId headParameters headUTxO sn (UTxO.singleton (depositedIn, depositedOut)) upperValiditySlot sigs
where
headScript = PlutusScriptSerialised Head.validatorScript
depositScript = PlutusScriptSerialised depositValidatorScript

Snapshot{utxoToCommit} = sn

(sn, sigs) =
Expand Down Expand Up @@ -523,14 +509,12 @@ decrement ::
decrement ctx spendableUTxO headId headParameters decrementingSnapshot = do
pid <- headIdToPolicyId headId ?> InvalidHeadIdInDecrement{headId}
let utxoOfThisHead' = utxoOfThisHead pid spendableUTxO
headUTxO@(_, headOut) <- UTxO.find (isScriptTxOut headScript) utxoOfThisHead' ?> CannotFindHeadOutputInDecrement
headUTxO@(_, headOut) <- UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead' ?> CannotFindHeadOutputInDecrement
let balance = txOutValue headOut <> negateValue decommitValue
when (isNegative balance) $
Left DecrementValueNegative
Right $ decrementTx scriptRegistry ownVerificationKey headId headParameters headUTxO sn sigs
where
headScript = PlutusScriptSerialised Head.validatorScript

decommitValue = foldMap txOutValue $ fromMaybe mempty $ utxoToDecommit sn

isNegative = any ((< 0) . snd) . IsList.toList
Expand Down Expand Up @@ -572,7 +556,7 @@ recover ctx headId depositedTxId spendableUTxO lowerValiditySlot = do
(_, depositedOut) <-
UTxO.findBy
( \(TxIn txid _, txout) ->
isScriptTxOut depositScript txout && txid == depositedTxId
isScriptTxOut depositValidatorScript txout && txid == depositedTxId
)
spendableUTxO
?> CannotFindDepositOutputToRecover{depositTxId = depositedTxId}
Expand All @@ -583,7 +567,6 @@ recover ctx headId depositedTxId spendableUTxO lowerValiditySlot = do
then Left InvalidHeadIdInRecover{headId}
else Right $ recoverTx depositedTxId deposited lowerValiditySlot
where
depositScript = PlutusScriptSerialised depositValidatorScript
ChainContext{networkId} = ctx

-- | Construct a close transaction spending the head output in given 'UTxO',
Expand Down Expand Up @@ -612,7 +595,7 @@ close ::
close ctx spendableUTxO headId HeadParameters{parties, contestationPeriod} openVersion confirmedSnapshot startSlotNo pointInTime = do
pid <- headIdToPolicyId headId ?> InvalidHeadIdInClose{headId}
headUTxO <-
UTxO.find (isScriptTxOut headScript) (utxoOfThisHead pid spendableUTxO)
UTxO.find (isScriptTxOut Head.validatorScript) (utxoOfThisHead pid spendableUTxO)
?> CannotFindHeadOutputToClose
let openThreadOutput =
OpenThreadOutput
Expand All @@ -626,8 +609,6 @@ close ctx spendableUTxO headId HeadParameters{parties, contestationPeriod} openV
where
Snapshot{utxoToCommit, utxoToDecommit} = getSnapshot confirmedSnapshot

headScript = PlutusScriptSerialised Head.validatorScript

ChainContext{ownVerificationKey, scriptRegistry} = ctx

data ContestTxError
Expand Down Expand Up @@ -662,7 +643,7 @@ contest ::
contest ctx spendableUTxO headId contestationPeriod openVersion contestingSnapshot pointInTime = do
pid <- headIdToPolicyId headId ?> InvalidHeadIdInContest{headId}
headUTxO <-
UTxO.find (isScriptTxOut headScript) (utxoOfThisHead pid spendableUTxO)
UTxO.find (isScriptTxOut Head.validatorScript) (utxoOfThisHead pid spendableUTxO)
?> CannotFindHeadOutputToContest
closedThreadOutput <- checkHeadDatum headUTxO
incrementalAction <- setIncrementalActionMaybe utxoToCommit utxoToDecommit ?> BothCommitAndDecommitInContest
Expand Down Expand Up @@ -698,8 +679,6 @@ contest ctx spendableUTxO headId contestationPeriod openVersion contestingSnapsh

ChainContext{ownVerificationKey, scriptRegistry} = ctx

headScript = PlutusScriptSerialised Head.validatorScript

data FanoutTxError
= CannotFindHeadOutputToFanout
| MissingHeadDatumInFanout
Expand Down Expand Up @@ -727,7 +706,7 @@ fanout ::
Either FanoutTxError Tx
fanout ctx spendableUTxO seedTxIn utxo utxoToCommit utxoToDecommit deadlineSlotNo = do
headUTxO <-
UTxO.find (isScriptTxOut headScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
UTxO.find (isScriptTxOut Head.validatorScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
?> CannotFindHeadOutputToFanout
closedThreadUTxO <- checkHeadDatum headUTxO
_ <- setIncrementalActionMaybe utxoToCommit utxoToDecommit ?> BothCommitAndDecommitInFanout
Expand All @@ -737,8 +716,6 @@ fanout ctx spendableUTxO seedTxIn utxo utxoToCommit utxoToDecommit deadlineSlotN

ChainContext{scriptRegistry} = ctx

headScript = PlutusScriptSerialised Head.validatorScript

checkHeadDatum headUTxO@(_, headOutput) = do
headDatum <-
txOutScriptData (toTxContext headOutput) ?> MissingHeadDatumInFanout
Expand Down
Loading
Loading