Skip to content

Commit e4aab41

Browse files
Jimbo4350Jimbo4350
committed
Move mkTxCertificates to Cardano.Api.Experimental.Tx.Internal.Compatible
1 parent 9f0d0bb commit e4aab41

File tree

6 files changed

+126
-88
lines changed

6 files changed

+126
-88
lines changed

‎cardano-api/cardano-api.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -227,6 +227,7 @@ library
227227
Cardano.Api.Experimental.Tx.Internal.AnyWitness
228228
Cardano.Api.Experimental.Tx.Internal.Body
229229
Cardano.Api.Experimental.Tx.Internal.Certificate
230+
Cardano.Api.Experimental.Tx.Internal.Compatible
230231
Cardano.Api.Experimental.Tx.Internal.Fee
231232
Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
232233
Cardano.Api.Genesis.Internal

‎cardano-api/src/Cardano/Api/Experimental.hs‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -78,5 +78,6 @@ import Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
7878
import Cardano.Api.Experimental.Simple.Script
7979
import Cardano.Api.Experimental.Tx
8080
import Cardano.Api.Experimental.Tx.Internal.Certificate
81+
import Cardano.Api.Experimental.Tx.Internal.Compatible
8182
import Cardano.Api.Experimental.Tx.Internal.Fee
8283
import Cardano.Api.Tx.Internal.Fee (evaluateTransactionExecutionUnitsShelley)

‎cardano-api/src/Cardano/Api/Experimental/Era.hs‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -32,7 +32,8 @@ module Cardano.Api.Experimental.Era
3232
)
3333
where
3434

35-
import Cardano.Api.Consensus
35+
import Cardano.Api.Consensus.Internal.Mode
36+
import Cardano.Api.Consensus.Internal.Reexport
3637
import Cardano.Api.Era qualified as Api
3738
import Cardano.Api.Era.Internal.Core (BabbageEra, ConwayEra, Eon (..))
3839
import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards

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

Lines changed: 0 additions & 86 deletions
Original file line numberDiff line numberDiff line change
@@ -13,13 +13,11 @@
1313

1414
module Cardano.Api.Experimental.Tx.Internal.Certificate
1515
( Certificate (..)
16-
, mkTxCertificates
1716
, convertToOldApiCertificate
1817
, convertToNewCertificate
1918
)
2019
where
2120

22-
import Cardano.Api.Address qualified as Api
2321
import Cardano.Api.Certificate.Internal qualified as Api
2422
import Cardano.Api.Era.Internal.Eon.Convert
2523
import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
@@ -89,87 +87,3 @@ convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (Ledger
8987
convertToNewCertificate ConwayEra (Api.ConwayCertificate _ cert) = Certificate cert
9088
convertToNewCertificate ConwayEra (Api.ShelleyRelatedCertificate sToBab _) =
9189
case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {}
92-
93-
mkTxCertificates
94-
:: forall era
95-
. IsEra era
96-
=> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
97-
-> Api.TxCertificates Api.BuildTx era
98-
mkTxCertificates [] = TxCertificatesNone
99-
mkTxCertificates certs =
100-
TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs
101-
where
102-
getStakeCred
103-
:: Era era
104-
-> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
105-
-> ( Api.Certificate era
106-
, Api.BuildTxWith
107-
Api.BuildTx
108-
(Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era))
109-
)
110-
getStakeCred era (Certificate cert, witness) =
111-
case era of
112-
ConwayEra -> do
113-
let oldApiCert = Api.ConwayCertificate (convert era) cert
114-
mStakeCred = Api.selectStakeCredentialWitness oldApiCert
115-
wit =
116-
case witness of
117-
AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr
118-
AnySimpleScriptWitness ss ->
119-
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ newToOldSimpleScriptWitness era ss
120-
AnyPlutusScriptWitness psw ->
121-
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
122-
newToOldPlutusCertificateScriptWitness ConwayEra psw
123-
(oldApiCert, pure $ (,wit) <$> mStakeCred)
124-
125-
newToOldSimpleScriptWitness
126-
:: L.AllegraEraScript (LedgerEra era)
127-
=> Era era -> Exp.SimpleScriptOrReferenceInput (LedgerEra era) -> Api.ScriptWitness Api.WitCtxStake era
128-
newToOldSimpleScriptWitness era simple =
129-
case simple of
130-
Exp.SScript (Exp.SimpleScript script) ->
131-
Api.SimpleScriptWitness
132-
(sbeToSimpleScriptLanguageInEra $ convert era)
133-
(Api.SScript $ fromAllegraTimelock script)
134-
Exp.SReferenceScript inp ->
135-
Api.SimpleScriptWitness
136-
(sbeToSimpleScriptLanguageInEra $ convert era)
137-
(Api.SReferenceScript inp)
138-
139-
newToOldPlutusCertificateScriptWitness
140-
:: Era era
141-
-> Exp.PlutusScriptWitness lang purpose (LedgerEra era)
142-
-> Api.ScriptWitness Api.WitCtxStake era
143-
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV1 scriptOrRef _ redeemer execUnits) =
144-
Api.PlutusScriptWitness
145-
Api.PlutusScriptV1InConway
146-
Api.PlutusScriptV1
147-
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
148-
Api.NoScriptDatumForStake
149-
redeemer
150-
execUnits
151-
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV2 scriptOrRef _ redeemer execUnits) =
152-
Api.PlutusScriptWitness
153-
Api.PlutusScriptV2InConway
154-
Api.PlutusScriptV2
155-
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
156-
Api.NoScriptDatumForStake
157-
redeemer
158-
execUnits
159-
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV3 scriptOrRef _ redeemer execUnits) =
160-
Api.PlutusScriptWitness
161-
Api.PlutusScriptV3InConway
162-
Api.PlutusScriptV3
163-
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
164-
Api.NoScriptDatumForStake
165-
redeemer
166-
execUnits
167-
168-
newToOldPlutusScriptOrReferenceInput
169-
:: Era era
170-
-> Exp.PlutusScriptOrReferenceInput lang (LedgerEra era)
171-
-> Api.PlutusScriptOrReferenceInput oldlang
172-
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PReferenceScript txin) = Api.PReferenceScript txin
173-
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) =
174-
let oldScript = L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable plutusRunnable
175-
in Api.PScript $ Api.PlutusScriptSerialised oldScript

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

