Replaced old certificate type with experimental type

Author: Jimbo4350

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -767,11 +768,43 @@ genTxCertificates =
         certs <- Gen.list (Range.constant 0 3) $ genCertificate w
         Gen.choice
           [ pure TxCertificatesNone
-          , pure (TxCertificates w $ fromList ((,BuildTxWith Nothing) <$> certs))
-          -- TODO: Generate certificates
+          , pure
+              ( TxCertificates w $
+                  fromList ((,BuildTxWith Nothing) <$> map (extractCertificate w) certs)
+              )
+              -- TODO: Generate certificates
           ]
     )
 
+extractCertificate
+  :: ShelleyBasedEra era
+  -> Api.Certificate era
+  -> Exp.Certificate (ShelleyLedgerEra era)
+extractCertificate ShelleyBasedEraShelley (Api.ShelleyRelatedCertificate _ c) =
+  Exp.Certificate c
+extractCertificate ShelleyBasedEraAllegra (Api.ShelleyRelatedCertificate _ c) =
+  Exp.Certificate c
+extractCertificate ShelleyBasedEraMary (Api.ShelleyRelatedCertificate _ c) =
+  Exp.Certificate c
+extractCertificate ShelleyBasedEraAlonzo (Api.ShelleyRelatedCertificate _ c) =
+  Exp.Certificate c
+extractCertificate ShelleyBasedEraBabbage (Api.ShelleyRelatedCertificate _ c) =
+  Exp.Certificate c
+extractCertificate ShelleyBasedEraConway (Api.ShelleyRelatedCertificate sToBab _) =
+  case sToBab :: ShelleyToBabbageEra ConwayEra of {}
+extractCertificate ShelleyBasedEraShelley (ConwayCertificate cOnwards _) =
+  case cOnwards :: ConwayEraOnwards ShelleyEra of {}
+extractCertificate ShelleyBasedEraAllegra (ConwayCertificate cOnwards _) =
+  case cOnwards :: ConwayEraOnwards AllegraEra of {}
+extractCertificate ShelleyBasedEraMary (ConwayCertificate cOnwards _) =
+  case cOnwards :: ConwayEraOnwards MaryEra of {}
+extractCertificate ShelleyBasedEraAlonzo (ConwayCertificate cOnwards _) =
+  case cOnwards :: ConwayEraOnwards AlonzoEra of {}
+extractCertificate ShelleyBasedEraBabbage (ConwayCertificate cOnwards _) =
+  case cOnwards :: ConwayEraOnwards BabbageEra of {}
+extractCertificate ShelleyBasedEraConway (ConwayCertificate _ c) =
+  Exp.Certificate c
+
 genScriptWitnessedTxCertificates :: Typeable era => Exp.Era era -> Gen (TxCertificates BuildTx era)
 genScriptWitnessedTxCertificates era = do
   let w = convert era
@@ -781,7 +814,7 @@ genScriptWitnessedTxCertificates era = do
   let certsAndWits =
         zipWith
           (\c p -> (c, Just p))
-          certs
+          (map (Exp.convertToNewCertificate era) certs)
           plutusScriptWits
 
   pure $ mkTxCertificates (convert era) certsAndWits

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

@@ -75,6 +75,7 @@ module Cardano.Api.Certificate.Internal
   , certificateToTxCert
   , filterUnRegCreds
   , filterUnRegDRepCreds
+  , getTxCertWitness
   , isDRepRegOrUpdateCert
   )
 where
@@ -118,6 +119,8 @@ import Network.Socket (PortNumber)
 -- Certificates embedded in transactions
 --
 
