Skip to content

Commit 46d546d

Browse files
Jimbo4350Jimbo4350
committed
Refactor ScriptWitnessRequirements related functions
1 parent 99c3936 commit 46d546d

File tree

6 files changed

+82
-147
lines changed

6 files changed

+82
-147
lines changed

‎cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/IndexedPlutusScriptWitness.hs‎

Lines changed: 18 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -169,33 +169,31 @@ createIndexedPlutusScriptWitnesses witnessableThings =
169169
-- script. The ledger basically reconstructs the indicies (redeemer pointers) of this map can then look up the relevant
170170
-- execution units/redeemer pairing. NB: the redeemer pointer has been renamed to 'PlutusPurpose AsIndex' in the ledger.
171171
getAnyWitnessRedeemerPointerMap
172-
:: AlonzoEraOnwards era
173-
-> [(Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
174-
-> L.Redeemers (ShelleyLedgerEra era)
175-
getAnyWitnessRedeemerPointerMap eon anyWit =
176-
constructRedeeemerPointerMap eon $
177-
alonzoEraOnwardsConstraints eon $
178-
createIndexedPlutusScriptWitnesses anyWit
172+
:: L.AlonzoEraScript era
173+
=> [(Witnessable witnessable era, AnyWitness era)]
174+
-> L.Redeemers era
175+
getAnyWitnessRedeemerPointerMap anyWit =
176+
constructRedeeemerPointerMap $
177+
createIndexedPlutusScriptWitnesses anyWit
179178

180179
-- | An 'IndexedPlutusScriptWitness' contains everything we need to construct a single
181180
-- entry in the redeemer pointer map.
182181
constructRedeemerPointer
183-
:: AlonzoEraOnwards era
184-
-> AnyIndexedPlutusScriptWitness (ShelleyLedgerEra era)
185-
-> L.Redeemers (ShelleyLedgerEra era)
186-
constructRedeemerPointer eon (AnyIndexedPlutusScriptWitness (IndexedPlutusScriptWitness _ purpose scriptWit)) =
182+
:: L.Era era
183+
=> AnyIndexedPlutusScriptWitness era
184+
-> L.Redeemers era
185+
constructRedeemerPointer (AnyIndexedPlutusScriptWitness (IndexedPlutusScriptWitness _ purpose scriptWit)) =
187186
let PlutusScriptWitness _ _ _ redeemer execUnits = scriptWit
188-
in alonzoEraOnwardsConstraints eon $
189-
L.Redeemers $
190-
fromList [(purpose, (toAlonzoData redeemer, toAlonzoExUnits execUnits))]
187+
in L.Redeemers $
188+
fromList [(purpose, (toAlonzoData redeemer, toAlonzoExUnits execUnits))]
191189

192190
constructRedeeemerPointerMap
193-
:: AlonzoEraOnwards era
194-
-> [AnyIndexedPlutusScriptWitness (ShelleyLedgerEra era)]
195-
-> L.Redeemers (ShelleyLedgerEra era)
196-
constructRedeeemerPointerMap eon scriptWits =
197-
let redeemerPointers = map (constructRedeemerPointer eon) scriptWits
198-
in alonzoEraOnwardsConstraints eon $ mconcat redeemerPointers
191+
:: L.AlonzoEraScript era
192+
=> [AnyIndexedPlutusScriptWitness era]
193+
-> L.Redeemers era
194+
constructRedeeemerPointerMap scriptWits =
195+
let redeemerPointers = map constructRedeemerPointer scriptWits
196+
in mconcat redeemerPointers
199197

200198
obtainAlonzoScriptPurposeConstraints
201199
:: AlonzoEraOnwards era

‎cardano-api/src/Cardano/Api/Experimental/Plutus/Internal/Shim/LegacyScripts.hs‎

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -192,7 +192,10 @@ legacyWitnessToScriptRequirements
192192
-> Either CBOR.DecoderError (TxScriptWitnessRequirements (ShelleyLedgerEra era))
193193
legacyWitnessToScriptRequirements eon wits = do
194194
r <- legacyWitnessConversion eon wits
195-
return $ getTxScriptWitnessesRequirements eon r
195+
return $
196+
alonzoEraOnwardsConstraints eon $
197+
obtainMonoidConstraint eon $
198+
getTxScriptWitnessesRequirements r
196199

197200
-- Misc helpers
198201

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/AnyWitness.hs‎

Lines changed: 38 additions & 102 deletions
Original file line numberDiff line numberDiff line change
@@ -15,27 +15,17 @@ module Cardano.Api.Experimental.Tx.Internal.AnyWitness
1515
)
1616
where
1717

18-
import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards
19-
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
20-
( ShelleyBasedEra (..)
21-
, ShelleyLedgerEra
22-
, forShelleyBasedEraInEon
23-
)
2418
import Cardano.Api.Experimental.Plutus.Internal.Script
2519
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
2620
import Cardano.Api.Experimental.Simple.Script
2721
( SimpleScript (SimpleScript)
2822
, SimpleScriptOrReferenceInput (..)
2923
)
3024
import Cardano.Api.Internal.Orphans.Misc ()
31-
import Cardano.Api.Ledger qualified as L
25+
import Cardano.Api.Ledger.Internal.Reexport qualified as L
3226
import Cardano.Api.Plutus.Internal.ScriptData
3327

34-
import Cardano.Ledger.Alonzo.Scripts qualified as L
35-
import Cardano.Ledger.Babbage.Scripts qualified as L
36-
import Cardano.Ledger.Conway.Scripts qualified as L
3728
import Cardano.Ledger.Core qualified as L
38-
import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra
3929
import Cardano.Ledger.Plutus.Data qualified as L
4030
import Cardano.Ledger.Plutus.Language qualified as L
4131

@@ -91,124 +81,70 @@ getAnyWitnessPlutusLanguage (AnySimpleScriptWitness _) = Nothing
9181
getAnyWitnessPlutusLanguage (AnyPlutusScriptWitness swit) = Just $ getPlutusScriptWitnessLanguage swit
9282

9383
getAnyWitnessSimpleScript
94-
:: AnyWitness (ShelleyLedgerEra era) -> Maybe (L.NativeScript (ShelleyLedgerEra era))
84+
:: AnyWitness era -> Maybe (L.Script era)
9585
getAnyWitnessSimpleScript AnyKeyWitnessPlaceholder = Nothing
9686
getAnyWitnessSimpleScript (AnySimpleScriptWitness simpleScriptOrRefInput) =
9787
case simpleScriptOrRefInput of
98-
SScript (SimpleScript simpleScript) -> Just simpleScript
88+
SScript (SimpleScript simpleScript) -> Just $ L.fromNativeScript simpleScript
9989
SReferenceScript{} -> Nothing
10090
getAnyWitnessSimpleScript (AnyPlutusScriptWitness _) = Nothing
10191

10292
getAnyWitnessPlutusScript
103-
:: AlonzoEraOnwards era
104-
-> AnyWitness (ShelleyLedgerEra era)
105-
-> Maybe (L.PlutusScript (ShelleyLedgerEra era))
106-
getAnyWitnessPlutusScript _ AnyKeyWitnessPlaceholder = Nothing
107-
getAnyWitnessPlutusScript _ (AnySimpleScriptWitness _) = Nothing
93+
:: L.AlonzoEraScript era
94+
=> AnyWitness era
95+
-> Maybe (L.Script era)
96+
getAnyWitnessPlutusScript AnyKeyWitnessPlaceholder = Nothing
97+
getAnyWitnessPlutusScript (AnySimpleScriptWitness _) = Nothing
10898
getAnyWitnessPlutusScript
109-
eon
11099
( AnyPlutusScriptWitness
111100
(PlutusScriptWitness l (PScript (PlutusScriptInEra plutusScriptRunnable)) _ _ _)
112-
) = fromPlutusRunnable l eon plutusScriptRunnable
113-
getAnyWitnessPlutusScript _ (AnyPlutusScriptWitness (PlutusScriptWitness _ (PReferenceScript{}) _ _ _)) =
101+
) = L.fromPlutusScript <$> fromPlutusRunnable l plutusScriptRunnable
102+
getAnyWitnessPlutusScript (AnyPlutusScriptWitness (PlutusScriptWitness _ (PReferenceScript{}) _ _ _)) =
114103
Nothing
115104

