Convert CertState to a type family

eras/allegra/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.7.0.0
 
+* Converted `CertState` to a type family
 * Made the fields of predicate failures and environments lazy
 * Add `Era era` constraint to `NoThunks` instance for `TimeLock`
 * Remove `Era era` constraint from:

eras/allegra/impl/cardano-ledger-allegra.cabal

@@ -34,6 +34,7 @@ library
 
   hs-source-dirs: src
   other-modules:
+    Cardano.Ledger.Allegra.CertState
     Cardano.Ledger.Allegra.Era
     Cardano.Ledger.Allegra.PParams
     Cardano.Ledger.Allegra.Rules.Bbody

eras/allegra/impl/src/Cardano/Ledger/Allegra/CertState.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.Ledger.Allegra.CertState (
+  ShelleyCertState (..),
+  toCertStatePairs,
+) where
+
+import Cardano.Ledger.Allegra.Era (AllegraEra)
+import Cardano.Ledger.CertState
+import Cardano.Ledger.Shelley.CertState
+import Data.Coerce (coerce)
+
+instance EraCertState AllegraEra where
+  type CertState AllegraEra = ShelleyCertState AllegraEra
+
+  mkCertState = mkShelleyCertState
+
+  upgradeCertState = coerce
+
+  certDStateL = shelleyCertDStateL
+  {-# INLINE certDStateL #-}
+
+  certVStateL = shelleyCertVStateL
+  {-# INLINE certVStateL #-}
+
+  certPStateL = shelleyCertPStateL
+  {-# INLINE certPStateL #-}
+
+  obligationCertState = shelleyObligationCertState
+
+  certsTotalDepositsTxBody = shelleyCertsTotalDepositsTxBody
+
+  certsTotalRefundsTxBody = shelleyCertsTotalRefundsTxBody

eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxo.hs

@@ -39,7 +39,7 @@ import Cardano.Ledger.BaseTypes (
  )
 import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), serialize)
 import Cardano.Ledger.Binary.Coders
-import Cardano.Ledger.CertState (certDState, dsGenDelegs)
+import Cardano.Ledger.CertState (EraCertState (..))
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Rules.ValidationMode (Test, runTest)
 import qualified Cardano.Ledger.Shelley.LedgerState as Shelley
@@ -175,13 +175,14 @@ utxoTransition ::
   , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
   , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era
   , EraRule "UTXO" era ~ AllegraUTXO era
+  , EraCertState era
   ) =>
   TransitionRule (EraRule "UTXO" era)
 utxoTransition = do
   TRC (Shelley.UtxoEnv slot pp certState, utxos, tx) <- judgmentContext
   let Shelley.UTxOState utxo _ _ ppup _ _ = utxos
       txBody = tx ^. bodyTxL
-      genDelegs = dsGenDelegs (certDState certState)
+      genDelegs = certState ^. Shelley.certDStateL . Shelley.dsGenDelegsL
 
   {- ininterval slot (txvld tx) -}
   runTest $ validateOutsideValidityIntervalUTxO slot txBody
@@ -308,6 +309,7 @@ instance
   , GovState era ~ ShelleyGovState era
   , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
   , InjectRuleFailure "UTXO" Shelley.ShelleyUtxoPredFailure era
+  , EraCertState era
   ) =>
   STS (AllegraUTXO era)
   where

eras/allegra/impl/src/Cardano/Ledger/Allegra/Rules/Utxow.hs

@@ -14,6 +14,7 @@ import Cardano.Ledger.Allegra.Core
 import Cardano.Ledger.Allegra.Era (AllegraEra, AllegraUTXOW)
 import Cardano.Ledger.Allegra.Rules.Utxo (AllegraUTXO, AllegraUtxoPredFailure)
 import Cardano.Ledger.BaseTypes
+import Cardano.Ledger.CertState
 import Cardano.Ledger.Shelley.LedgerState (UTxOState)
 import Cardano.Ledger.Shelley.Rules (
   ShelleyPpupPredFailure,
@@ -58,6 +59,7 @@ instance
   , Signal (EraRule "UTXO" era) ~ Tx era
   , EraRule "UTXOW" era ~ AllegraUTXOW era
   , InjectRuleFailure "UTXOW" ShelleyUtxowPredFailure era
+  , EraCertState era
   ) =>
   STS (AllegraUTXOW era)
   where

eras/allegra/impl/src/Cardano/Ledger/Allegra/Transition.hs

@@ -5,6 +5,7 @@
 
 module Cardano.Ledger.Allegra.Transition (TransitionConfig (..)) where
 
