Skip to content

Commit 198fe58

Browse files
Jimbo4350Jimbo4350
committed
Remove eon parameterization from some of the experimental api's
functions
1 parent 054d33c commit 198fe58

File tree

3 files changed

+109
-142
lines changed

3 files changed

+109
-142
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/Tx/Internal/AnyWitness.hs‎

Lines changed: 72 additions & 102 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,31 @@
1+
{-# LANGUAGE DataKinds #-}
12
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE KindSignatures #-}
4+
{-# LANGUAGE ScopedTypeVariables #-}
25
{-# LANGUAGE StandaloneDeriving #-}
36

47
module Cardano.Api.Experimental.Tx.Internal.AnyWitness
58
( -- * Any witness (key, simple script, plutus script).
69
AnyWitness (..)
710
, getAnyWitnessScript
11+
, getAnyWitnessSimpleScript
812
, getAnyWitnessPlutusLanguage
913
, getAnyWitnessScriptData
14+
, getPlutusDatum
1015
)
1116
where
1217

13-
import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards
14-
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
15-
( ShelleyBasedEra (..)
16-
, ShelleyLedgerEra
17-
, forShelleyBasedEraInEon
18-
)
1918
import Cardano.Api.Experimental.Plutus.Internal.Script
2019
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
2120
import Cardano.Api.Experimental.Simple.Script
2221
( SimpleScript (SimpleScript)
2322
, SimpleScriptOrReferenceInput (..)
2423
)
25-
import Cardano.Api.Ledger qualified as L
24+
import Cardano.Api.Internal.Orphans.Misc ()
25+
import Cardano.Api.Ledger.Internal.Reexport qualified as L
2626
import Cardano.Api.Plutus.Internal.ScriptData
2727

28-
import Cardano.Ledger.Alonzo.Scripts qualified as L
29-
import Cardano.Ledger.Babbage.Scripts qualified as L
30-
import Cardano.Ledger.Conway.Scripts qualified as L
3128
import Cardano.Ledger.Core qualified as L
32-
import Cardano.Ledger.Dijkstra.Scripts qualified as Dijkstra
3329
import Cardano.Ledger.Plutus.Data qualified as L
3430
import Cardano.Ledger.Plutus.Language qualified as L
3531

@@ -51,130 +47,104 @@ data AnyWitness era where
5147

5248
deriving instance Show (AnyWitness era)
5349

50+
instance Eq (AnyWitness era) where
51+
AnyKeyWitnessPlaceholder == AnyKeyWitnessPlaceholder = True
52+
(AnySimpleScriptWitness s1) == (AnySimpleScriptWitness s2) = s1 == s2
53+
(AnyPlutusScriptWitness (PlutusScriptWitness l1 s1 d1 r1 e1)) == (AnyPlutusScriptWitness (PlutusScriptWitness l2 s2 d2 r2 e2)) =
54+
case (l1, l2) of
55+
(L.SPlutusV1, L.SPlutusV1) -> case (d1, d2) of
56+
(InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
57+
(NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
58+
(SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
59+
(_, _) -> False
60+
(L.SPlutusV2, L.SPlutusV2) -> case (d1, d2) of
61+
(InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
62+
(NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
63+
(SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
64+
(_, _) -> False
65+
(L.SPlutusV3, L.SPlutusV3) -> case (d1, d2) of
66+
(InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
67+
(NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
68+
(SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
69+
(_, _) -> False
70+
(L.SPlutusV4, L.SPlutusV4) -> case (d1, d2) of
71+
(InlineDatum, InlineDatum) -> s1 == s2 && r1 == r2 && e1 == e2
72+
(NoScriptDatum, NoScriptDatum) -> s1 == s2 && r1 == r2 && e1 == e2
73+
(SpendingScriptDatum d1', SpendingScriptDatum d2') -> s1 == s2 && r1 == r2 && e1 == e2 && d1' == d2'
74+
(_, _) -> False
75+
(_, _) -> False
76+
_ == _ = False
77+
5478
getAnyWitnessPlutusLanguage :: AnyWitness era -> Maybe L.Language
5579
getAnyWitnessPlutusLanguage AnyKeyWitnessPlaceholder = Nothing
5680
getAnyWitnessPlutusLanguage (AnySimpleScriptWitness _) = Nothing
5781
getAnyWitnessPlutusLanguage (AnyPlutusScriptWitness swit) = Just $ getPlutusScriptWitnessLanguage swit
5882

5983
getAnyWitnessSimpleScript
60-
:: AnyWitness (ShelleyLedgerEra era) -> Maybe (L.NativeScript (ShelleyLedgerEra era))
84+
:: AnyWitness era -> Maybe (L.Script era)
6185
getAnyWitnessSimpleScript AnyKeyWitnessPlaceholder = Nothing
6286
getAnyWitnessSimpleScript (AnySimpleScriptWitness simpleScriptOrRefInput) =
6387
case simpleScriptOrRefInput of
64-
SScript (SimpleScript simpleScript) -> Just simpleScript
88+
SScript (SimpleScript simpleScript) -> Just $ L.fromNativeScript simpleScript
6589
SReferenceScript{} -> Nothing
6690
getAnyWitnessSimpleScript (AnyPlutusScriptWitness _) = Nothing
6791

6892
getAnyWitnessPlutusScript
69-
:: AlonzoEraOnwards era
70-
-> AnyWitness (ShelleyLedgerEra era)
71-
-> Maybe (L.PlutusScript (ShelleyLedgerEra era))
72-
getAnyWitnessPlutusScript _ AnyKeyWitnessPlaceholder = Nothing
73-
getAnyWitnessPlutusScript _ (AnySimpleScriptWitness _) = Nothing
93+
:: L.AlonzoEraScript era
94+
=> AnyWitness era
95+
-> Maybe (L.Script era)
96+
getAnyWitnessPlutusScript AnyKeyWitnessPlaceholder = Nothing
97+
getAnyWitnessPlutusScript (AnySimpleScriptWitness _) = Nothing
7498
getAnyWitnessPlutusScript
75-
eon
7699
( AnyPlutusScriptWitness
77100
(PlutusScriptWitness l (PScript (PlutusScriptInEra plutusScriptRunnable)) _ _ _)
78-
) = fromPlutusRunnable l eon plutusScriptRunnable
79-
getAnyWitnessPlutusScript _ (AnyPlutusScriptWitness (PlutusScriptWitness _ (PReferenceScript{}) _ _ _)) =
101+
) = L.fromPlutusScript <$> fromPlutusRunnable l plutusScriptRunnable
102+
getAnyWitnessPlutusScript (AnyPlutusScriptWitness (PlutusScriptWitness _ (PReferenceScript{}) _ _ _)) =
80103
Nothing
81104

82105
-- | NB this does not include datums from inline datums existing at tx outputs!
83106
getAnyWitnessScriptData
84-
:: AlonzoEraOnwards era -> AnyWitness (ShelleyLedgerEra era) -> L.TxDats (ShelleyLedgerEra era)
85-
getAnyWitnessScriptData eon AnyKeyWitnessPlaceholder = alonzoEraOnwardsConstraints eon mempty
86-
getAnyWitnessScriptData eon AnySimpleScriptWitness{} = alonzoEraOnwardsConstraints eon mempty
87-
getAnyWitnessScriptData eon (AnyPlutusScriptWitness (PlutusScriptWitness l _ scriptDatum _ _)) =
88-
let alonzoSdat = toAlonzoDatum eon l scriptDatum
89-
in alonzoEraOnwardsConstraints eon $
90-
case alonzoSdat of
91-
Nothing -> alonzoEraOnwardsConstraints eon mempty
92-
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)]
93115

94116
getAnyWitnessScript
95-
:: ShelleyBasedEra era -> AnyWitness (ShelleyLedgerEra era) -> Maybe (L.Script (ShelleyLedgerEra era))
96-
getAnyWitnessScript _ AnyKeyWitnessPlaceholder = Nothing
97-
getAnyWitnessScript era ss@(AnySimpleScriptWitness{}) =
98-
case era of
99-
ShelleyBasedEraShelley -> getAnyWitnessSimpleScript ss
100-
ShelleyBasedEraAllegra -> getAnyWitnessSimpleScript ss
101-
ShelleyBasedEraMary -> getAnyWitnessSimpleScript ss
102-
ShelleyBasedEraAlonzo -> L.NativeScript <$> getAnyWitnessSimpleScript ss
103-
ShelleyBasedEraBabbage -> L.NativeScript <$> getAnyWitnessSimpleScript ss
104-
ShelleyBasedEraConway -> L.NativeScript <$> getAnyWitnessSimpleScript ss
105-
ShelleyBasedEraDijkstra -> L.NativeScript <$> getAnyWitnessSimpleScript ss
106-
getAnyWitnessScript era ps@(AnyPlutusScriptWitness{}) =
107-
forShelleyBasedEraInEon era Nothing $ \aEon ->
108-
case aEon of
109-
AlonzoEraOnwardsAlonzo -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
110-
AlonzoEraOnwardsBabbage -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
111-
AlonzoEraOnwardsConway -> L.PlutusScript <$> getAnyWitnessPlutusScript aEon ps
112-
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
113121

114122
-- It should be noted that 'PlutusRunnable' is constructed via deserialization. The deserialization
115123
-- instance lives in ledger and will fail for an invalid script language/era pairing. Therefore
116124
-- this function should never return 'Nothing'.
117125
fromPlutusRunnable
118-
:: L.SLanguage lang
119-
-> AlonzoEraOnwards era
126+
:: L.AlonzoEraScript era
127+
=> L.SLanguage lang
120128
-> L.PlutusRunnable lang
121-
-> Maybe (L.PlutusScript (ShelleyLedgerEra era))
122-
fromPlutusRunnable L.SPlutusV1 eon runnable =
123-
case eon of
124-
AlonzoEraOnwardsAlonzo ->
125-
let plutusScript = L.plutusFromRunnable runnable
126-
in Just $ L.AlonzoPlutusV1 plutusScript
127-
AlonzoEraOnwardsBabbage ->
128-
let plutusScript = L.plutusFromRunnable runnable
129-
in Just $ L.BabbagePlutusV1 plutusScript
130-
AlonzoEraOnwardsConway ->
131-
let plutusScript = L.plutusFromRunnable runnable
132-
in Just $ L.ConwayPlutusV1 plutusScript
133-
AlonzoEraOnwardsDijkstra ->
134-
let plutusScript = L.plutusFromRunnable runnable
135-
in Just $ Dijkstra.DijkstraPlutusV1 plutusScript
136-
fromPlutusRunnable L.SPlutusV2 eon runnable =
137-
case eon of
138-
AlonzoEraOnwardsAlonzo -> Nothing
139-
AlonzoEraOnwardsBabbage ->
140-
let plutusScript = L.plutusFromRunnable runnable
141-
in Just $ L.BabbagePlutusV2 plutusScript
142-
AlonzoEraOnwardsConway ->
143-
let plutusScript = L.plutusFromRunnable runnable
144-
in Just $ L.ConwayPlutusV2 plutusScript
145-
AlonzoEraOnwardsDijkstra ->
146-
let plutusScript = L.plutusFromRunnable runnable
147-
in Just $ Dijkstra.DijkstraPlutusV2 plutusScript
148-
fromPlutusRunnable L.SPlutusV3 eon runnable =
149-
case eon of
150-
AlonzoEraOnwardsAlonzo -> Nothing
151-
AlonzoEraOnwardsBabbage -> Nothing
152-
AlonzoEraOnwardsConway ->
153-
let plutusScript = L.plutusFromRunnable runnable
154-
in Just $ L.ConwayPlutusV3 plutusScript
155-
AlonzoEraOnwardsDijkstra ->
156-
let plutusScript = L.plutusFromRunnable runnable
157-
in Just $ Dijkstra.DijkstraPlutusV3 plutusScript
158-
fromPlutusRunnable L.SPlutusV4 eon runnable =
159-
case eon of
160-
AlonzoEraOnwardsAlonzo -> Nothing
161-
AlonzoEraOnwardsBabbage -> Nothing
162-
AlonzoEraOnwardsConway ->
163-
let plutusScript = L.plutusFromRunnable runnable
164-
in Just $ error "fromPlutusRunnable: ConwayPlutusV4" plutusScript
165-
AlonzoEraOnwardsDijkstra ->
166-
let plutusScript = L.plutusFromRunnable runnable
167-
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
168138

169139
toAlonzoDatum
170-
:: AlonzoEraOnwards era
171-
-> L.SLanguage lang
140+
:: L.Era era
141+
=> L.SLanguage lang
172142
-> PlutusScriptDatum lang purpose
173-
-> Maybe (L.Data (ShelleyLedgerEra era))
174-
toAlonzoDatum eon l d =
143+
-> Maybe (L.Data era)
144+
toAlonzoDatum l d =
175145
let mHashableData = getPlutusDatum l d
176146
in case mHashableData of
177-
Just h -> Just $ alonzoEraOnwardsConstraints eon $ toAlonzoData h
147+
Just h -> Just $ toAlonzoData h
178148
Nothing -> Nothing
179149

180150
getPlutusDatum

‎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

0 commit comments

Comments
 (0)