Skip to content

Commit 9464b3f

Browse files
Jimbo4350Jimbo4350
authored
Merge pull request #858 from IntersectMBO/jordan/introduce-certificate-type
Introduce new certificate type
2 parents 95b9805 + 8a5d6d6 commit 9464b3f

6 files changed

Lines changed: 170 additions & 3 deletions

File tree

‎cardano-api/cardano-api.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -220,6 +220,7 @@ library
220220
Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
221221
Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
222222
Cardano.Api.Experimental.Tx.Internal.AnyWitness
223+
Cardano.Api.Experimental.Tx.Internal.Certificate
223224
Cardano.Api.Experimental.Tx.Internal.TxScriptWitnessRequirements
224225
Cardano.Api.Genesis.Internal
225226
Cardano.Api.Genesis.Internal.Parameters

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

Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -20,6 +20,10 @@ module Cardano.Api.Experimental
2020
, obtainCommonConstraints
2121
, hashTxBody
2222
, evaluateTransactionExecutionUnitsShelley
23+
, Certificate (..)
24+
, convertToNewCertificate
25+
, convertToOldApiCertificate
26+
, mkTxCertificates
2327

2428
-- ** Era-related
2529
, BabbageEra
@@ -69,4 +73,5 @@ import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness
6973
import Cardano.Api.Experimental.Plutus.Internal.Shim.LegacyScripts
7074
import Cardano.Api.Experimental.Simple.Script
7175
import Cardano.Api.Experimental.Tx
76+
import Cardano.Api.Experimental.Tx.Internal.Certificate
7277
import Cardano.Api.Tx.Internal.Fee (evaluateTransactionExecutionUnitsShelley)

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

Lines changed: 17 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -37,10 +37,12 @@ import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards
3737
import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards
3838
import Cardano.Api.Era.Internal.Eon.Convert
3939
import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
40+
import Cardano.Api.Era.Internal.Eon.MaryEraOnwards
4041
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra (ShelleyBasedEra (..), ShelleyLedgerEra)
4142
import Cardano.Api.Ledger.Internal.Reexport qualified as L
4243
import Cardano.Api.Pretty.Internal.ShowOf
4344

45+
import Cardano.Ledger.Allegra.Scripts qualified as L
4446
import Cardano.Ledger.Api qualified as L
4547
import Cardano.Ledger.BaseTypes (Inject (..))
4648
import Cardano.Ledger.Conway qualified as Ledger
@@ -212,6 +214,14 @@ instance Convert Era BabbageEraOnwards where
212214
convert = \case
213215
ConwayEra -> BabbageEraOnwardsConway
214216

217+
instance Convert Era MaryEraOnwards where
218+
convert = \case
219+
ConwayEra -> MaryEraOnwardsConway
220+
221+
instance Convert Era ConwayEraOnwards where
222+
convert = \case
223+
ConwayEra -> ConwayEraOnwardsConway
224+
215225
instance Convert ConwayEraOnwards Era where
216226
convert = \case
217227
ConwayEraOnwardsConway -> ConwayEra
@@ -253,13 +263,19 @@ obtainCommonConstraints
253263
obtainCommonConstraints ConwayEra x = x
254264

255265
type EraCommonConstraints era =
256-
( L.AlonzoEraTx (LedgerEra era)
266+
( L.AllegraEraScript (LedgerEra era)
267+
, L.AlonzoEraTx (LedgerEra era)
257268
, L.BabbageEraPParams (LedgerEra era)
258269
, L.BabbageEraTxBody (LedgerEra era)
270+
, L.ConwayEraTxCert (LedgerEra era)
259271
, L.Era (LedgerEra era)
272+
, L.EraScript (LedgerEra era)
260273
, L.EraTx (LedgerEra era)
274+
, L.EraTxCert (LedgerEra era)
261275
, L.EraTxOut (LedgerEra era)
262276
, L.EraUTxO (LedgerEra era)
277+
, L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era)
278+
, L.ShelleyEraTxCert (LedgerEra era)
263279
, ShelleyLedgerEra era ~ LedgerEra era
264280
, L.HashAnnotated (Ledger.TxBody (LedgerEra era)) L.EraIndependentTxBody
265281
, Api.IsCardanoEra era

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

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

‎cardano-api/src/Cardano/Api/Internal/Orphans/Misc.hs‎

Lines changed: 10 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,20 +15,22 @@ module Cardano.Api.Internal.Orphans.Misc
1515
)
1616
where
1717

18-
import Cardano.Api.Pretty (Pretty (..), prettyException, (<+>))
18+
import Cardano.Api.Error
19+
import Cardano.Api.Pretty
1920

2021
import Cardano.Ledger.Alonzo.PParams qualified as Ledger
2122
import Cardano.Ledger.Babbage.PParams qualified as Ledger
2223
import Cardano.Ledger.BaseTypes (strictMaybeToMaybe)
2324
import Cardano.Ledger.BaseTypes qualified as Ledger
2425
import Cardano.Ledger.Binary
26+
import Cardano.Ledger.Binary qualified as CBOR
2527
import Cardano.Ledger.Coin qualified as L
2628
import Cardano.Ledger.Conway.PParams qualified as Ledger
2729
import Cardano.Ledger.HKD (NoUpdate (..))
2830
import Cardano.Ledger.Shelley.PParams qualified as Ledger
31+
import PlutusLedgerApi.Common qualified as P
2932

3033
import Codec.Binary.Bech32 qualified as Bech32
31-
import Codec.CBOR.Read qualified as CBOR
3234
import Data.Data (Data)
3335
import Data.ListMap (ListMap)
3436
import Data.ListMap qualified as ListMap
@@ -262,3 +264,9 @@ instance IsList (ListMap k a) where
262264
type Item (ListMap k a) = (k, a)
263265
fromList = ListMap.fromList
264266
toList = ListMap.toList
267+
268+
instance Error CBOR.DecoderError where
269+
prettyError = pshow
270+
271+
instance Error P.ScriptDecodeError where
272+
prettyError = pshow

‎cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -156,6 +156,7 @@ module Cardano.Api.Ledger.Internal.Reexport
156156
, textToDns
157157
, Url
158158
, urlToText
159+
, Version
159160
, textToUrl
160161
, portToWord16
161162
, ProtVer (..)
@@ -240,6 +241,7 @@ import Cardano.Ledger.BaseTypes
240241
, StrictMaybe (..)
241242
, UnitInterval
242243
, Url
244+
, Version
243245
, boundRational
244246
, dnsToText
245247
, hashAnchorData

0 commit comments

Comments
 (0)