+import Cardano.Ledger.Allegra.CertState ()
 import Cardano.Ledger.Allegra.Era
 import Cardano.Ledger.Allegra.Translation ()
 import Cardano.Ledger.Genesis (NoGenesis (..))

eras/allegra/impl/src/Cardano/Ledger/Allegra/Translation.hs

@@ -12,15 +12,16 @@
 
 module Cardano.Ledger.Allegra.Translation (shelleyToAllegraAVVMsToDelete) where
 
+import Cardano.Ledger.Allegra.CertState ()
 import Cardano.Ledger.Allegra.Era (AllegraEra)
 import Cardano.Ledger.Allegra.Tx ()
 import Cardano.Ledger.Binary (DecoderError)
 import Cardano.Ledger.CertState (CommitteeState (..))
 import Cardano.Ledger.Genesis (NoGenesis (..))
 import Cardano.Ledger.Shelley (ShelleyEra)
+import Cardano.Ledger.Shelley.CertState (ShelleyCertState)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.LedgerState (
-  CertState (..),
   DState (..),
   EpochState (..),
   LedgerState (..),
@@ -143,14 +144,7 @@ instance TranslateEra AllegraEra VState where
 instance TranslateEra AllegraEra PState where
   translateEra _ PState {..} = pure PState {..}
 
-instance TranslateEra AllegraEra CertState where
-  translateEra ctxt ls =
-    pure
-      CertState
-        { certDState = translateEra' ctxt $ certDState ls
-        , certPState = translateEra' ctxt $ certPState ls
-        , certVState = translateEra' ctxt $ certVState ls
-        }
+instance TranslateEra AllegraEra ShelleyCertState
 
 instance TranslateEra AllegraEra LedgerState where
   translateEra ctxt ls =

eras/allegra/impl/src/Cardano/Ledger/Allegra/UTxO.hs

@@ -6,6 +6,7 @@
 
 module Cardano.Ledger.Allegra.UTxO () where
 
+import Cardano.Ledger.Allegra.CertState ()
 import Cardano.Ledger.Allegra.Core
 import Cardano.Ledger.Allegra.Era (AllegraEra)
 import Cardano.Ledger.Shelley.UTxO (

eras/alonzo/impl/CHANGELOG.md

@@ -2,6 +2,7 @@
 
 ## 1.13.0.0
 
+* Converted `CertState` to a type family
 * Remove `reapplyAlonzoTx` as no longer needed.
 * Add `TxInfoResult` data family, `mkTxInfoResult` and `lookupTxInfoResult` to `EraPlutusContext`
 * Add `lookupTxInfoResultImpossible` helper
@@ -15,6 +16,7 @@
 
 ### `testlib`
 
+* Converted `CertState` to a type family
 * Expose `alonzoFixupFees`
 
 ## 1.12.0.0

eras/alonzo/impl/cardano-ledger-alonzo.cabal

@@ -48,6 +48,7 @@ library
 
   hs-source-dirs: src
   other-modules:
+    Cardano.Ledger.Alonzo.CertState
     Cardano.Ledger.Alonzo.Era
     Cardano.Ledger.Alonzo.Rules.Bbody
     Cardano.Ledger.Alonzo.Rules.Deleg

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/CertState.hs

@@ -0,0 +1,39 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Cardano.Ledger.Alonzo.CertState (
+  ShelleyCertState (..),
+  toCertStatePairs,
+) where
+
+import Cardano.Ledger.Alonzo.Era (AlonzoEra)
+import Cardano.Ledger.CertState
+import Cardano.Ledger.Shelley.CertState
+import Data.Coerce (coerce)
+
+instance EraCertState AlonzoEra where
+  type CertState AlonzoEra = ShelleyCertState AlonzoEra
+
+  mkCertState = mkShelleyCertState
+
+  upgradeCertState = coerce
+
+  certDStateL = shelleyCertDStateL
+  {-# INLINE certDStateL #-}
+
+  certVStateL = shelleyCertVStateL
+  {-# INLINE certVStateL #-}
+
+  certPStateL = shelleyCertPStateL
+  {-# INLINE certPStateL #-}
+
+  obligationCertState = shelleyObligationCertState
+
+  certsTotalDepositsTxBody = shelleyCertsTotalDepositsTxBody
+
+  certsTotalRefundsTxBody = shelleyCertsTotalRefundsTxBody

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Ledger.hs

@@ -23,9 +23,10 @@ import Cardano.Ledger.Alonzo.Rules.Utxos (AlonzoUtxosPredFailure)
 import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUTXOW, AlonzoUtxowEvent, AlonzoUtxowPredFailure)
 import Cardano.Ledger.Alonzo.Tx (AlonzoEraTx (..), AlonzoTx (..), IsValid (..))
 import Cardano.Ledger.BaseTypes (ShelleyBase)
+import Cardano.Ledger.CertState (EraCertState)
 import Cardano.Ledger.Shelley.Core
 import Cardano.Ledger.Shelley.LedgerState (
-  CertState (..),
+  CertState,
   LedgerState (..),
   UTxOState (..),
  )
@@ -166,6 +167,7 @@ instance
   , State (EraRule "DELEGS" era) ~ CertState era
   , Signal (EraRule "DELEGS" era) ~ Seq (TxCert era)
   , ProtVerAtMost era 8
+  , EraCertState era
   ) =>
   STS (AlonzoLEDGER era)
   where

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -78,6 +78,7 @@ import Cardano.Ledger.Binary.Coders (
   (!>),
   (<!),
  )
+import Cardano.Ledger.CertState (EraCertState)
 import Cardano.Ledger.Coin (Coin (unCoin), DeltaCoin, rationalToCoinViaCeiling, toDeltaCoin)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Credential (Credential (..))
@@ -484,6 +485,7 @@ utxoTransition ::
   , Environment (EraRule "UTXOS" era) ~ UtxoEnv era
   , State (EraRule "UTXOS" era) ~ UTxOState era
   , Signal (EraRule "UTXOS" era) ~ Tx era
+  , EraCertState era
   ) =>
   TransitionRule (EraRule "UTXO" era)
 utxoTransition = do
@@ -571,6 +573,7 @@ instance
   , InjectRuleFailure "UTXO" AlonzoUtxoPredFailure era
   , InjectRuleFailure "UTXO" AllegraUtxoPredFailure era
   , ProtVerAtMost era 8
+  , EraCertState era
   ) =>
   STS (AlonzoUTXO era)
   where

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxos.hs

@@ -58,7 +58,7 @@ import Cardano.Ledger.Binary (
  )
 import Cardano.Ledger.Binary.Coders
 import qualified Cardano.Ledger.Binary.Plain as Plain
-import Cardano.Ledger.CertState (certDState, dsGenDelegs)
+import Cardano.Ledger.CertState (EraCertState (..))
 import Cardano.Ledger.Coin (Coin)
 import Cardano.Ledger.Plutus.Evaluate (
   PlutusWithContext,
@@ -125,6 +125,7 @@ instance
   , Eq (EraRuleFailure "PPUP" era)
   , Show (EraRuleFailure "PPUP" era)
   , EraPlutusContext era
+  , EraCertState era
   ) =>
   STS (AlonzoUTXOS era)
   where
@@ -192,6 +193,7 @@ utxosTransition ::
   , Eq (EraRuleFailure "PPUP" era)
   , Show (EraRuleFailure "PPUP" era)
   , EraPlutusContext era
+  , EraCertState era
   ) =>
   TransitionRule (AlonzoUTXOS era)
 utxosTransition =
