Skip to content

Commit 34eb78c

Browse files
committed
Replaced old certificate type with experimental type
1 parent e4aab41 commit 34eb78c

File tree

8 files changed

+83
-41
lines changed

8 files changed

+83
-41
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: 3 additions & 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
@@ -118,6 +119,8 @@ import Network.Socket (PortNumber)
118119
-- Certificates embedded in transactions
119120
--
120121

122+
{-# DEPRECATED Certificate "Use `Certificate` type from Cardano.Api.Experimental.Tx.Internal.Certificate instead" #-}
123+
121124
data Certificate era where
122125
-- Pre-Conway
123126
-- 1. Stake registration

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: 9 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -11,19 +11,19 @@ where
1111
import Cardano.Api.Address qualified as Api
1212
import Cardano.Api.Certificate.Internal qualified as Api
1313
import Cardano.Api.Era.Internal.Eon.Convert
14+
import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
1415
import Cardano.Api.Experimental.Era
1516
import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
1617
import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness qualified as Exp
1718
import Cardano.Api.Experimental.Simple.Script qualified as Exp
1819
import Cardano.Api.Experimental.Tx.Internal.AnyWitness
19-
import Cardano.Api.Experimental.Tx.Internal.Certificate
20+
import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
2021
import Cardano.Api.Ledger.Internal.Reexport qualified as L
2122
import Cardano.Api.Plutus.Internal.Script (fromAllegraTimelock, sbeToSimpleScriptLanguageInEra)
2223
import Cardano.Api.Plutus.Internal.Script qualified as Api
2324
import Cardano.Api.Tx.Internal.Body (TxCertificates (..))
2425
import Cardano.Api.Tx.Internal.Body qualified as Api
2526

26-
import Cardano.Binary
2727
import Cardano.Ledger.Allegra.Scripts qualified as L
2828
import Cardano.Ledger.Alonzo.Scripts qualified as L
2929
import Cardano.Ledger.Plutus.Language qualified as L
@@ -34,7 +34,7 @@ import GHC.Exts (IsList (..))
3434
mkTxCertificates
3535
:: forall era
3636
. IsEra era
37-
=> [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
37+
=> [(Exp.Certificate (ShelleyLedgerEra era), AnyWitness (LedgerEra era))]
3838
-> Api.TxCertificates Api.BuildTx era
3939
mkTxCertificates [] = TxCertificatesNone
4040
mkTxCertificates certs =
@@ -45,16 +45,17 @@ mkTxCertificates certs =
4545

4646
getStakeCred
4747
:: Era era
48-
-> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
49-
-> ( Api.Certificate era
48+
-> (Exp.Certificate (ShelleyLedgerEra era), AnyWitness (LedgerEra era))
49+
-> ( Exp.Certificate (ShelleyLedgerEra era)
5050
, Api.BuildTxWith
5151
Api.BuildTx
5252
(Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era))
5353
)
54-
getStakeCred era (Certificate cert, witness) =
54+
getStakeCred era (cert, witness) =
5555
case era of
5656
ConwayEra -> do
57-
let oldApiCert = Api.ConwayCertificate (convert era) cert
57+
let Exp.Certificate c = cert
58+
oldApiCert = Api.ConwayCertificate (convert era) c
5859
mStakeCred = Api.selectStakeCredentialWitness oldApiCert
5960
wit =
6061
case witness of
@@ -64,7 +65,7 @@ mkTxCertificates certs =
6465
AnyPlutusScriptWitness psw ->
6566
Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
6667
newToOldPlutusCertificateScriptWitness ConwayEra psw
67-
(oldApiCert, pure $ (,wit) <$> mStakeCred)
68+
(cert, pure $ (,wit) <$> mStakeCred)
6869

6970
newToOldSimpleScriptWitness
7071
:: L.AllegraEraScript (LedgerEra era)

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)