Skip to content

Commit 565c0b3

Browse files
ch1boch1bo
committed
Use PlutusScript instead of SerialisedScript where possible
The PlutusScript type is more specific as it carries the plutus version (fixed to V3 in hydra-cardano-api).
1 parent dd7634b commit 565c0b3

File tree

32 files changed

+136
-464
lines changed

32 files changed

+136
-464
lines changed

‎hydra-cardano-api/src/Hydra/Cardano/Api/ReferenceScript.hs

+2-15
Original file line numberDiff line numberDiff line change
@@ -2,22 +2,9 @@ module Hydra.Cardano.Api.ReferenceScript where
22

33
import Hydra.Cardano.Api.Prelude
44

5-
import PlutusLedgerApi.V3 qualified as Plutus
6-
75
-- | Construct a 'ReferenceScript' from any given Plutus script.
8-
--
9-
-- NOTE: The script is treated as a 'PlutusScriptV3'
10-
mkScriptRef :: Plutus.SerialisedScript -> ReferenceScript Era
6+
mkScriptRef :: IsPlutusScriptLanguage lang => PlutusScript lang -> ReferenceScript Era
117
mkScriptRef =
128
ReferenceScript babbageBasedEra
139
. toScriptInAnyLang
14-
. PlutusScript PlutusScriptV3
15-
. PlutusScriptSerialised
16-
17-
-- | Construct a PlutusV3 'ReferenceScript' from any given Plutus script.
18-
mkScriptRefV3 :: Plutus.SerialisedScript -> ReferenceScript Era
19-
mkScriptRefV3 =
20-
ReferenceScript babbageBasedEra
21-
. toScriptInAnyLang
22-
. PlutusScript PlutusScriptV3
23-
. PlutusScriptSerialised
10+
. PlutusScript plutusScriptVersion

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