+{-# DEPRECATED Certificate "Use `Certificate` type from Cardano.Api.Experimental.Tx.Internal.Certificate instead" #-}
+
 data Certificate era where
   -- Pre-Conway
   --   1. Stake registration

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

@@ -16,8 +16,8 @@ module Cardano.Api.Compatible.Tx
 where
 
 import Cardano.Api.Address (StakeCredential)
-import Cardano.Api.Certificate.Internal (Certificate)
 import Cardano.Api.Era
+import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
 import Cardano.Api.Plutus.Internal.Script
 import Cardano.Api.ProtocolParameters
 import Cardano.Api.Tx.Internal.Body
@@ -155,7 +155,12 @@ createCompatibleTx sbe ins outs txFee' anyProtocolUpdate anyVote txCertificates'
       (L.bodyTxL . L.votingProceduresTxBodyL) .~ votingProcedures
 
   indexedTxCerts
-    :: [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
+    :: [ ( ScriptWitnessIndex
+         , Exp.Certificate (ShelleyLedgerEra era)
+         , StakeCredential
+         , Witness WitCtxStake era
+         )
+       ]
   indexedTxCerts = indexTxCertificates txCertificates'
 
   setScriptWitnesses

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

@@ -19,31 +19,18 @@ module Cardano.Api.Experimental.Tx.Internal.Certificate
 where
 
 import Cardano.Api.Certificate.Internal qualified as Api
-import Cardano.Api.Era.Internal.Eon.Convert
 import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Era.Internal.Eon.ShelleyToBabbageEra qualified as Api
 import Cardano.Api.Experimental.Era
-import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
-import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness qualified as Exp
-import Cardano.Api.Experimental.Simple.Script qualified as Exp
-import Cardano.Api.Experimental.Tx.Internal.AnyWitness
 import Cardano.Api.HasTypeProxy
 import Cardano.Api.Ledger qualified as L
-import Cardano.Api.Plutus.Internal.Script
-import Cardano.Api.Plutus.Internal.Script qualified as Api
 import Cardano.Api.Serialise.Cbor
 import Cardano.Api.Serialise.TextEnvelope.Internal
-import Cardano.Api.Tx.Internal.Body (TxCertificates (..))
-import Cardano.Api.Tx.Internal.Body qualified as Api
 
 import Cardano.Binary qualified as CBOR
-import Cardano.Ledger.Allegra.Scripts qualified as L
-import Cardano.Ledger.Plutus.Language qualified as L
-import Cardano.Ledger.Plutus.Language qualified as Plutus
 
 import Data.Typeable
-import GHC.IsList
 
 data Certificate era where
   Certificate :: L.EraTxCert era => L.TxCert era -> Certificate era
@@ -83,7 +70,7 @@ convertToOldApiCertificate :: Era era -> Certificate (LedgerEra era) -> Api.Cert
 convertToOldApiCertificate ConwayEra (Certificate cert) =
   Api.ConwayCertificate ConwayEraOnwardsConway cert
 
-convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (LedgerEra era)
+convertToNewCertificate :: Era era -> Api.Certificate era -> Certificate (ShelleyLedgerEra era)
 convertToNewCertificate ConwayEra (Api.ConwayCertificate _ cert) = Certificate cert
 convertToNewCertificate ConwayEra (Api.ShelleyRelatedCertificate sToBab _) =
   case sToBab :: Api.ShelleyToBabbageEra ConwayEra of {}

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

@@ -11,19 +11,19 @@ where
 import Cardano.Api.Address qualified as Api
 import Cardano.Api.Certificate.Internal qualified as Api
 import Cardano.Api.Era.Internal.Eon.Convert
+import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Experimental.Era
 import Cardano.Api.Experimental.Plutus.Internal.Script qualified as Exp
 import Cardano.Api.Experimental.Plutus.Internal.ScriptWitness qualified as Exp
 import Cardano.Api.Experimental.Simple.Script qualified as Exp
 import Cardano.Api.Experimental.Tx.Internal.AnyWitness
-import Cardano.Api.Experimental.Tx.Internal.Certificate
+import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
 import Cardano.Api.Plutus.Internal.Script (fromAllegraTimelock, sbeToSimpleScriptLanguageInEra)
 import Cardano.Api.Plutus.Internal.Script qualified as Api
 import Cardano.Api.Tx.Internal.Body (TxCertificates (..))
 import Cardano.Api.Tx.Internal.Body qualified as Api
 
-import Cardano.Binary
 import Cardano.Ledger.Allegra.Scripts qualified as L
 import Cardano.Ledger.Alonzo.Scripts qualified as L
 import Cardano.Ledger.Plutus.Language qualified as L
@@ -34,7 +34,7 @@ import GHC.Exts (IsList (..))
 mkTxCertificates
   :: forall era
    . IsEra era
-  => [(Certificate (LedgerEra era), AnyWitness (LedgerEra era))]
+  => [(Exp.Certificate (ShelleyLedgerEra era), AnyWitness (LedgerEra era))]
   -> Api.TxCertificates Api.BuildTx era
 mkTxCertificates [] = TxCertificatesNone
 mkTxCertificates certs =
@@ -45,16 +45,17 @@ mkTxCertificates certs =
 
   getStakeCred
     :: Era era
-    -> (Certificate (LedgerEra era), AnyWitness (LedgerEra era))
-    -> ( Api.Certificate era
+    -> (Exp.Certificate (ShelleyLedgerEra era), AnyWitness (LedgerEra era))
+    -> ( Exp.Certificate (ShelleyLedgerEra era)
        , Api.BuildTxWith
            Api.BuildTx
            (Maybe (Api.StakeCredential, Api.Witness Api.WitCtxStake era))
        )
-  getStakeCred era (Certificate cert, witness) =
+  getStakeCred era (cert, witness) =
     case era of
       ConwayEra -> do
-        let oldApiCert = Api.ConwayCertificate (convert era) cert
+        let Exp.Certificate c = cert
+            oldApiCert = Api.ConwayCertificate (convert era) c
             mStakeCred = Api.selectStakeCredentialWitness oldApiCert
             wit =
               case witness of
@@ -64,7 +65,7 @@ mkTxCertificates certs =
                 AnyPlutusScriptWitness psw ->
                   Api.ScriptWitness Api.ScriptWitnessForStakeAddr $
                     newToOldPlutusCertificateScriptWitness ConwayEra psw
-        (oldApiCert, pure $ (,wit) <$> mStakeCred)
+        (cert, pure $ (,wit) <$> mStakeCred)
 
 newToOldSimpleScriptWitness
   :: L.AllegraEraScript (LedgerEra era)

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

@@ -575,7 +575,7 @@ data TxCertificates build era where
   TxCertificates
     :: ShelleyBasedEra era
     -> OMap
-         (Exp.Certificate era)
+         (Exp.Certificate (ShelleyLedgerEra era))
          ( BuildTxWith
              build
              (Maybe (StakeCredential, Witness WitCtxStake era))
@@ -594,29 +594,40 @@ deriving instance Show (TxCertificates build era)
 -- credential registration certificates without a deposit. Future eras will require a witness for
 -- registration certificates, because the one without a deposit will be removed.
 mkTxCertificates
-  :: Applicative (BuildTxWith build)
+  :: forall era build
+   . Applicative (BuildTxWith build)
   => ShelleyBasedEra era
-  -> [(Certificate era, Maybe (ScriptWitness WitCtxStake era))]
+  -> [(Exp.Certificate (ShelleyLedgerEra era), Maybe (ScriptWitness WitCtxStake era))]
   -> TxCertificates build era
 mkTxCertificates _ [] = TxCertificatesNone
 mkTxCertificates sbe certs = TxCertificates sbe . fromList $ map getStakeCred certs
  where
-  getStakeCred (cert, mWit) = do
+  getStakeCred
+    :: (Exp.Certificate (ShelleyLedgerEra era), Maybe (ScriptWitness WitCtxStake era))
+    -> ( Exp.Certificate (ShelleyLedgerEra era)
+       , BuildTxWith build (Maybe (StakeCredential, Witness WitCtxStake era))
+       )
+  getStakeCred (c@(Exp.Certificate cert), mWit) = do
     let wit =
           maybe
             (KeyWitness KeyWitnessForStakeAddr)
             (ScriptWitness ScriptWitnessForStakeAddr)
             mWit
-    ( cert
+    ( c
       , pure $
-          (,wit) <$> selectStakeCredentialWitness cert
+          (,wit) <$> getTxCertWitness sbe cert
       )
 
 -- | Index certificates with witnesses by the order they appear in the list (in the transaction).
 -- See section 4.1 of https://github.com/intersectmbo/cardano-ledger/releases/latest/download/alonzo-ledger.pdf
 indexTxCertificates
   :: TxCertificates BuildTx era
-  -> [(ScriptWitnessIndex, Certificate era, StakeCredential, Witness WitCtxStake era)]
+  -> [ ( ScriptWitnessIndex
+       , Exp.Certificate (ShelleyLedgerEra era)
+       , StakeCredential
+       , Witness WitCtxStake era
+       )
+     ]
 indexTxCertificates TxCertificatesNone = []
 indexTxCertificates (TxCertificates _ certsWits) =
   [ (ScriptWitnessIndexCertificate ix, cert, stakeCred, witness)
@@ -1760,7 +1771,7 @@ fromLedgerTxCertificates sbe body =
      in if null certificates
           then TxCertificatesNone
           else
-            TxCertificates sbe . fromList $ map ((,ViewTx) . fromShelleyCertificate sbe) $ toList certificates
+            TxCertificates sbe . fromList $ map ((,ViewTx) . Exp.Certificate) $ toList certificates
 
 maybeFromLedgerTxUpdateProposal
   :: ()
@@ -1844,7 +1855,7 @@ convCertificates
   -> Seq.StrictSeq (Shelley.TxCert (ShelleyLedgerEra era))
 convCertificates _ = \case
   TxCertificatesNone -> Seq.empty
-  TxCertificates _ cs -> fromList . map (toShelleyCertificate . fst) $ toList cs
+  TxCertificates _ cs -> fromList . map (\(Exp.Certificate c, _) -> c) $ toList cs
 
 convWithdrawals :: TxWithdrawals build era -> L.Withdrawals
 convWithdrawals txWithdrawals =
@@ -2981,10 +2992,10 @@ extractWitnessableCertificates
 extractWitnessableCertificates aeon txCertificates =
   alonzoEraOnwardsConstraints aeon $
     List.nub
-      [ ( WitTxCert (certificateToTxCert cert) stakeCred
+      [ ( WitTxCert cert stakeCred
         , BuildTxWith wit
         )
-      | (cert, BuildTxWith (Just (stakeCred, wit))) <- getCertificates txCertificates
+      | (Exp.Certificate cert, BuildTxWith (Just (stakeCred, wit))) <- getCertificates txCertificates
       ]
  where
   getCertificates TxCertificatesNone = []

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

@@ -65,6 +65,7 @@ import Cardano.Api.Era.Internal.Eon.MaryEraOnwards
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Era.Internal.Feature
 import Cardano.Api.Error
+import Cardano.Api.Experimental.Tx.Internal.Certificate qualified as Exp
 import Cardano.Api.Ledger.Internal.Reexport qualified as L
 import Cardano.Api.Plutus
 import Cardano.Api.Pretty
@@ -1535,7 +1536,7 @@ substituteExecutionUnits
     mapScriptWitnessesCertificates TxCertificatesNone = Right TxCertificatesNone
     mapScriptWitnessesCertificates txCertificates'@(TxCertificates supported _) = do
       let mappedScriptWitnesses
-            :: [ ( Certificate era
+            :: [ ( Exp.Certificate (ShelleyLedgerEra era)
                  , Either
                      (TxBodyErrorAutoBalance era)
                      ( BuildTxWith

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

@@ -15,6 +15,7 @@ module Test.Cardano.Api.Transaction.Autobalance
 where
 
 import Cardano.Api
+import Cardano.Api.Experimental qualified as Exp
 import Cardano.Api.Experimental.Tx
 import Cardano.Api.Ledger qualified as L
 import Cardano.Api.Parser.Text qualified as P
@@ -360,8 +361,8 @@ prop_make_transaction_body_autobalance_when_deregistering_certs = H.propertyOnce
   stakeCred <- forAll genStakeCredential
   let certs =
         [
-          ( ConwayCertificate ceo $
-              L.ConwayTxCertDeleg (L.ConwayUnRegCert (toShelleyStakeCredential stakeCred) (L.SJust deregDeposit))
+          ( Exp.Certificate
+              (L.ConwayTxCertDeleg (L.ConwayUnRegCert (toShelleyStakeCredential stakeCred) (L.SJust deregDeposit)))
           , Nothing
           )
         ]