New constraints for DebugLedgerState and tidy up

IntersectMBO · Jul 27, 2023 · 4803f72 · 4803f72
1 parent f198e8e
commit 4803f72
Show file tree

Hide file tree

Showing 2 changed files with 39 additions and 35 deletions.
diff --git a/cardano-api/internal/Cardano/Api/Eras/Constraints.hs b/cardano-api/internal/Cardano/Api/Eras/Constraints.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -7,42 +8,31 @@
 {-# LANGUAGE TypeFamilyDependencies #-}
 {-# LANGUAGE TypeOperators #-}
 
-
--- | Cardano eras, sometimes we have to distinguish them.
---
 module Cardano.Api.Eras.Constraints
-  ( withShelleyBasedEraConstraintsForLedger
-  , cardanoEraConstraints
+  ( cardanoEraConstraints
+  , withShelleyBasedEraConstraintsForLedger
   , shelleyBasedEraConstraints
   ) where
 
 import           Cardano.Api.Eras.Core
+import           Cardano.Api.Query.Types
 
 import qualified Cardano.Crypto.Hash.Class as C
 import qualified Cardano.Ledger.Api as L
+import           Cardano.Ledger.Binary (FromCBOR)
 
+import           Data.Aeson (ToJSON)
 import           Data.Typeable (Typeable)
 
-withShelleyBasedEraConstraintsForLedger :: ()
-  => ShelleyLedgerEra era ~ ledgerera
-  => ShelleyBasedEra era
-  ->  ( ()
-      => L.EraCrypto ledgerera ~ L.StandardCrypto
-      => L.EraTx ledgerera
-      => L.EraTxBody ledgerera
-      => L.Era ledgerera
-      => a
-      )
-  -> a
-withShelleyBasedEraConstraintsForLedger = \case
-  ShelleyBasedEraShelley -> id
-  ShelleyBasedEraAllegra -> id
-  ShelleyBasedEraMary    -> id
-  ShelleyBasedEraAlonzo  -> id
-  ShelleyBasedEraBabbage -> id
-  ShelleyBasedEraConway  -> id
+type CardanoEraConstraint era =
+  ( Typeable era
+  , IsCardanoEra era
+  )
 
-cardanoEraConstraints :: CardanoEra era -> (Typeable era => IsCardanoEra era => a) -> a
+cardanoEraConstraints :: ()
+  => CardanoEra era
+  -> (CardanoEraConstraint era => a)
+  -> a
 cardanoEraConstraints = \case
   ByronEra   -> id
   ShelleyEra -> id
@@ -52,18 +42,24 @@ cardanoEraConstraints = \case
   BabbageEra -> id
   ConwayEra  -> id
 
+type ShelleyBasedEraConstraints era ledgerera =
+  ( C.HashAlgorithm (L.HASH (L.EraCrypto ledgerera))
+  , L.Crypto (L.EraCrypto ledgerera)
+  , L.Era ledgerera
+  , L.EraCrypto ledgerera ~ L.StandardCrypto
+  , L.EraPParams ledgerera
+  , L.EraTx ledgerera
+  , L.EraTxBody ledgerera
+  , FromCBOR (DebugLedgerState era)
+  , IsShelleyBasedEra era
+  , ToJSON (DebugLedgerState era)
+  , Typeable era
+  )
+
 shelleyBasedEraConstraints :: ()
+  => ShelleyLedgerEra era ~ ledgerera
   => ShelleyBasedEra era
-  -> (()
-      => Typeable era
-      => IsShelleyBasedEra era
-      => L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
-      => L.Crypto (L.EraCrypto (ShelleyLedgerEra era))
-      => L.EraPParams (ShelleyLedgerEra era)
-      => IsShelleyBasedEra era
-      => L.Era (ShelleyLedgerEra era)
-      => C.HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
-      => a)
+  -> (ShelleyBasedEraConstraints era ledgerera => a)
   -> a
 shelleyBasedEraConstraints = \case
   ShelleyBasedEraShelley -> id
@@ -72,3 +68,11 @@ shelleyBasedEraConstraints = \case
   ShelleyBasedEraAlonzo  -> id
   ShelleyBasedEraBabbage -> id
   ShelleyBasedEraConway  -> id
+
+-- Deprecated: Use shelleyBasedEraConstraints instead.
+withShelleyBasedEraConstraintsForLedger :: ()
+  => ShelleyLedgerEra era ~ ledgerera
+  => ShelleyBasedEra era
+  -> (ShelleyBasedEraConstraints era ledgerera => a)
+  -> a
+withShelleyBasedEraConstraintsForLedger = shelleyBasedEraConstraints
diff --git a/cardano-api/internal/Cardano/Api/Query/Types.hs b/cardano-api/internal/Cardano/Api/Query/Types.hs
@@ -14,7 +14,7 @@ module Cardano.Api.Query.Types
   , toDebugLedgerStatePair
   ) where
 
-import           Cardano.Api.Eras
+import           Cardano.Api.Eras.Core
 
 import           Cardano.Binary
 import           Cardano.Ledger.Binary