116105
-- | NB this does not include datums from inline datums existing at tx outputs!
117106
getAnyWitnessScriptData
118-
:: AlonzoEraOnwards era -> AnyWitness (ShelleyLedgerEra era) -> L.TxDats (ShelleyLedgerEra era)
119-
getAnyWitnessScriptData eon AnyKeyWitnessPlaceholder = alonzoEraOnwardsConstraints eon mempty
120-
getAnyWitnessScriptData eon AnySimpleScriptWitness{} = alonzoEraOnwardsConstraints eon mempty
121-
getAnyWitnessScriptData eon (AnyPlutusScriptWitness (PlutusScriptWitness l _ scriptDatum _ _)) =
122-
let alonzoSdat = toAlonzoDatum eon l scriptDatum
123-
in alonzoEraOnwardsConstraints eon $
124-
case alonzoSdat of
125-
Nothing -> alonzoEraOnwardsConstraints eon mempty
126-
Just d -> alonzoEraOnwardsConstraints eon $ L.TxDats $ fromList [(L.hashData d, d)]
107+
:: L.Era era => AnyWitness era -> L.TxDats era
108+
getAnyWitnessScriptData AnyKeyWitnessPlaceholder = mempty
109+
getAnyWitnessScriptData AnySimpleScriptWitness{} = mempty
110+
getAnyWitnessScriptData (AnyPlutusScriptWitness (PlutusScriptWitness l _ scriptDatum _ _)) =
111+
let alonzoSdat = toAlonzoDatum l scriptDatum
112+
in case alonzoSdat of
113+
Nothing -> mempty
114+
Just d -> L.TxDats $ fromList [(L.hashData d, d)]
127115

