15
15
16
16
import Cardano.Api.Address qualified as Api
17
17
import Cardano.Api.Certificate.Internal qualified as Api
18
+ import Cardano.Api.Era.Internal.Core (DijkstraEra )
18
19
import Cardano.Api.Era.Internal.Eon.Convert
19
- import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
20
20
import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra qualified as Api
21
21
import Cardano.Api.Experimental.Era
22
22
import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
@@ -45,13 +45,18 @@ deriving instance Eq (Certificate era)
45
45
deriving instance Ord (Certificate era )
46
46
47
47
convertToOldApiCertificate :: Era era -> Certificate (LedgerEra era ) -> Api. Certificate era
48
- convertToOldApiCertificate ConwayEra (Certificate cert) =
49
- Api. ConwayCertificate ConwayEraOnwardsConway cert
48
+ convertToOldApiCertificate e (Certificate cert) =
49
+ obtainCommonConstraints e $ Api. ConwayCertificate (convert e) cert
50
50
51
51
convertToNewCertificate :: Era era -> Api. Certificate era -> Certificate (LedgerEra era )
52
- convertToNewCertificate ConwayEra (Api. ConwayCertificate _ cert) = Certificate cert
53
- convertToNewCertificate ConwayEra (Api. ShelleyRelatedCertificate sToBab _) =
54
- case sToBab :: Api. ShelleyToBabbageEra ConwayEra of {}
52
+ convertToNewCertificate era (Api. ConwayCertificate _ cert) =
53
+ case era of
54
+ ConwayEra -> Certificate cert
55
+ DijkstraEra -> Certificate cert
56
+ convertToNewCertificate era (Api. ShelleyRelatedCertificate sToBab _) =
57
+ case era of
58
+ ConwayEra -> case sToBab :: Api. ShelleyToBabbageEra ConwayEra of {}
59
+ DijkstraEra -> case sToBab :: Api. ShelleyToBabbageEra DijkstraEra of {}
55
60
56
61
mkTxCertificates
57
62
:: forall era
@@ -61,29 +66,29 @@ mkTxCertificates
61
66
mkTxCertificates [] = TxCertificatesNone
62
67
mkTxCertificates certs =
63
68
TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs
64
- where
65
- getStakeCred
66
- :: Era era
67
- -> (Certificate (LedgerEra era ), AnyWitness (LedgerEra era ))
68
- -> ( Api. Certificate era
69
- , Api. BuildTxWith
70
- Api. BuildTx
71
- (Maybe (Api. StakeCredential , Api. Witness Api. WitCtxStake era ))
72
- )
73
- getStakeCred era (Certificate cert, witness) =
74
- case era of
75
- ConwayEra -> do
76
- let oldApiCert = Api. ConwayCertificate (convert era) cert
77
- mStakeCred = Api. selectStakeCredentialWitness oldApiCert
78
- wit =
79
- case witness of
80
- AnyKeyWitnessPlaceholder -> Api. KeyWitness Api. KeyWitnessForStakeAddr
81
- AnySimpleScriptWitness ss ->
82
- Api. ScriptWitness Api. ScriptWitnessForStakeAddr $ newToOldSimpleScriptWitness era ss
83
- AnyPlutusScriptWitness psw ->
84
- Api. ScriptWitness Api. ScriptWitnessForStakeAddr $
85
- newToOldPlutusCertificateScriptWitness ConwayEra psw
86
- (oldApiCert, pure $ (,wit) <$> mStakeCred)
69
+
70
+ getStakeCred
71
+ :: Era era
72
+ -> (Certificate (LedgerEra era ), AnyWitness (LedgerEra era ))
73
+ -> ( Api. Certificate era
74
+ , Api. BuildTxWith
75
+ Api. BuildTx
76
+ (Maybe (Api. StakeCredential , Api. Witness Api. WitCtxStake era ))
77
+ )
78
+ getStakeCred e (Certificate cert, witness) = do
79
+ let oldApiCert = obtainCommonConstraints e $ Api. ConwayCertificate (convert e) cert
80
+ mStakeCred = Api. selectStakeCredentialWitness oldApiCert
81
+ wit =
82
+ case witness of
83
+ AnyKeyWitnessPlaceholder -> Api. KeyWitness Api. KeyWitnessForStakeAddr
84
+ AnySimpleScriptWitness ss ->
85
+ Api. ScriptWitness Api. ScriptWitnessForStakeAddr $
86
+ obtainCommonConstraints e $
87
+ newToOldSimpleScriptWitness e ss
88
+ AnyPlutusScriptWitness psw ->
89
+ Api. ScriptWitness Api. ScriptWitnessForStakeAddr $
90
+ newToOldPlutusCertificateScriptWitness e psw
91
+ (oldApiCert, pure $ (,wit) <$> mStakeCred)
87
92
88
93
newToOldSimpleScriptWitness
89
94
:: L. AllegraEraScript (LedgerEra era )
@@ -127,12 +132,40 @@ newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus
127
132
Api. NoScriptDatumForStake
128
133
redeemer
129
134
execUnits
135
+ newToOldPlutusCertificateScriptWitness ConwayEra (Exp. PlutusScriptWitness Plutus. SPlutusV4 _scriptOrRef _ _redeemer _execUnits) =
136
+ error " dijkstra"
137
+ newToOldPlutusCertificateScriptWitness DijkstraEra (Exp. PlutusScriptWitness Plutus. SPlutusV1 scriptOrRef _ redeemer execUnits) =
138
+ Api. PlutusScriptWitness
139
+ Api. PlutusScriptV1InDijkstra
140
+ Api. PlutusScriptV1
141
+ (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef)
142
+ Api. NoScriptDatumForStake
143
+ redeemer
144
+ execUnits
145
+ newToOldPlutusCertificateScriptWitness DijkstraEra (Exp. PlutusScriptWitness Plutus. SPlutusV2 scriptOrRef _ redeemer execUnits) =
146
+ Api. PlutusScriptWitness
147
+ Api. PlutusScriptV2InDijkstra
148
+ Api. PlutusScriptV2
149
+ (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef)
150
+ Api. NoScriptDatumForStake
151
+ redeemer
152
+ execUnits
153
+ newToOldPlutusCertificateScriptWitness DijkstraEra (Exp. PlutusScriptWitness Plutus. SPlutusV3 scriptOrRef _ redeemer execUnits) =
154
+ Api. PlutusScriptWitness
155
+ Api. PlutusScriptV3InDijkstra
156
+ Api. PlutusScriptV3
157
+ (newToOldPlutusScriptOrReferenceInput DijkstraEra scriptOrRef)
158
+ Api. NoScriptDatumForStake
159
+ redeemer
160
+ execUnits
161
+ newToOldPlutusCertificateScriptWitness DijkstraEra (Exp. PlutusScriptWitness Plutus. SPlutusV4 _scriptOrRef _ _redeemer _execUnits) =
162
+ error " dijkstra"
130
163
131
164
newToOldPlutusScriptOrReferenceInput
132
165
:: Era era
133
166
-> Exp. PlutusScriptOrReferenceInput lang (LedgerEra era )
134
167
-> Api. PlutusScriptOrReferenceInput oldlang
135
- newToOldPlutusScriptOrReferenceInput ConwayEra (Exp. PReferenceScript txin) = Api. PReferenceScript txin
136
- newToOldPlutusScriptOrReferenceInput ConwayEra (Exp. PScript (Exp. PlutusScriptInEra plutusRunnable)) =
168
+ newToOldPlutusScriptOrReferenceInput _ (Exp. PReferenceScript txin) = Api. PReferenceScript txin
169
+ newToOldPlutusScriptOrReferenceInput _ (Exp. PScript (Exp. PlutusScriptInEra plutusRunnable)) =
137
170
let oldScript = L. unPlutusBinary . L. plutusBinary $ L. plutusFromRunnable plutusRunnable
138
171
in Api. PScript $ Api. PlutusScriptSerialised oldScript
0 commit comments