Review changes

Author: Jimbo4350

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

@@ -1,5 +1,4 @@
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE NamedFieldPuns #-}
@@ -770,40 +769,19 @@ genTxCertificates =
           [ pure TxCertificatesNone
           , pure
               ( TxCertificates w $
-                  fromList ((,BuildTxWith Nothing) <$> map (extractCertificate w) certs)
+                  fromList ((,BuildTxWith Nothing) <$> map extractCertificate certs)
               )
               -- TODO: Generate certificates
           ]
     )
 
 extractCertificate
-  :: ShelleyBasedEra era
-  -> Api.Certificate 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
+extractCertificate (Api.ShelleyRelatedCertificate w c) =
+  shelleyToBabbageEraConstraints w $ Exp.Certificate c
+extractCertificate (ConwayCertificate w c) =
+  conwayEraOnwardsConstraints w $ Exp.Certificate c
 
 genScriptWitnessedTxCertificates :: Typeable era => Exp.Era era -> Gen (TxCertificates BuildTx era)
 genScriptWitnessedTxCertificates era = do
@@ -815,7 +793,7 @@ genScriptWitnessedTxCertificates era = do
   let certsAndWits =
         zipWith
           (\c p -> (c, Just p))
-          (map (extractCertificate w) certs)
+          (map extractCertificate certs)
           plutusScriptWits
 
   pure $ mkTxCertificates (convert era) certsAndWits

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

@@ -103,6 +103,7 @@ import Cardano.Ledger.BaseTypes (strictMaybe)
 import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Keys qualified as Ledger
 
+import Control.Monad
 import Control.Monad.Except (MonadError (..))
 import Data.ByteString (ByteString)
 import Data.ByteString qualified as BS
@@ -579,16 +580,10 @@ filterUnRegDRepCreds
   -> Exp.Certificate (ShelleyLedgerEra era)
   -> Maybe (Ledger.Credential Ledger.DRepRole)
 filterUnRegDRepCreds sbe (Exp.Certificate cert) =
-  case sbe of
-    ShelleyBasedEraShelley -> Nothing
-    ShelleyBasedEraAllegra -> Nothing
-    ShelleyBasedEraMary -> Nothing
-    ShelleyBasedEraAlonzo -> Nothing
-    ShelleyBasedEraBabbage -> Nothing
-    ShelleyBasedEraConway ->
-      conwayEraOnwardsConstraints ConwayEraOnwardsConway $
-        fst
-          <$> Ledger.getUnRegDRepTxCert cert
+  join $ forEraInEonMaybe (toCardanoEra sbe) $ \w ->
+    conwayEraOnwardsConstraints w $
+      fst
+        <$> Ledger.getUnRegDRepTxCert cert
 
 -- ----------------------------------------------------------------------------
 -- Internal conversion functions

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

@@ -114,4 +114,4 @@ data AnchorDataFromCertificateError
 instance Error AnchorDataFromCertificateError where
   prettyError :: AnchorDataFromCertificateError -> Doc ann
   prettyError (InvalidPoolMetadataHashError url hash) =
-    "Invalid pool metadata hash for URL " <> fromString (show url) <> ": " <> fromString (show hash)
+    "Invalid pool metadata hash for URL " <> pretty url <> ": " <> fromString (show hash)