Skip to content

Commit d0ae67a

Browse files
Jimbo4350Jimbo4350
committed
Replaced old certificate type with experimental type
1 parent 9769fb2 commit d0ae67a

File tree

8 files changed

+93
-61
lines changed

8 files changed

+93
-61
lines changed

‎cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs‎

Lines changed: 36 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
{-# LANGUAGE DataKinds #-}
2+
{-# LANGUAGE EmptyCase #-}
23
{-# LANGUAGE FlexibleContexts #-}
34
{-# LANGUAGE GADTs #-}
45
{-# LANGUAGE NamedFieldPuns #-}
@@ -767,11 +768,43 @@ genTxCertificates =
767768
certs <- Gen.list (Range.constant 0 3) $ genCertificate w
768769
Gen.choice
769770
[ pure TxCertificatesNone
770-
, pure (TxCertificates w $ fromList ((,BuildTxWith Nothing) <$> certs))
771-
-- TODO: Generate certificates
771+
, pure
772+
( TxCertificates w $
773+
fromList ((,BuildTxWith Nothing) <$> map (extractCertificate w) certs)
774+
)
775+
-- TODO: Generate certificates
772776
]
773777
)
774778

779+
extractCertificate
780+
:: ShelleyBasedEra era
781+
-> Api.Certificate era
782+
-> Exp.Certificate (ShelleyLedgerEra era)
783+
extractCertificate ShelleyBasedEraShelley (Api.ShelleyRelatedCertificate _ c) =
784+
Exp.Certificate c
785+
extractCertificate ShelleyBasedEraAllegra (Api.ShelleyRelatedCertificate _ c) =
786+
Exp.Certificate c
787+
extractCertificate ShelleyBasedEraMary (Api.ShelleyRelatedCertificate _ c) =
788+
Exp.Certificate c
789+
extractCertificate ShelleyBasedEraAlonzo (Api.ShelleyRelatedCertificate _ c) =
790+
Exp.Certificate c
791+
extractCertificate ShelleyBasedEraBabbage (Api.ShelleyRelatedCertificate _ c) =
792+
Exp.Certificate c
793+
extractCertificate ShelleyBasedEraConway (Api.ShelleyRelatedCertificate sToBab _) =
794+
case sToBab :: ShelleyToBabbageEra ConwayEra of {}
795+
extractCertificate ShelleyBasedEraShelley (ConwayCertificate cOnwards _) =
796+
case cOnwards :: ConwayEraOnwards ShelleyEra of {}
797+
extractCertificate ShelleyBasedEraAllegra (ConwayCertificate cOnwards _) =
798+
case cOnwards :: ConwayEraOnwards AllegraEra of {}
799+
extractCertificate ShelleyBasedEraMary (ConwayCertificate cOnwards _) =
800+
case cOnwards :: ConwayEraOnwards MaryEra of {}
801+
extractCertificate ShelleyBasedEraAlonzo (ConwayCertificate cOnwards _) =
802+
case cOnwards :: ConwayEraOnwards AlonzoEra of {}
803+
extractCertificate ShelleyBasedEraBabbage (ConwayCertificate cOnwards _) =
804+
case cOnwards :: ConwayEraOnwards BabbageEra of {}
805+
extractCertificate ShelleyBasedEraConway (ConwayCertificate _ c) =
806+
Exp.Certificate c
807+
775808
genScriptWitnessedTxCertificates :: Typeable era => Exp.Era era -> Gen (TxCertificates BuildTx era)
776809
genScriptWitnessedTxCertificates era = do
777810
let w = convert era
@@ -781,7 +814,7 @@ genScriptWitnessedTxCertificates era = do
781814
let certsAndWits =
782815
zipWith
783816
(\c p -> (c, Just p))
784-
certs
817+
(map (Exp.convertToNewCertificate era) certs)
785818
plutusScriptWits
786819

787820
pure $ mkTxCertificates (convert era) certsAndWits

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

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -75,6 +75,7 @@ module Cardano.Api.Certificate.Internal
7575
, certificateToTxCert
7676
, filterUnRegCreds
7777
, filterUnRegDRepCreds
78+
, getTxCertWitness
7879
, isDRepRegOrUpdateCert
7980
)
8081
where

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

Lines changed: 7 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -16,8 +16,8 @@ module Cardano.Api.Compatible.Tx
1616
where
1717

1818
import Cardano.Api.Address (StakeCredential)
19-
import Cardano.Api.Certificate.Internal (Certificate)
2019
import Cardano.Api.Era
20+
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
2121
import Cardano.Api.Plutus.Internal.Script
2222
import Cardano.Api.ProtocolParameters
2323
import Cardano.Api.Tx.Internal.Body
@@ -155,7 +155,12 @@ createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates'
155155
(L.bodyTxL . L.votingProceduresTxBodyL) .~ votingProcedures
156156

157157
indexedTxCerts
158-
:: [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
158+
:: [ ( ScriptWitnessIndex
159+
, Exp.Certificate (ShelleyLedgerEra era)
160+
, StakeCredential
161+
, Witness WitCtxStake era
162+
)
163+
]
159164
indexedTxCerts = indexTxCertificates txCertificates'
160165

161166
setScriptWitnesses

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

Lines changed: 1 addition & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -19,31 +19,18 @@ module Cardano.Api.Experimental.Tx.Internal.Certificate
1919
where
2020

2121
import Cardano.Api.Certificate.Internal qualified as Api
22-
import Cardano.Api.Era.Internal.Eon.Convert
2322
import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
2423
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
2524
import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra qualified as Api
2625
import Cardano.Api.Experimental.Era
27-
import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
28-
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness qualified as Exp
29-
import Cardano.Api.Experimental.Simple.Script qualified as Exp
30-
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
3126
import Cardano.Api.HasTypeProxy
3227
import Cardano.Api.Ledger qualified as L
33-
import Cardano.Api.Plutus.Internal.Script
34-
import Cardano.Api.Plutus.Internal.Script qualified as Api
3528
import Cardano.Api.Serialise.Cbor
3629
import Cardano.Api.Serialise.TextEnvelope.Internal
37-
import Cardano.Api.Tx.Internal.Body (TxCertificates (..))
38-
import Cardano.Api.Tx.Internal.Body qualified as Api
3930

4031
import Cardano.Binary qualified as CBOR
41-
import Cardano.Ledger.Allegra.Scripts qualified as L
42-
import Cardano.Ledger.Plutus.Language qualified as L
43-
import Cardano.Ledger.Plutus.Language qualified as Plutus
4432

4533
import Data.Typeable
46-
import GHC.IsList
4734

4835
data Certificate era where
4936
Certificate :: L.EraTxCert era => L.TxCert era -> Certificate era
@@ -83,7 +70,7 @@ convertToOldApiCertificate :: Era era -> Certificate (LedgerEra era) -> Api.Cert
8370
convertToOldApiCertificate ConwayEra (Certificate cert) =
8471
Api.ConwayCertificate ConwayEraOnwardsConway cert
8572

86-
convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (LedgerEra era)
73+
convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (ShelleyLedgerEra era)
8774
convertToNewCertificate ConwayEra (Api.ConwayCertificate _ cert) = Certificate cert
8875
convertToNewCertificate ConwayEra (Api.ShelleyRelatedCertificate sToBab _) =
8976
case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {}

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

Lines changed: 21 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -5,61 +5,56 @@
55
{-# LANGUAGE StandaloneDeriving #-}
66
{-# LANGUAGE TupleSections #-}
77

8-
module Cardano.Api.Experimental.Tx.Internal.Compatible (mkTxCertificates) where
8+
module Cardano.Api.Experimental.Tx.Internal.Compatible (mkTxCertificates) where
99

1010
import Cardano.Api.Address qualified as Api
1111
import Cardano.Api.Certificate.Internal qualified as Api
1212
import Cardano.Api.Era.Internal.Eon.Convert
13-
import Cardano.Api.Plutus.Internal.Script (sbeToSimpleScriptLanguageInEra,fromAllegraTimelock)
13+
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
1414
import Cardano.Api.Experimental.Era
1515
import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
1616
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness qualified as Exp
17-
import Cardano.Api.Ledger.Internal.Reexport qualified as L
18-
19-
20-
import Cardano.Ledger.Alonzo.Scripts qualified as L
21-
22-
import Cardano.Ledger.Plutus.Language qualified as L
2317
import Cardano.Api.Experimental.Simple.Script qualified as Exp
24-
import Cardano.Ledger.Plutus.Language qualified as Plutus
25-
26-
import Cardano.Binary
27-
import Cardano.Ledger.Allegra.Scripts qualified as L
28-
29-
3018
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
19+
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
20+
import Cardano.Api.Ledger.Internal.Reexport qualified as L
21+
import Cardano.Api.Plutus.Internal.Script (fromAllegraTimelock, sbeToSimpleScriptLanguageInEra)
3122
import Cardano.Api.Plutus.Internal.Script qualified as Api
32-
3323
import Cardano.Api.Tx.Internal.Body (TxCertificates (..))
3424
import Cardano.Api.Tx.Internal.Body qualified as Api
35-
import Cardano.Api.Experimental.Tx.Internal.Certificate
3625

37-
import GHC.Exts (IsList (..))
26+
import Cardano.Ledger.Allegra.Scripts qualified as L
27+
import Cardano.Ledger.Alonzo.Scripts qualified as L
28+
import Cardano.Ledger.Plutus.Language qualified as L
29+
import Cardano.Ledger.Plutus.Language qualified as Plutus
3830

31+
import GHC.Exts (IsList (..))
3932

4033
mkTxCertificates
4134
:: forall era
4235
. IsEra era
43-
=> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
36+
=> [(Exp.Certificate (ShelleyLedgerEra era), AnyWitness (LedgerEra era))]
4437
-> Api.TxCertificates Api.BuildTx era
4538
mkTxCertificates [] = TxCertificatesNone
4639
mkTxCertificates certs =
47-
TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs
40+
TxCertificates (convert useEra) $ fromList $ map (getStakeCred useEra) certs
41+
where
4842
-- TxCertificate now uses experimental Certificate type therefore getStakeCred
4943
-- needs to be adjusted!
50-
where
44+
5145
getStakeCred
5246
:: Era era
53-
-> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
54-
-> ( Api.Certificate era
47+
-> (Exp.Certificate (ShelleyLedgerEra era), AnyWitness (LedgerEra era))
48+
-> ( Exp.Certificate (ShelleyLedgerEra era)
5549
, Api.BuildTxWith
5650
Api.BuildTx
5751
(Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era))
5852
)
59-
getStakeCred era (Certificate cert, witness) =
53+
getStakeCred era (cert, witness) =
6054
case era of
6155
ConwayEra -> do
62-
let oldApiCert = Api.ConwayCertificate (convert era) cert
56+
let Exp.Certificate c = cert
57+
oldApiCert = Api.ConwayCertificate (convert era) c
6358
mStakeCred = Api.selectStakeCredentialWitness oldApiCert
6459
wit =
6560
case witness of
@@ -69,9 +64,7 @@ mkTxCertificates certs =
6964
AnyPlutusScriptWitness psw ->
7065
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
7166
newToOldPlutusCertificateScriptWitness ConwayEra psw
72-
(oldApiCert, pure $ (,wit) <$> mStakeCred)
73-
74-
67+
(cert, pure $ (,wit) <$> mStakeCred)
7568

7669
newToOldSimpleScriptWitness
7770
:: L.AllegraEraScript (LedgerEra era)
@@ -123,4 +116,4 @@ newToOldPlutusScriptOrReferenceInput
123116
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PReferenceScript txin) = Api.PReferenceScript txin
124117
newToOldPlutusScriptOrReferenceInput ConwayEra (Exp.PScript (Exp.PlutusScriptInEra plutusRunnable)) =
125118
let oldScript = L.unPlutusBinary . L.plutusBinary $ L.plutusFromRunnable plutusRunnable
126-
in Api.PScript $ Api.PlutusScriptSerialised oldScript
119+
in Api.PScript $ Api.PlutusScriptSerialised oldScript

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

Lines changed: 22 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -575,7 +575,7 @@ data TxCertificates build era where
575575
TxCertificates
576576
:: ShelleyBasedEra era
577577
-> OMap
578-
(Exp.Certificate era)
578+
(Exp.Certificate (ShelleyLedgerEra era))
579579
( BuildTxWith
580580
build
581581
(Maybe (StakeCredential, Witness WitCtxStake era))
@@ -594,29 +594,40 @@ deriving instance Show (TxCertificates build era)
594594
-- credential registration certificates without a deposit. Future eras will require a witness for
595595
-- registration certificates, because the one without a deposit will be removed.
596596
mkTxCertificates
597-
:: Applicative (BuildTxWith build)
597+
:: forall era build
598+
. Applicative (BuildTxWith build)
598599
=> ShelleyBasedEra era
599-
-> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
600+
-> [(Exp.Certificate (ShelleyLedgerEra era), Maybe (ScriptWitness WitCtxStake era))]
600601
-> TxCertificates build era
601602
mkTxCertificates _ [] = TxCertificatesNone
602603
mkTxCertificates sbe certs = TxCertificates sbe . fromList $ map getStakeCred certs
603604
where
604-
getStakeCred (cert, mWit) = do
605+
getStakeCred
606+
:: (Exp.Certificate (ShelleyLedgerEra era), Maybe (ScriptWitness WitCtxStake era))
607+
-> ( Exp.Certificate (ShelleyLedgerEra era)
608+
, BuildTxWith build (Maybe (StakeCredential, Witness WitCtxStake era))
609+
)
610+
getStakeCred (c@(Exp.Certificate cert), mWit) = do
605611
let wit =
606612
maybe
607613
(KeyWitness KeyWitnessForStakeAddr)
608614
(ScriptWitness ScriptWitnessForStakeAddr)
609615
mWit
610-
( cert
616+
( c
611617
, pure $
612-
(,wit) <$> selectStakeCredentialWitness cert
618+
(,wit) <$> getTxCertWitness sbe cert
613619
)
614620

615621
-- | Index certificates with witnesses by the order they appear in the list (in the transaction).
616622
-- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
617623
indexTxCertificates
618624
:: TxCertificates BuildTx era
619-
-> [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
625+
-> [ ( ScriptWitnessIndex
626+
, Exp.Certificate (ShelleyLedgerEra era)
627+
, StakeCredential
628+
, Witness WitCtxStake era
629+
)
630+
]
620631
indexTxCertificates TxCertificatesNone = []
621632
indexTxCertificates (TxCertificates _ certsWits) =
622633
[ (ScriptWitnessIndexCertificate ix, cert, stakeCred, witness)
@@ -1760,7 +1771,7 @@ fromLedgerTxCertificates sbe body =
17601771
in if null certificates
17611772
then TxCertificatesNone
17621773
else
1763-
TxCertificates sbe . fromList $ map ((,ViewTx) . fromShelleyCertificate sbe) $ toList certificates
1774+
TxCertificates sbe . fromList $ map ((,ViewTx) . Exp.Certificate) $ toList certificates
17641775

17651776
maybeFromLedgerTxUpdateProposal
17661777
:: ()
@@ -1844,7 +1855,7 @@ convCertificates
18441855
-> Seq.StrictSeq (Shelley.TxCert (ShelleyLedgerEra era))
18451856
convCertificates _ = \case
18461857
TxCertificatesNone -> Seq.empty
1847-
TxCertificates _ cs -> fromList . map (toShelleyCertificate . fst) $ toList cs
1858+
TxCertificates _ cs -> fromList . map (\(Exp.Certificate c, _) -> c) $ toList cs
18481859

18491860
convWithdrawals :: TxWithdrawals build era -> L.Withdrawals
18501861
convWithdrawals txWithdrawals =
@@ -2981,10 +2992,10 @@ extractWitnessableCertificates
29812992
extractWitnessableCertificates aeon txCertificates =
29822993
alonzoEraOnwardsConstraints aeon $
29832994
List.nub
2984-
[ ( WitTxCert (certificateToTxCert cert) stakeCred
2995+
[ ( WitTxCert cert stakeCred
29852996
, BuildTxWith wit
29862997
)
2987-
| (cert, BuildTxWith (Just (stakeCred, wit))) <- getCertificates txCertificates
2998+
| (Exp.Certificate cert, BuildTxWith (Just (stakeCred, wit))) <- getCertificates txCertificates
29882999
]
29893000
where
29903001
getCertificates TxCertificatesNone = []

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -65,6 +65,7 @@ import Cardano.Api.Era.Internal.Eon.MaryEraOnwards
6565
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
6666
import Cardano.Api.Era.Internal.Feature
6767
import Cardano.Api.Error
68+
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
6869
import Cardano.Api.Ledger.Internal.Reexport qualified as L
6970
import Cardano.Api.Plutus
7071
import Cardano.Api.Pretty
@@ -1535,7 +1536,7 @@ substituteExecutionUnits
15351536
mapScriptWitnessesCertificates TxCertificatesNone = Right TxCertificatesNone
15361537
mapScriptWitnessesCertificates txCertificates'@(TxCertificates supported _) = do
15371538
let mappedScriptWitnesses
1538-
:: [ ( Certificate era
1539+
:: [ ( Exp.Certificate (ShelleyLedgerEra era)
15391540
, Either
15401541
(TxBodyErrorAutoBalance era)
15411542
( BuildTxWith

‎cardano-api/test/cardano-api-test/Test/Cardano/Api/Transaction/Autobalance.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -15,6 +15,7 @@ module Test.Cardano.Api.Transaction.Autobalance
1515
where
1616

1717
import Cardano.Api
18+
import Cardano.Api.Experimental qualified as Exp
1819
import Cardano.Api.Experimental.Tx
1920
import Cardano.Api.Ledger qualified as L
2021
import Cardano.Api.Parser.Text qualified as P
@@ -360,8 +361,8 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.propertyOnce
360361
stakeCred <- forAll genStakeCredential
361362
let certs =
362363
[
363-
( ConwayCertificate ceo $
364-
L.ConwayTxCertDeleg (L.ConwayUnRegCert (toShelleyStakeCredential stakeCred) (L.SJust deregDeposit))
364+
( Exp.Certificate
365+
(L.ConwayTxCertDeleg (L.ConwayUnRegCert (toShelleyStakeCredential stakeCred) (L.SJust deregDeposit)))
365366
, Nothing
366367
)
367368
]

0 commit comments

Comments
 (0)