Lines changed: 119 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,119 @@
1+
{-# LANGUAGE FlexibleContexts #-}
2+
{-# LANGUAGE GADTs #-}
3+
{-# LANGUAGE RankNTypes #-}
4+
{-# LANGUAGE TupleSections #-}
5+
6+
module Cardano.Api.Experimental.Tx.Internal.Compatible
7+
( mkTxCertificates
8+
)
9+
where
10+
11+
import Cardano.Api.Address qualified as Api
12+
import Cardano.Api.Certificate.Internal qualified as Api
13+
import Cardano.Api.Era.Internal.Eon.Convert
14+
import Cardano.Api.Experimental.Era
15+
import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
16+
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness qualified as Exp
17+
import Cardano.Api.Experimental.Simple.Script qualified as Exp
18+
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
19+
import Cardano.Api.Experimental.Tx.Internal.Certificate
20+
import Cardano.Api.Ledger.Internal.Reexport qualified as L
21+
import Cardano.Api.Plutus.Internal.Script (fromAllegraTimelock, sbeToSimpleScriptLanguageInEra)
22+
import Cardano.Api.Plutus.Internal.Script qualified as Api
23+
import Cardano.Api.Tx.Internal.Body (TxCertificates (..))
24+
import Cardano.Api.Tx.Internal.Body qualified as Api
25+
26+
import Cardano.Binary
27+
import Cardano.Ledger.Allegra.Scripts qualified as L
28+
import Cardano.Ledger.Alonzo.Scripts qualified as L
29+
import Cardano.Ledger.Plutus.Language qualified as L
30+
import Cardano.Ledger.Plutus.Language qualified as Plutus
31+
32+
import GHC.Exts (IsList (..))
33+
34+
mkTxCertificates
35+
:: forall era
36+
. IsEra era
37+
=> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
38+
-> Api.TxCertificates Api.BuildTx era
39+
mkTxCertificates [] = TxCertificatesNone
40+
mkTxCertificates certs =
41+
TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs
42+
where
43+
-- TxCertificate now uses experimental Certificate type therefore getStakeCred
44+
-- needs to be adjusted!
45+
46+
getStakeCred
47+
:: Era era
48+
-> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
49+
-> ( Api.Certificate era
50+
, Api.BuildTxWith
51+
Api.BuildTx
52+
(Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era))
53+
)
54+
getStakeCred era (Certificate cert, witness) =
55+
case era of
56+
ConwayEra -> do
57+
let oldApiCert = Api.ConwayCertificate (convert era) cert
58+
mStakeCred = Api.selectStakeCredentialWitness oldApiCert
59+
wit =
60+
case witness of
61+
AnyKeyWitnessPlaceholder -> Api.KeyWitness Api.KeyWitnessForStakeAddr
62+
AnySimpleScriptWitness ss ->
63+
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $ newToOldSimpleScriptWitness era ss
64+
AnyPlutusScriptWitness psw ->
65+
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
66+
newToOldPlutusCertificateScriptWitness ConwayEra psw
67+
(oldApiCert, pure $ (,wit) <$> mStakeCred)
68+
69+
newToOldSimpleScriptWitness
70+
:: L.AllegraEraScript (LedgerEra era)
71+
=> Era era -> Exp.SimpleScriptOrReferenceInput (LedgerEra era) -> Api.ScriptWitness Api.WitCtxStake era
72+
newToOldSimpleScriptWitness era simple =
73+
case simple of
74+
Exp.SScript (Exp.SimpleScript script) ->
75+
Api.SimpleScriptWitness
76+
(sbeToSimpleScriptLanguageInEra $ convert era)
77+
(Api.SScript $ fromAllegraTimelock script)
78+
Exp.SReferenceScript inp ->
79+
Api.SimpleScriptWitness
80+
(sbeToSimpleScriptLanguageInEra $ convert era)
81+
(Api.SReferenceScript inp)
82+
83+
newToOldPlutusCertificateScriptWitness
84+
:: Era era
85+
-> Exp.PlutusScriptWitness lang purpose (LedgerEra era)
86+
-> Api.ScriptWitness Api.WitCtxStake era
87+
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV1 scriptOrRef _ redeemer execUnits) =
88+
Api.PlutusScriptWitness
89+
Api.PlutusScriptV1InConway
90+
Api.PlutusScriptV1
91+
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
92+
Api.NoScriptDatumForStake
93+
redeemer
94+
execUnits
95+
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV2 scriptOrRef _ redeemer execUnits) =
96+
Api.PlutusScriptWitness
97+
Api.PlutusScriptV2InConway
98+
Api.PlutusScriptV2
99+
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
100+
Api.NoScriptDatumForStake
101+
redeemer
102+
execUnits
103+
newToOldPlutusCertificateScriptWitness ConwayEra (Exp.PlutusScriptWitness Plutus.SPlutusV3 scriptOrRef _ redeemer execUnits) =
104+
Api.PlutusScriptWitness
105+
Api.PlutusScriptV3InConway
106+
Api.PlutusScriptV3
107+
(newToOldPlutusScriptOrReferenceInput ConwayEra scriptOrRef)
108+
Api.NoScriptDatumForStake
109+
redeemer
110+
execUnits
111+
112+
newToOldPlutusScriptOrReferenceInput
113+
:: Era era
114+
-> Exp.PlutusScriptOrReferenceInput lang (LedgerEra era)
115+
-> Api.PlutusScriptOrReferenceInput oldlang
116+
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PReferenceScript txin) = Api.PReferenceScript txin
117+
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) =
118+
let oldScript = L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable plutusRunnable
119+
in Api.PScript $ Api.PlutusScriptSerialised oldScript

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

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -232,6 +232,7 @@ where
232232

233233
import Cardano.Api.Address
234234
import Cardano.Api.Byron.Internal.Key
235+
import Cardano.Api.Certificate
235236
import Cardano.Api.Certificate.Internal
236237
import Cardano.Api.Era.Internal.Case
237238
import Cardano.Api.Era.Internal.Core
@@ -251,6 +252,7 @@ import Cardano.Api.Experimental.Plutus.Internal.IndexedPlutusScriptWitness
251252
, obtainAlonzoScriptPurposeConstraints
252253
)
253254
import Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
255+
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
254256
import Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
255257
import Cardano.Api.Governance.Internal.Action.ProposalProcedure
256258
import Cardano.Api.Governance.Internal.Action.VotingProcedure
@@ -573,7 +575,7 @@ data TxCertificates build era where
573575
TxCertificates
574576
:: ShelleyBasedEra era
575577
-> OMap
576-
(Certificate era)
578+
(Exp.Certificate era)
577579
( BuildTxWith
578580
build
579581
(Maybe (StakeCredential, Witness WitCtxStake era))

0 commit comments

Comments
 (0)