Remove the era case combinators in favour of inEonForEra

.changes/remove-case-shelley-era-only-or-allegra-era-onwards.yml

@@ -0,0 +1,7 @@
+project: cardano-api
+pr: 1326
+kind:
+  - breaking
+  - refactoring
+description: |
+  Removed the era case combinators `caseByronOrShelleyBasedEra` and `caseShelleyToBabbageOrConwayEraOnwards`, along with the internal `caseShelleyEraOnlyOrAllegraEraOnwards`, and the now-empty `Cardano.Api.Era.Internal.Case` module. Use `inEonForEra` / `inEonForShelleyBasedEra` with the appropriate eon, or match on the era constructors where both branches need era constraints.

cardano-api/cardano-api.cabal

@@ -217,7 +217,6 @@ library
     Cardano.Api.Consensus.Internal.Mode
     Cardano.Api.Consensus.Internal.Protocol
     Cardano.Api.Consensus.Internal.Reexport
-    Cardano.Api.Era.Internal.Case
     Cardano.Api.Era.Internal.Core
     Cardano.Api.Era.Internal.Eon.AllegraEraOnwards
     Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards

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

@@ -2,6 +2,7 @@
 {-# LANGUAGE EmptyCase #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
@@ -849,58 +850,76 @@ genCertificate sbe =
 
 genStakeAddressRegistrationCertificate
   :: ShelleyBasedEra era -> Gen (Exp.Certificate (ShelleyLedgerEra era))
-genStakeAddressRegistrationCertificate =
-  caseShelleyToBabbageOrConwayEraOnwards
-    ( \w ->
-        shelleyToBabbageEraConstraints w $
-          Exp.Certificate . L.mkRegTxCert . toShelleyStakeCredential <$> genStakeCredential
-    )
-    ( \w ->
-        conwayEraOnwardsConstraints w $
-          Exp.Certificate
-            <$> ( L.mkRegDepositTxCert . toShelleyStakeCredential
-                    <$> genStakeCredential
-                    <*> genLovelace
-                )
-    )
+genStakeAddressRegistrationCertificate = \case
+  ShelleyBasedEraShelley -> preConway
+  ShelleyBasedEraAllegra -> preConway
+  ShelleyBasedEraMary -> preConway
+  ShelleyBasedEraAlonzo -> preConway
+  ShelleyBasedEraBabbage -> preConway
+  ShelleyBasedEraConway -> postConway
+  ShelleyBasedEraDijkstra -> postConway
+ where
+  preConway :: L.ShelleyEraTxCert ledgerera => Gen (Exp.Certificate ledgerera)
+  preConway =
+    Exp.Certificate . L.mkRegTxCert . toShelleyStakeCredential <$> genStakeCredential
+
+  postConway :: L.ConwayEraTxCert ledgerera => Gen (Exp.Certificate ledgerera)
+  postConway =
+    Exp.Certificate
+      <$> ( L.mkRegDepositTxCert . toShelleyStakeCredential
+              <$> genStakeCredential
+              <*> genLovelace
+          )
 
 genStakeAddressUnregistrationCertificate
   :: ShelleyBasedEra era -> Gen (Exp.Certificate (ShelleyLedgerEra era))
-genStakeAddressUnregistrationCertificate =
-  caseShelleyToBabbageOrConwayEraOnwards
-    ( \w ->
-        shelleyToBabbageEraConstraints w $
-          Exp.Certificate . L.mkUnRegTxCert . toShelleyStakeCredential <$> genStakeCredential
-    )
-    ( \w ->
-        conwayEraOnwardsConstraints w $
-          Exp.Certificate
-            <$> ( L.mkUnRegDepositTxCert . toShelleyStakeCredential
-                    <$> genStakeCredential
-                    <*> genLovelace
-                )
-    )
+genStakeAddressUnregistrationCertificate = \case
+  ShelleyBasedEraShelley -> preConway
+  ShelleyBasedEraAllegra -> preConway
+  ShelleyBasedEraMary -> preConway
+  ShelleyBasedEraAlonzo -> preConway
+  ShelleyBasedEraBabbage -> preConway
+  ShelleyBasedEraConway -> postConway
+  ShelleyBasedEraDijkstra -> postConway
+ where
+  preConway :: L.ShelleyEraTxCert ledgerera => Gen (Exp.Certificate ledgerera)
+  preConway =
+    Exp.Certificate . L.mkUnRegTxCert . toShelleyStakeCredential <$> genStakeCredential
+
+  postConway :: L.ConwayEraTxCert ledgerera => Gen (Exp.Certificate ledgerera)
+  postConway =
+    Exp.Certificate
+      <$> ( L.mkUnRegDepositTxCert . toShelleyStakeCredential
+              <$> genStakeCredential
+              <*> genLovelace
+          )
 
 genStakeAddressDelegationCertificate
   :: ShelleyBasedEra era -> Gen (Exp.Certificate (ShelleyLedgerEra era))
-genStakeAddressDelegationCertificate =
-  caseShelleyToBabbageOrConwayEraOnwards
-    ( \w ->
-        shelleyToBabbageEraConstraints w $
-          Exp.Certificate
-            <$> ( L.mkDelegStakeTxCert . toShelleyStakeCredential
-                    <$> genStakeCredential
-                    <*> (unStakePoolKeyHash <$> genVerificationKeyHash AsStakePoolKey)
-                )
-    )
-    ( \w ->
-        conwayEraOnwardsConstraints w $
-          Exp.Certificate
-            <$> ( L.mkDelegTxCert . toShelleyStakeCredential
-                    <$> genStakeCredential
-                    <*> Q.arbitrary
-                )
-    )
+genStakeAddressDelegationCertificate = \case
+  ShelleyBasedEraShelley -> preConway
+  ShelleyBasedEraAllegra -> preConway
+  ShelleyBasedEraMary -> preConway
+  ShelleyBasedEraAlonzo -> preConway
+  ShelleyBasedEraBabbage -> preConway
+  ShelleyBasedEraConway -> postConway
+  ShelleyBasedEraDijkstra -> postConway
+ where
+  preConway :: L.ShelleyEraTxCert ledgerera => Gen (Exp.Certificate ledgerera)
+  preConway =
+    Exp.Certificate
+      <$> ( L.mkDelegStakeTxCert . toShelleyStakeCredential
+              <$> genStakeCredential
+              <*> (unStakePoolKeyHash <$> genVerificationKeyHash AsStakePoolKey)
+          )
+
+  postConway :: L.ConwayEraTxCert ledgerera => Gen (Exp.Certificate ledgerera)
+  postConway =
+    Exp.Certificate
+      <$> ( L.mkDelegTxCert . toShelleyStakeCredential
+              <$> genStakeCredential
+              <*> Q.arbitrary
+          )
 
 genStakePoolRegistrationCertificate
   :: ShelleyBasedEra era -> Gen (Exp.Certificate (ShelleyLedgerEra era))

cardano-api/src/Cardano/Api/Era.hs

@@ -58,18 +58,9 @@ module Cardano.Api.Era
     , AsConwayEra
     , AsDijkstraEra
     )