@@ -249,13 +251,14 @@ alonzoEvalScriptsTxValid ::
   , GovState era ~ ShelleyGovState era
   , State (EraRule "PPUP" era) ~ ShelleyGovState era
   , EraPlutusContext era
+  , EraCertState era
   ) =>
   TransitionRule (AlonzoUTXOS era)
 alonzoEvalScriptsTxValid = do
   TRC (UtxoEnv slot pp certState, utxos@(UTxOState utxo _ _ pup _ _), tx) <-
     judgmentContext
   let txBody = tx ^. bodyTxL
-      genDelegs = dsGenDelegs (certDState certState)
+      genDelegs = certState ^. certDStateL . Shelley.dsGenDelegsL
 
   () <- pure $! Debug.traceEvent validBegin ()
 

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs

@@ -56,7 +56,7 @@ import Cardano.Ledger.BaseTypes (
  )
 import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..))
 import Cardano.Ledger.Binary.Coders
-import Cardano.Ledger.CertState (certDState, dsGenDelegs)
+import Cardano.Ledger.CertState (EraCertState (..), dsGenDelegsL)
 import Cardano.Ledger.Rules.ValidationMode (Test, runTest, runTestOnSignal)
 import Cardano.Ledger.Shelley.LedgerState (UTxOState (..))
 import Cardano.Ledger.Shelley.Rules (
@@ -324,6 +324,7 @@ alonzoStyleWitness ::
   , Environment (EraRule "UTXO" era) ~ UtxoEnv era
   , State (EraRule "UTXO" era) ~ UTxOState era
   , Signal (EraRule "UTXO" era) ~ Tx era
+  , EraCertState era
   ) =>
   TransitionRule (EraRule "UTXOW" era)
 alonzoStyleWitness = do
