Merge pull request #259 from input-output-hk/newhoggy/replace-Certifi…

…catesSupportedInEra-with-ShelleyBasedEra Replace `CertificatesSupportedInEra` with `ShelleyBasedEra`
IntersectMBO · Sep 26, 2023 · 680f0db · 680f0db
2 parents 4a2e1fb + 5f005f8
commit 680f0db
Show file tree

Hide file tree

Showing 3 changed files with 23 additions and 105 deletions.
diff --git a/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs b/cardano-api/gen/Test/Gen/Cardano/Api/Typed.hs
@@ -592,19 +592,17 @@ genTxWithdrawals era =
         ]
 
 genTxCertificates :: CardanoEra era -> Gen (TxCertificates BuildTx era)
-genTxCertificates era =
-  case certificatesSupportedInEra era of
-    Nothing -> pure TxCertificatesNone
-    Just supported ->
-      case cardanoEraStyle era of
-        LegacyByronEra -> pure TxCertificatesNone
-        ShelleyBasedEra sbe -> do
-          certs <- Gen.list (Range.constant 0 3) $ genCertificate sbe
-          Gen.choice
-            [ pure TxCertificatesNone
-            , pure (TxCertificates supported certs $ BuildTxWith mempty)
-              -- TODO: Generate certificates
-            ]
+genTxCertificates =
+  inEonForEra
+    (pure TxCertificatesNone)
+    (\w -> do
+      certs <- Gen.list (Range.constant 0 3) $ genCertificate w
+      Gen.choice
+        [ pure TxCertificatesNone
+        , pure (TxCertificates w certs $ BuildTxWith mempty)
+          -- TODO: Generate certificates
+        ]
+    )
 
 -- TODO: Add remaining certificates
 -- TODO: This should be parameterised on ShelleyBasedEra