+2-5
Original file line numberDiff line numberDiff line change
@@ -61,7 +61,6 @@ import Hydra.Cardano.Api (
6161
utxoFromTx,
6262
writeFileTextEnvelope,
6363
pattern BuildTxWith,
64-
pattern PlutusScriptSerialised,
6564
pattern ReferenceScriptNone,
6665
pattern ScriptWitness,
6766
pattern TxOut,
@@ -446,17 +445,15 @@ singlePartyCommitsScriptBlueprint tracer workDir node hydraScriptsTxId =
446445
output "GetUTxOResponse" ["headId" .= headId, "utxo" .= (scriptUTxO <> scriptUTxO')]
447446
where
448447
prepareScriptPayload lovelaceAmt = do
449-
let script = dummyValidatorScript
450-
let serializedScript = PlutusScriptSerialised script
451-
let scriptAddress = mkScriptAddress networkId serializedScript
448+
let scriptAddress = mkScriptAddress networkId dummyValidatorScript
452449
let datumHash = mkTxOutDatumHash ()
453450
(scriptIn, scriptOut) <- createOutputAtAddress node scriptAddress datumHash (lovelaceToValue lovelaceAmt)
454451
let scriptUTxO = UTxO.singleton (scriptIn, scriptOut)
455452

456453
let scriptWitness =
457454
BuildTxWith $
458455
ScriptWitness scriptWitnessInCtx $
459-
mkScriptWitness serializedScript (mkScriptDatum ()) (toScriptData ())
456+
mkScriptWitness dummyValidatorScript (mkScriptDatum ()) (toScriptData ())
460457
let spendingTx =
461458
unsafeBuildTransaction $
462459
defaultTxBodyContent

‎hydra-node/src/Hydra/Chain/Direct/State.hs

+12-35
Original file line numberDiff line numberDiff line change
@@ -50,7 +50,6 @@ import Hydra.Cardano.Api (
5050
txOutValue,
5151
txSpendingUTxO,
5252
pattern ByronAddressInEra,
53-
pattern PlutusScriptSerialised,
5453
pattern ShelleyAddressInEra,
5554
pattern TxIn,
5655
pattern TxOut,
@@ -394,23 +393,17 @@ abort ::
394393
abort ctx seedTxIn spendableUTxO committedUTxO = do
395394
headUTxO <-
396395
maybe (Left CannotFindHeadOutputToAbort) pure $
397-
UTxO.find (isScriptTxOut headScript) utxoOfThisHead'
396+
UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead'
398397

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

403402
initials =
404-
UTxO.toMap $ UTxO.filter (isScriptTxOut initialScript) utxoOfThisHead'
403+
UTxO.toMap $ UTxO.filter (isScriptTxOut initialValidatorScript) utxoOfThisHead'
405404

406405
commits =
407-
UTxO.toMap $ UTxO.filter (isScriptTxOut commitScript) utxoOfThisHead'
408-
409-
commitScript = PlutusScriptSerialised commitValidatorScript
410-
411-
headScript = PlutusScriptSerialised Head.validatorScript
412-
413-
initialScript = PlutusScriptSerialised initialValidatorScript
406+
UTxO.toMap $ UTxO.filter (isScriptTxOut commitValidatorScript) utxoOfThisHead'
414407

415408
headTokenScript = mkHeadTokenScript seedTxIn
416409

@@ -437,15 +430,11 @@ collect ::
437430
collect ctx headId headParameters utxoToCollect spendableUTxO = do
438431
pid <- headIdToPolicyId headId ?> InvalidHeadIdInCollect{headId}
439432
let utxoOfThisHead' = utxoOfThisHead pid spendableUTxO
440-
headUTxO <- UTxO.find (isScriptTxOut headScript) utxoOfThisHead' ?> CannotFindHeadOutputToCollect
441-
let commits = UTxO.toMap $ UTxO.filter (isScriptTxOut commitScript) utxoOfThisHead'
433+
headUTxO <- UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead' ?> CannotFindHeadOutputToCollect
434+
let commits = UTxO.toMap $ UTxO.filter (isScriptTxOut commitValidatorScript) utxoOfThisHead'
442435
pure $
443436
collectComTx networkId scriptRegistry ownVerificationKey headId headParameters headUTxO commits utxoToCollect
444437
where
445-
headScript = PlutusScriptSerialised Head.validatorScript
446-
447-
commitScript = PlutusScriptSerialised commitValidatorScript
448-
449438
ChainContext{networkId, ownVerificationKey, scriptRegistry} = ctx
450439

451440
data IncrementTxError
@@ -473,11 +462,11 @@ increment ::
473462
increment ctx spendableUTxO headId headParameters incrementingSnapshot depositTxId upperValiditySlot = do
474463
pid <- headIdToPolicyId headId ?> InvalidHeadIdInIncrement{headId}
475464
let utxoOfThisHead' = utxoOfThisHead pid spendableUTxO
476-
headUTxO <- UTxO.find (isScriptTxOut headScript) utxoOfThisHead' ?> CannotFindHeadOutputInIncrement
465+
headUTxO <- UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead' ?> CannotFindHeadOutputInIncrement
477466
(depositedIn, depositedOut) <-
478467
UTxO.findBy
479468
( \(TxIn txid _, txout) ->
480-
isScriptTxOut depositScript txout && txid == depositTxId
469+
isScriptTxOut depositValidatorScript txout && txid == depositTxId
481470
)
482471
spendableUTxO
483472
?> CannotFindDepositOutputInIncrement{depositTxId}
@@ -489,9 +478,6 @@ increment ctx spendableUTxO headId headParameters incrementingSnapshot depositTx
489478
Left SnapshotIncrementUTxOIsNull
490479
| otherwise -> Right $ incrementTx scriptRegistry ownVerificationKey headId headParameters headUTxO sn (UTxO.singleton (depositedIn, depositedOut)) upperValiditySlot sigs
491480
where
492-
headScript = PlutusScriptSerialised Head.validatorScript
493-
depositScript = PlutusScriptSerialised depositValidatorScript
494-
495481
Snapshot{utxoToCommit} = sn
496482

497483
(sn, sigs) =
@@ -523,14 +509,12 @@ decrement ::
523509
decrement ctx spendableUTxO headId headParameters decrementingSnapshot = do
524510
pid <- headIdToPolicyId headId ?> InvalidHeadIdInDecrement{headId}
525511
let utxoOfThisHead' = utxoOfThisHead pid spendableUTxO
526-
headUTxO@(_, headOut) <- UTxO.find (isScriptTxOut headScript) utxoOfThisHead' ?> CannotFindHeadOutputInDecrement
512+
headUTxO@(_, headOut) <- UTxO.find (isScriptTxOut Head.validatorScript) utxoOfThisHead' ?> CannotFindHeadOutputInDecrement
527513
let balance = txOutValue headOut <> negateValue decommitValue
528514
when (isNegative balance) $
529515
Left DecrementValueNegative
530516
Right $ decrementTx scriptRegistry ownVerificationKey headId headParameters headUTxO sn sigs
531517
where
532-
headScript = PlutusScriptSerialised Head.validatorScript
533-
534518
decommitValue = foldMap txOutValue $ fromMaybe mempty $ utxoToDecommit sn
535519

536520
isNegative = any ((< 0) . snd) . IsList.toList
@@ -572,7 +556,7 @@ recover ctx headId depositedTxId spendableUTxO lowerValiditySlot = do
572556
(_, depositedOut) <-
573557
UTxO.findBy
574558
( \(TxIn txid _, txout) ->
575-
isScriptTxOut depositScript txout && txid == depositedTxId
559+
isScriptTxOut depositValidatorScript txout && txid == depositedTxId
576560
)
577561
spendableUTxO
578562
?> CannotFindDepositOutputToRecover{depositTxId = depositedTxId}
@@ -583,7 +567,6 @@ recover ctx headId depositedTxId spendableUTxO lowerValiditySlot = do
583567
then Left InvalidHeadIdInRecover{headId}
584568
else Right $ recoverTx depositedTxId deposited lowerValiditySlot
585569
where
586-
depositScript = PlutusScriptSerialised depositValidatorScript
587570
ChainContext{networkId} = ctx
588571

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

629-
headScript = PlutusScriptSerialised Head.validatorScript
630-
631612
ChainContext{ownVerificationKey, scriptRegistry} = ctx
632613

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

699680
ChainContext{ownVerificationKey, scriptRegistry} = ctx
700681

701-
headScript = PlutusScriptSerialised Head.validatorScript
702-
703682
data FanoutTxError
704683
= CannotFindHeadOutputToFanout
705684
| MissingHeadDatumInFanout
@@ -727,7 +706,7 @@ fanout ::
727706
Either FanoutTxError Tx
728707
fanout ctx spendableUTxO seedTxIn utxo utxoToCommit utxoToDecommit deadlineSlotNo = do
729708
headUTxO <-
730-
UTxO.find (isScriptTxOut headScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
709+
UTxO.find (isScriptTxOut Head.validatorScript) (utxoOfThisHead (headPolicyId seedTxIn) spendableUTxO)
731710
?> CannotFindHeadOutputToFanout
732711
closedThreadUTxO <- checkHeadDatum headUTxO
733712
_ <- setIncrementalActionMaybe utxoToCommit utxoToDecommit ?> BothCommitAndDecommitInFanout
@@ -737,8 +716,6 @@ fanout ctx spendableUTxO seedTxIn utxo utxoToCommit utxoToDecommit deadlineSlotN
737716

738717
ChainContext{scriptRegistry} = ctx
739718

740-
headScript = PlutusScriptSerialised Head.validatorScript
741-
742719
checkHeadDatum headUTxO@(_, headOutput) = do
743720
headDatum <-
744721
txOutScriptData (toTxContext headOutput) ?> MissingHeadDatumInFanout

0 commit comments

Comments
 (0)