128116
getAnyWitnessScript
129-
:: ShelleyBasedEra era -> AnyWitness (ShelleyLedgerEra era) -> Maybe (L.Script (ShelleyLedgerEra era))
130-
getAnyWitnessScript _ AnyKeyWitnessPlaceholder = Nothing
131-
getAnyWitnessScript era ss@(AnySimpleScriptWitness{}) =
132-
case era of
133-
ShelleyBasedEraShelley -> getAnyWitnessSimpleScript ss
134-
ShelleyBasedEraAllegra -> getAnyWitnessSimpleScript ss
135-
ShelleyBasedEraMary -> getAnyWitnessSimpleScript ss
136-
ShelleyBasedEraAlonzo -> L.NativeScript <$> getAnyWitnessSimpleScript ss
137-
ShelleyBasedEraBabbage -> L.NativeScript <$> getAnyWitnessSimpleScript ss
138-
ShelleyBasedEraConway -> L.NativeScript <$> getAnyWitnessSimpleScript ss
139-
ShelleyBasedEraDijkstra -> L.NativeScript <$> getAnyWitnessSimpleScript ss
140-
getAnyWitnessScript era ps@(AnyPlutusScriptWitness{}) =
141-
forShelleyBasedEraInEon era Nothing $ \aEon ->
142-
case aEon of
143-
AlonzoEraOnwardsAlonzo -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
144-
AlonzoEraOnwardsBabbage -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
145-
AlonzoEraOnwardsConway -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
146-
AlonzoEraOnwardsDijkstra -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
117+
:: L.AlonzoEraScript era => AnyWitness era -> Maybe (L.Script era)
118+
getAnyWitnessScript AnyKeyWitnessPlaceholder = Nothing
119+
getAnyWitnessScript ss@(AnySimpleScriptWitness{}) = getAnyWitnessSimpleScript ss
120+
getAnyWitnessScript ps@(AnyPlutusScriptWitness{}) = getAnyWitnessPlutusScript ps
147121