diff --git a/cardano-api/internal/Cardano/Api/TxBody.hs b/cardano-api/internal/Cardano/Api/TxBody.hs
@@ -123,7 +123,6 @@ module Cardano.Api.TxBody (
     TxExtraKeyWitnessesSupportedInEra(..),
     AlonzoEraOnwards(..),
     WithdrawalsSupportedInEra(..),
-    CertificatesSupportedInEra(..),
     UpdateProposalSupportedInEra(..),
     TxTotalAndReturnCollateralSupportedInEra(..),
 
@@ -136,7 +135,6 @@ module Cardano.Api.TxBody (
     auxScriptsSupportedInEra,
     extraKeyWitnessesSupportedInEra,
     withdrawalsSupportedInEra,
-    certificatesSupportedInEra,
     updateProposalSupportedInEra,
     txScriptValiditySupportedInShelleyBasedEra,
     txScriptValiditySupportedInCardanoEra,
@@ -1116,35 +1114,6 @@ withdrawalsSupportedInEra AlonzoEra  = Just WithdrawalsInAlonzoEra
 withdrawalsSupportedInEra BabbageEra = Just WithdrawalsInBabbageEra
 withdrawalsSupportedInEra ConwayEra  = Just WithdrawalsInConwayEra
 
-
--- | A representation of whether the era supports 'Certificate's embedded in
--- transactions.
---
--- The Shelley and subsequent eras support such certificates.
---
-data CertificatesSupportedInEra era where
-
-     CertificatesInShelleyEra :: CertificatesSupportedInEra ShelleyEra
-     CertificatesInAllegraEra :: CertificatesSupportedInEra AllegraEra
-     CertificatesInMaryEra    :: CertificatesSupportedInEra MaryEra
-     CertificatesInAlonzoEra  :: CertificatesSupportedInEra AlonzoEra
-     CertificatesInBabbageEra :: CertificatesSupportedInEra BabbageEra
-     CertificatesInConwayEra  :: CertificatesSupportedInEra ConwayEra
-
-deriving instance Eq   (CertificatesSupportedInEra era)
-deriving instance Show (CertificatesSupportedInEra era)
-
-certificatesSupportedInEra :: CardanoEra era
-                           -> Maybe (CertificatesSupportedInEra era)
-certificatesSupportedInEra ByronEra   = Nothing
-certificatesSupportedInEra ShelleyEra = Just CertificatesInShelleyEra
-certificatesSupportedInEra AllegraEra = Just CertificatesInAllegraEra
-certificatesSupportedInEra MaryEra    = Just CertificatesInMaryEra
-certificatesSupportedInEra AlonzoEra  = Just CertificatesInAlonzoEra
-certificatesSupportedInEra BabbageEra = Just CertificatesInBabbageEra
-certificatesSupportedInEra ConwayEra  = Just CertificatesInConwayEra
-
-
 -- | A representation of whether the era supports 'UpdateProposal's embedded in
 -- transactions.
 --
@@ -1556,13 +1525,14 @@ deriving instance Show (TxWithdrawals build era)
 
 data TxCertificates build era where
 
-     TxCertificatesNone :: TxCertificates build era
+  TxCertificatesNone
+    :: TxCertificates build era
 
-     TxCertificates     :: CertificatesSupportedInEra era
-                        -> [Certificate era]
-                        -> BuildTxWith build
-                             (Map StakeCredential (Witness WitCtxStake era))
-                        -> TxCertificates build era
+  TxCertificates
+    :: ShelleyBasedEra era
+    -> [Certificate era]
+    -> BuildTxWith build (Map StakeCredential (Witness WitCtxStake era))
+    -> TxCertificates build era
 
 deriving instance Eq   (TxCertificates build era)
 deriving instance Show (TxCertificates build era)
@@ -3068,59 +3038,11 @@ fromLedgerTxCertificates
   -> Ledger.TxBody (ShelleyLedgerEra era)
   -> TxCertificates ViewTx era
 fromLedgerTxCertificates sbe body =
-  case sbe of
-    ShelleyBasedEraShelley
-      | null certificates -> TxCertificatesNone
-      | otherwise ->
-          TxCertificates
-            CertificatesInShelleyEra
-            (map (fromShelleyCertificate sbe) $ toList certificates)
-            ViewTx
-      where
-        certificates = body ^. L.certsTxBodyL
-
-    ShelleyBasedEraAllegra
-      | null certificates -> TxCertificatesNone
-      | otherwise ->
-          TxCertificates
-            CertificatesInAllegraEra
-            (map (fromShelleyCertificate sbe) $ toList certificates)
-            ViewTx
-      where
-        certificates = body ^. L.certsTxBodyL
-
-    ShelleyBasedEraMary
-      | null certificates -> TxCertificatesNone
-      | otherwise ->
-          TxCertificates
-            CertificatesInMaryEra
-            (map (fromShelleyCertificate sbe) $ toList certificates)
-            ViewTx
-      where
-        certificates = body ^. L.certsTxBodyL
-
-    ShelleyBasedEraAlonzo
-      | null certificates -> TxCertificatesNone
-      | otherwise ->
-          TxCertificates
-            CertificatesInAlonzoEra
-            (map (fromShelleyCertificate sbe) $ toList certificates)
-            ViewTx
-      where
-        certificates = body ^. L.certsTxBodyL
-
-    ShelleyBasedEraBabbage
-      | null certificates -> TxCertificatesNone
-      | otherwise ->
-          TxCertificates
-            CertificatesInBabbageEra
-            (map (fromShelleyCertificate sbe) $ toList certificates)
-            ViewTx
-      where
-        certificates = body ^. L.certsTxBodyL
-
-    -- TODO: Implement once certificates are done in Conway.
-    ShelleyBasedEraConway -> TxCertificatesNone
+  shelleyBasedEraConstraints sbe $
+    let certificates = body ^. L.certsTxBodyL in
+    if null certificates
+      then TxCertificatesNone
+      else TxCertificates sbe (map (fromShelleyCertificate sbe) $ toList certificates) ViewTx
 
 fromLedgerTxUpdateProposal
   :: ShelleyBasedEra era

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -390,7 +390,6 @@ module Cardano.Api (
     AuxScriptsSupportedInEra(..),
     TxExtraKeyWitnessesSupportedInEra(..),
     WithdrawalsSupportedInEra(..),
-    CertificatesSupportedInEra(..),
     UpdateProposalSupportedInEra(..),
     TxTotalAndReturnCollateralSupportedInEra(..),
 
@@ -403,7 +402,6 @@ module Cardano.Api (
     auxScriptsSupportedInEra,
     extraKeyWitnessesSupportedInEra,
     withdrawalsSupportedInEra,
-    certificatesSupportedInEra,
     updateProposalSupportedInEra,
     totalAndReturnCollateralSupportedInEra,