@@ -370,7 +371,7 @@ alonzoStyleWitness = do
   -- check genesis keys signatures for instantaneous rewards certificates
   {-  genSig := { hashKey gkey | gkey ∈ dom(genDelegs)} ∩ witsKeyHashes  -}
   {-  { c ∈ txcerts txb ∩ TxCert_mir} ≠ ∅  ⇒ (|genSig| ≥ Quorum) ∧ (d pp > 0)  -}
-  let genDelegs = dsGenDelegs (certDState certState)
+  let genDelegs = certState ^. certDStateL . dsGenDelegsL
   coreNodeQuorum <- liftSTS $ asks quorum
   runTest $
     Shelley.validateMIRInsufficientGenesisSigs genDelegs coreNodeQuorum witsKeyHashes tx
@@ -416,6 +417,7 @@ instance
   , Environment (EraRule "UTXO" era) ~ UtxoEnv era
   , State (EraRule "UTXO" era) ~ UTxOState era
   , Signal (EraRule "UTXO" era) ~ Tx era
+  , EraCertState era
   ) =>
   STS (AlonzoUTXOW era)
   where

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Translation.hs

@@ -12,16 +12,17 @@
 
 module Cardano.Ledger.Alonzo.Translation where
 
+import Cardano.Ledger.Alonzo.CertState ()
 import Cardano.Ledger.Alonzo.Core hiding (Tx)
 import qualified Cardano.Ledger.Alonzo.Core as Core
 import Cardano.Ledger.Alonzo.Era (AlonzoEra)
 import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
 import Cardano.Ledger.Alonzo.PParams ()
 import Cardano.Ledger.Alonzo.Tx (AlonzoTx (..), IsValid (..))
 import Cardano.Ledger.Binary (DecoderError)
-import Cardano.Ledger.CertState (CommitteeState (..), PState (..), VState (..))
+import Cardano.Ledger.CertState (CommitteeState (..), EraCertState (..), PState (..), VState (..))
+import Cardano.Ledger.Shelley.CertState (ShelleyCertState)
 import Cardano.Ledger.Shelley.LedgerState (
-  CertState (..),
   DState (..),
   EpochState (..),
   LedgerState (..),
@@ -116,14 +117,8 @@ instance TranslateEra AlonzoEra VState where
 instance TranslateEra AlonzoEra PState where
   translateEra _ PState {..} = pure PState {..}
 
-instance TranslateEra AlonzoEra CertState where
-  translateEra ctxt ls =
-    pure
-      CertState
-        { certDState = translateEra' ctxt $ certDState ls
-        , certPState = translateEra' ctxt $ certPState ls
-        , certVState = translateEra' ctxt $ certVState ls
-        }
+instance TranslateEra AlonzoEra ShelleyCertState where
+  translateEra (AlonzoGenesisWrapper _scs) = pure . upgradeCertState
 
 instance TranslateEra AlonzoEra LedgerState where
   translateEra ctxt ls =

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/UTxO.hs

@@ -33,12 +33,13 @@ module Cardano.Ledger.Alonzo.UTxO (
 )
 where
 
+import Cardano.Ledger.Alonzo.CertState ()
 import Cardano.Ledger.Alonzo.Core
 import Cardano.Ledger.Alonzo.Era (AlonzoEra)
 import Cardano.Ledger.Alonzo.Scripts (lookupPlutusScript, plutusScriptLanguage)
 import Cardano.Ledger.Alonzo.TxWits (unTxDats)
 import Cardano.Ledger.BaseTypes (StrictMaybe (..))
-import Cardano.Ledger.CertState (CertState)
+import Cardano.Ledger.CertState (EraCertState (..))
 import Cardano.Ledger.Credential (credScriptHash)
 import Cardano.Ledger.Mary.UTxO (getConsumedMaryValue, getProducedMaryValue)
 import Cardano.Ledger.Mary.Value (PolicyID (..))
@@ -314,7 +315,7 @@ getMintingScriptsNeeded txBody =
 -- | Just like `getShelleyWitsVKeyNeeded`, but also requires `reqSignerHashesTxBodyL`.
 getAlonzoWitsVKeyNeeded ::
   forall era.
-  (EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era) =>
+  (EraTx era, AlonzoEraTxBody era, ShelleyEraTxBody era, EraCertState era) =>
   CertState era ->
   UTxO era ->
   TxBody era ->