148122
-- It should be noted that 'PlutusRunnable' is constructed via deserialization. The deserialization
149123
-- instance lives in ledger and will fail for an invalid script language/era pairing. Therefore
150124
-- this function should never return 'Nothing'.
151125
fromPlutusRunnable
152-
:: L.SLanguage lang
153-
-> AlonzoEraOnwards era
126+
:: L.AlonzoEraScript era
127+
=> L.SLanguage lang
154128
-> L.PlutusRunnable lang
155-
-> Maybe (L.PlutusScript (ShelleyLedgerEra era))
156-
fromPlutusRunnable L.SPlutusV1 eon runnable =
157-
case eon of
158-
AlonzoEraOnwardsAlonzo ->
159-
let plutusScript = L.plutusFromRunnable runnable
160-
in Just $ L.AlonzoPlutusV1 plutusScript
161-
AlonzoEraOnwardsBabbage ->
162-
let plutusScript = L.plutusFromRunnable runnable
163-
in Just $ L.BabbagePlutusV1 plutusScript
164-
AlonzoEraOnwardsConway ->
165-
let plutusScript = L.plutusFromRunnable runnable
166-
in Just $ L.ConwayPlutusV1 plutusScript
167-
AlonzoEraOnwardsDijkstra ->
168-
let plutusScript = L.plutusFromRunnable runnable
169-
in Just $ Dijkstra.DijkstraPlutusV1 plutusScript
170-
fromPlutusRunnable L.SPlutusV2 eon runnable =
171-
case eon of
172-
AlonzoEraOnwardsAlonzo -> Nothing
173-
AlonzoEraOnwardsBabbage ->
174-
let plutusScript = L.plutusFromRunnable runnable
175-
in Just $ L.BabbagePlutusV2 plutusScript
176-
AlonzoEraOnwardsConway ->
177-
let plutusScript = L.plutusFromRunnable runnable
178-
in Just $ L.ConwayPlutusV2 plutusScript
179-
AlonzoEraOnwardsDijkstra ->
180-
let plutusScript = L.plutusFromRunnable runnable
181-
in Just $ Dijkstra.DijkstraPlutusV2 plutusScript
182-
fromPlutusRunnable L.SPlutusV3 eon runnable =
183-
case eon of
184-
AlonzoEraOnwardsAlonzo -> Nothing
185-
AlonzoEraOnwardsBabbage -> Nothing
186-
AlonzoEraOnwardsConway ->
187-
let plutusScript = L.plutusFromRunnable runnable
188-
in Just $ L.ConwayPlutusV3 plutusScript
189-
AlonzoEraOnwardsDijkstra ->
190-
let plutusScript = L.plutusFromRunnable runnable
191-
in Just $ Dijkstra.DijkstraPlutusV3 plutusScript
192-
fromPlutusRunnable L.SPlutusV4 eon runnable =
193-
case eon of
194-
AlonzoEraOnwardsAlonzo -> Nothing
195-
AlonzoEraOnwardsBabbage -> Nothing
196-
AlonzoEraOnwardsConway ->
197-
let plutusScript = L.plutusFromRunnable runnable
198-
in Just $ error "fromPlutusRunnable: ConwayPlutusV4" plutusScript
199-
AlonzoEraOnwardsDijkstra ->
200-
let plutusScript = L.plutusFromRunnable runnable
201-
in Just $ Dijkstra.DijkstraPlutusV4 plutusScript
129+
-> Maybe (L.PlutusScript era)
130+
fromPlutusRunnable L.SPlutusV1 runnable =
131+
L.mkPlutusScript $ L.plutusFromRunnable runnable
132+
fromPlutusRunnable L.SPlutusV2 runnable =
133+
L.mkPlutusScript $ L.plutusFromRunnable runnable
134+
fromPlutusRunnable L.SPlutusV3 runnable =
135+
L.mkPlutusScript $ L.plutusFromRunnable runnable
136+
fromPlutusRunnable L.SPlutusV4 runnable =
137+
L.mkPlutusScript $ L.plutusFromRunnable runnable
202138

203139
toAlonzoDatum
204-
:: AlonzoEraOnwards era
205-
-> L.SLanguage lang
140+
:: L.Era era
141+
=> L.SLanguage lang
206142
-> PlutusScriptDatum lang purpose
207-
-> Maybe (L.Data (ShelleyLedgerEra era))
208-
toAlonzoDatum eon l d =
143+
-> Maybe (L.Data era)
144+
toAlonzoDatum l d =
209145
let mHashableData = getPlutusDatum l d
210146
in case mHashableData of
211-
Just h -> Just $ alonzoEraOnwardsConstraints eon $ toAlonzoData h
147+
Just h -> Just $ toAlonzoData h
212148
Nothing -> Nothing
213149

214150
getPlutusDatum

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/BodyContent/New.hs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -626,8 +626,8 @@ getAnyWitnessScript
626626
getAnyWitnessScript AnyKeyWitnessPlaceholder = Nothing
627627
getAnyWitnessScript ss@(AnySimpleScriptWitness{}) =
628628
case useEra @era of
629-
ConwayEra -> L.NativeScript <$> obtainCommonConstraints (useEra @era) (getAnyWitnessSimpleScript ss)
630-
DijkstraEra -> L.NativeScript <$> obtainCommonConstraints (useEra @era) (getAnyWitnessSimpleScript ss)
629+
ConwayEra -> obtainCommonConstraints (useEra @era) (getAnyWitnessSimpleScript ss)
630+
DijkstraEra -> obtainCommonConstraints (useEra @era) (getAnyWitnessSimpleScript ss)
631631
getAnyWitnessScript ps@(AnyPlutusScriptWitness{}) =
632632
case useEra @era of
633633
ConwayEra -> L.PlutusScript <$> getAnyWitnessPlutusScript ps