-
-    -- * Era case handling
-
-    -- ** Case on CardanoEra
-  , caseByronOrShelleyBasedEra
-
-    -- ** Case on ShelleyBasedEra
-  , caseShelleyToBabbageOrConwayEraOnwards
   )
 where
 
-import Cardano.Api.Era.Internal.Case
 import Cardano.Api.Era.Internal.Core
 import Cardano.Api.Era.Internal.Eon.AllegraEraOnwards
 import Cardano.Api.Era.Internal.Eon.AlonzoEraOnwards

cardano-api/src/Cardano/Api/LedgerState.hs

@@ -110,9 +110,9 @@ import Cardano.Api.Byron.Internal.Proposal as Byron
 import Cardano.Api.Certificate.Internal
 import Cardano.Api.Consensus.Internal.Mode
 import Cardano.Api.Consensus.Internal.Mode qualified as Api
-import Cardano.Api.Era.Internal.Case
 import Cardano.Api.Era.Internal.Core (forEraInEon, forEraMaybeEon, toCardanoEra)
 import Cardano.Api.Era.Internal.Eon.BabbageEraOnwards
+import Cardano.Api.Era.Internal.Eon.ConwayEraOnwards (ConwayEraOnwards)
 import Cardano.Api.Era.Internal.Eon.ShelleyBasedEra
 import Cardano.Api.Error as Api
 import Cardano.Api.Genesis.Internal
@@ -2119,7 +2119,7 @@ nextEpochEligibleLeadershipSlots sbe sGen serCurrEpochState ptclState poolid (Vr
         stabilityWindowSlots :: SlotNo
         stabilityWindowSlots = fromIntegral @Word64 $ floor $ fromRational @Double stabilityWindowR
         stableStakeDistribSlot = currentEpochLastSlot - stabilityWindowSlots
-        stabilityWindowConst = caseShelleyToBabbageOrConwayEraOnwards (const 3) (const 4) sbe
+        stabilityWindowConst = inEonForShelleyBasedEra @ConwayEraOnwards 3 (const 4) sbe
 
     case cTip of
       ChainTipAtGenesis -> Left LeaderErrGenesisSlot

cardano-api/src/Cardano/Api/Network/IPC.hs

@@ -107,7 +107,7 @@ module Cardano.Api.Network.IPC
     -- @
     -- Api.AnyShelleyBasedEra sbe :: Api.AnyShelleyBasedEra <- case eEra of
     --   Right (Api.AnyCardanoEra era) ->
-    --     Api.caseByronOrShelleyBasedEra
+    --     Api.inEonForEra
     --       (error "Error, we are in Byron era")
     --       (return . Api.AnyShelleyBasedEra)
     --       era

cardano-api/src/Cardano/Api/Query/Internal/Convenience.hs

@@ -169,8 +169,8 @@ queryStateForBalancedTx era allTxIns certs = runExceptT $ do
               )
 
   featuredTxTreasuryValueM <-
-    caseShelleyToBabbageOrConwayEraOnwards
-      (const $ pure Nothing)
+    inEonForShelleyBasedEra
+      (pure Nothing)
       ( \cOnwards -> do
           ChainAccountState{casTreasury} <-
             lift (queryAccountState cOnwards)