‎cardano-api/src/Cardano/Api/Experimental/Tx/Internal/TxScriptWitnessRequirements.hs‎

Lines changed: 19 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,6 @@ module Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
1818
where
1919

2020
import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards
21-
import Cardano.Api.Era.Internal.Eon.Convert (Convert (convert))
2221
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
2322
import Cardano.Api.Experimental.Plutus.Internal.IndexedPlutusScriptWitness
2423
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
@@ -69,28 +68,28 @@ instance Monoid (TxScriptWitnessRequirements L.DijkstraEra) where
6968
mempty = TxScriptWitnessRequirements mempty mempty mempty mempty
7069

7170
getTxScriptWitnessRequirements
72-
:: AlonzoEraOnwards era
73-
-> [(Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
74-
-> TxScriptWitnessRequirements (ShelleyLedgerEra era)
75-
getTxScriptWitnessRequirements era wits =
71+
:: L.AlonzoEraScript era
72+
=> Monoid (TxScriptWitnessRequirements era)
73+
=> (Witnessable witnessable era, AnyWitness era)
74+
-> TxScriptWitnessRequirements era
75+
getTxScriptWitnessRequirements wit@(_, anyWit) =
7676
let TxScriptWitnessRequirements l s d _ =
77-
obtainMonoidConstraint era $
78-
mconcat
79-
[ TxScriptWitnessRequirements
80-
(maybe mempty Set.singleton $ getAnyWitnessPlutusLanguage anyWit)
81-
(maybe mempty return $ getAnyWitnessScript (convert era) anyWit)
82-
(getAnyWitnessScriptData era anyWit)
83-
(alonzoEraOnwardsConstraints era mempty)
84-
| (_, anyWit) <- wits
85-
]
86-
in TxScriptWitnessRequirements l s d (getAnyWitnessRedeemerPointerMap era wits)
77+
mconcat
78+
[ TxScriptWitnessRequirements
79+
(maybe mempty Set.singleton $ getAnyWitnessPlutusLanguage anyWit)
80+
(maybe mempty return $ getAnyWitnessScript anyWit)
81+
(getAnyWitnessScriptData anyWit)
82+
mempty
83+
]
84+
in TxScriptWitnessRequirements l s d (getAnyWitnessRedeemerPointerMap [wit])
8785

8886
getTxScriptWitnessesRequirements
89-
:: AlonzoEraOnwards era
90-
-> [(Witnessable witnessable (ShelleyLedgerEra era), AnyWitness (ShelleyLedgerEra era))]
91-
-> TxScriptWitnessRequirements (ShelleyLedgerEra era)
92-
getTxScriptWitnessesRequirements eon wits =
93-
obtainMonoidConstraint eon $ getTxScriptWitnessRequirements eon wits
87+
:: L.AlonzoEraScript era
88+
=> Monoid (TxScriptWitnessRequirements era)
89+
=> [(Witnessable witnessable era, AnyWitness era)]
90+
-> TxScriptWitnessRequirements era
91+
getTxScriptWitnessesRequirements wits =
92+
mconcat $ map getTxScriptWitnessRequirements wits
9493

9594
obtainMonoidConstraint
9695
:: AlonzoEraOnwards era

‎cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Body/Plutus/Scripts.hs‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -67,7 +67,6 @@ import Test.Tasty.Hedgehog (testProperty)
6767
-- in the redeemer pointer map.
6868
prop_getAnyWitnessRedeemerPointerMap :: Property
6969
prop_getAnyWitnessRedeemerPointerMap = property $ do
70-
let eon = AlonzoEraOnwardsConway
7170
l <- forAll $ Gen.int (Range.linear 2 5)
7271
witnessables <- forAll $ Gen.list (Range.singleton l) $ genWitnessable @L.ConwayEra
7372
wits <-
@@ -83,7 +82,7 @@ prop_getAnyWitnessRedeemerPointerMap = property $ do
8382
expectedRedeemerPointerMapLength = length zipped
8483
finalWits = take expectedRedeemerPointerMapLength wits
8584

86-
L.Redeemers constructedRedeemerPointerMap = getAnyWitnessRedeemerPointerMap eon zipped
85+
L.Redeemers constructedRedeemerPointerMap = getAnyWitnessRedeemerPointerMap zipped
8786

8887
annotate "Constructed redeemer pointer map"
8988
annotateShow constructedRedeemerPointerMap

0 commit comments

Comments
 (0)