More constraints for the standard features ShelleyBasedEra, ShelleyTo…

…BabbageEra and BabbageEraOnwards.

cardano-api/cardano-api.cabal

@@ -162,7 +162,7 @@ library internal
                       , ouroboros-consensus >= 0.9
                       , ouroboros-consensus-cardano >= 0.7
                       , ouroboros-consensus-diffusion >= 0.7
-                      , ouroboros-consensus-protocol >= 0.5
+                      , ouroboros-consensus-protocol >= 0.5.0.4
                       , ouroboros-network
                       , ouroboros-network-api
                       , ouroboros-network-framework

cardano-api/internal/Cardano/Api/Block.hs

@@ -162,7 +162,8 @@ instance Show (Block era) where
         )
 
 getBlockTxs :: forall era . Block era -> [Tx era]
-getBlockTxs (ByronBlock Consensus.ByronBlock { Consensus.byronBlockRaw }) =
+getBlockTxs = \case
+  ByronBlock Consensus.ByronBlock { Consensus.byronBlockRaw } ->
     case byronBlockRaw of
       Byron.ABOBBoundary{} -> [] -- no txs in EBBs
       Byron.ABOBBlock Byron.ABlock {
@@ -171,9 +172,9 @@ getBlockTxs (ByronBlock Consensus.ByronBlock { Consensus.byronBlockRaw }) =
               Byron.bodyTxPayload = Byron.ATxPayload txs
             }
         } -> map ByronTx txs
-getBlockTxs (ShelleyBlock era Consensus.ShelleyBlock{Consensus.shelleyBlockRaw}) =
-    withShelleyBasedEraConstraintForConsensus era $
-      getShelleyBlockTxs era shelleyBlockRaw
+  ShelleyBlock sbe Consensus.ShelleyBlock{Consensus.shelleyBlockRaw} ->
+    shelleyBasedEraConstraints sbe $
+      getShelleyBlockTxs sbe shelleyBlockRaw
 
 
 getShelleyBlockTxs :: forall era ledgerera blockheader.

cardano-api/internal/Cardano/Api/Certificate.hs

@@ -818,11 +818,7 @@ shelleyCertificateConstraints
       , Ledger.TxCert (ShelleyLedgerEra era) ~ Ledger.ShelleyTxCert (ShelleyLedgerEra era)
       ) => a)
   -> a
-shelleyCertificateConstraints ShelleyToBabbageEraBabbage f = f
-shelleyCertificateConstraints ShelleyToBabbageEraAlonzo f = f
-shelleyCertificateConstraints ShelleyToBabbageEraMary    f = f
-shelleyCertificateConstraints ShelleyToBabbageEraAllegra  f = f
-shelleyCertificateConstraints ShelleyToBabbageEraShelley f = f
+shelleyCertificateConstraints = shelleyToBabbageEraConstraints
 
 conwayCertificateConstraints
   :: ConwayEraOnwards era
@@ -831,5 +827,5 @@ conwayCertificateConstraints
       , Ledger.TxCert (ShelleyLedgerEra era) ~ Ledger.ConwayTxCert (ShelleyLedgerEra era)
       ) => a)
   -> a
-conwayCertificateConstraints ConwayEraOnwardsConway f = f
+conwayCertificateConstraints = conwayEraOnwardsConstraints
 

cardano-api/internal/Cardano/Api/Eras/Constraints.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
@@ -7,42 +8,40 @@
 {-# 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.Modes
+import           Cardano.Api.Query.Types
 
+import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
 import qualified Cardano.Crypto.Hash.Class as C
+import qualified Cardano.Crypto.VRF as C
 import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.BaseTypes as L
+import           Cardano.Ledger.Binary (FromCBOR)
+import qualified Cardano.Ledger.Core as L
+import qualified Cardano.Ledger.SafeHash as L
+import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
+import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 
+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 +51,31 @@ cardanoEraConstraints = \case
   BabbageEra -> id
   ConwayEra  -> id
 
+type ShelleyBasedEraConstraints era ledgerera =
+  ( C.HashAlgorithm (L.HASH (L.EraCrypto ledgerera))
+  , C.Signable (L.VRF (L.EraCrypto ledgerera)) L.Seed
+  , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
+  , Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
+  , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.Crypto (L.EraCrypto ledgerera)
+  , L.Era ledgerera
+  , L.EraCrypto ledgerera ~ L.StandardCrypto
+  , L.EraPParams ledgerera
+  , L.EraTx ledgerera
+  , L.EraTxBody ledgerera
+  , L.HashAnnotated (L.TxBody ledgerera) L.EraIndependentTxBody L.StandardCrypto
+  , L.ShelleyEraTxBody ledgerera
+  , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
+  , 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 +84,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

cardano-api/internal/Cardano/Api/Eras/Core.hs

@@ -8,8 +8,6 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilyDependencies #-}
-{-# LANGUAGE TypeOperators #-}
-
 
 -- | Cardano eras, sometimes we have to distinguish them.
 --

cardano-api/internal/Cardano/Api/Feature/ConwayEraOnwards.hs

@@ -16,13 +16,24 @@ module Cardano.Api.Feature.ConwayEraOnwards
   ) where
 
 import           Cardano.Api.Eras
+import           Cardano.Api.Modes
 import           Cardano.Api.Query.Types
 
 import           Cardano.Binary
-import           Cardano.Crypto.Hash.Class (HashAlgorithm)
+import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
+import qualified Cardano.Crypto.Hash.Class as C
+import qualified Cardano.Crypto.VRF as C
 import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.BaseTypes as L
+import qualified Cardano.Ledger.Conway.TxCert as L
+import qualified Cardano.Ledger.Core as L
+import qualified Cardano.Ledger.SafeHash as L
+import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
+import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 
 import           Data.Aeson
+import           Data.Typeable (Typeable)
 
 data ConwayEraOnwards era where
   ConwayEraOnwardsConway :: ConwayEraOnwards ConwayEra
@@ -45,19 +56,34 @@ data AnyConwayEraOnwards where
 
 deriving instance Show AnyConwayEraOnwards
 
-type ConwayEraOnwardsConstraints era =
-  ( FromCBOR (DebugLedgerState era)
-  , HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
+type ConwayEraOnwardsConstraints era ledgerera =
+  ( C.HashAlgorithm (L.HASH (L.EraCrypto ledgerera))
+  , C.Signable (L.VRF (L.EraCrypto ledgerera)) L.Seed
+  , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
+  , Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
+  , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.ConwayEraTxBody ledgerera
+  , L.ConwayEraTxCert ledgerera
+  , L.Crypto (L.EraCrypto ledgerera)
+  , L.Era ledgerera
+  , L.EraCrypto ledgerera ~ L.StandardCrypto
+  , L.EraPParams ledgerera
+  , L.EraTx ledgerera
+  , L.EraTxBody ledgerera
+  , L.HashAnnotated (L.TxBody ledgerera) L.EraIndependentTxBody L.StandardCrypto
+  , L.ShelleyEraTxBody ledgerera
+  , L.TxCert ledgerera ~ L.ConwayTxCert ledgerera
+  , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
+  , FromCBOR (DebugLedgerState era)
   , IsShelleyBasedEra era
-  , L.ConwayEraTxBody (ShelleyLedgerEra era)
-  , L.Era (ShelleyLedgerEra era)
-  , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
   , ToJSON (DebugLedgerState era)
+  , Typeable era
   )
 
-conwayEraOnwardsConstraints
-  :: ConwayEraOnwards era
-  -> (ConwayEraOnwardsConstraints era => a)
+conwayEraOnwardsConstraints :: ()
+  => ShelleyLedgerEra era ~ ledgerera
+  => ConwayEraOnwards era
+  -> (ConwayEraOnwardsConstraints era ledgerera => a)
   -> a
 conwayEraOnwardsConstraints = \case
   ConwayEraOnwardsConway -> id

cardano-api/internal/Cardano/Api/Feature/ShelleyToBabbageEra.hs

@@ -16,13 +16,24 @@ module Cardano.Api.Feature.ShelleyToBabbageEra
   ) where
 
 import           Cardano.Api.Eras
+import           Cardano.Api.Modes
 import           Cardano.Api.Query.Types
 
 import           Cardano.Binary
-import           Cardano.Crypto.Hash.Class (HashAlgorithm)
+import qualified Cardano.Crypto.Hash.Blake2b as Blake2b
+import qualified Cardano.Crypto.Hash.Class as C
+import qualified Cardano.Crypto.VRF as C
 import qualified Cardano.Ledger.Api as L
+import qualified Cardano.Ledger.BaseTypes as L
+import qualified Cardano.Ledger.Core as L
+import qualified Cardano.Ledger.SafeHash as L
+import qualified Cardano.Ledger.Shelley.TxCert as L
+import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus
+import qualified Ouroboros.Consensus.Protocol.Praos.Common as Consensus
+import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 
 import           Data.Aeson
+import           Data.Typeable (Typeable)
 
 data ShelleyToBabbageEra era where
   ShelleyToBabbageEraShelley :: ShelleyToBabbageEra ShelleyEra
@@ -44,23 +55,38 @@ instance FeatureInEra ShelleyToBabbageEra where
     BabbageEra  -> yes ShelleyToBabbageEraBabbage
     ConwayEra   -> no
 
-type ShelleyToBabbageEraConstraints era =
-  ( FromCBOR (DebugLedgerState era)
-  , HashAlgorithm (L.HASH (L.EraCrypto (ShelleyLedgerEra era)))
+type ShelleyToBabbageEraConstraints era ledgerera =
+  ( C.HashAlgorithm (L.HASH (L.EraCrypto ledgerera))
+  , C.Signable (L.VRF (L.EraCrypto ledgerera)) L.Seed
+  , Consensus.PraosProtocolSupportsNode (ConsensusProtocol era)
+  , Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera
+  , L.ADDRHASH (Consensus.PraosProtocolSupportsNodeCrypto (ConsensusProtocol era)) ~ Blake2b.Blake2b_224
+  , L.Crypto (L.EraCrypto ledgerera)
+  , L.Era ledgerera
+  , L.EraCrypto ledgerera ~ L.StandardCrypto
+  , L.EraPParams ledgerera
+  , L.EraTx ledgerera
+  , L.EraTxBody ledgerera
+  , L.HashAnnotated (L.TxBody ledgerera) L.EraIndependentTxBody L.StandardCrypto
+  , L.ShelleyEraTxBody ledgerera
+  , L.ShelleyEraTxCert ledgerera
+  , L.TxCert ledgerera ~ L.ShelleyTxCert ledgerera
+  , FromCBOR (Consensus.ChainDepState (ConsensusProtocol era))
+  , FromCBOR (DebugLedgerState era)
   , IsShelleyBasedEra era
-  , L.Era (ShelleyLedgerEra era)
-  , L.EraCrypto (ShelleyLedgerEra era) ~ L.StandardCrypto
   , ToJSON (DebugLedgerState era)
+  , Typeable era
   )
 
 data AnyShelleyToBabbageEra where
   AnyShelleyToBabbageEra :: ShelleyToBabbageEra era -> AnyShelleyToBabbageEra
 
 deriving instance Show AnyShelleyToBabbageEra
 
-shelleyToBabbageEraConstraints
-  :: ShelleyToBabbageEra era
-  -> (ShelleyToBabbageEraConstraints era => a)
+shelleyToBabbageEraConstraints :: ()
+  => ShelleyLedgerEra era ~ ledgerera
+  => ShelleyToBabbageEra era
+  -> (ShelleyToBabbageEraConstraints era ledgerera => a)
   -> a
 shelleyToBabbageEraConstraints = \case
   ShelleyToBabbageEraShelley -> id

cardano-api/internal/Cardano/Api/Modes.hs

@@ -44,11 +44,9 @@ module Cardano.Api.Modes (
     ConsensusBlockForEra,
     toConsensusEraIndex,
     fromConsensusEraIndex,
-
-    withShelleyBasedEraConstraintForConsensus,
   ) where
 
-import           Cardano.Api.Eras
+import           Cardano.Api.Eras.Core
 
 import qualified Cardano.Chain.Slotting as Byron (EpochSlots (..))
 import           Cardano.Ledger.Crypto (StandardCrypto)
@@ -60,7 +58,6 @@ import           Ouroboros.Consensus.HardFork.Combinator as Consensus (EraIndex
 import qualified Ouroboros.Consensus.Protocol.Praos as Consensus
 import qualified Ouroboros.Consensus.Protocol.TPraos as Consensus
 import qualified Ouroboros.Consensus.Shelley.HFEras as Consensus
-import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus
 import qualified Ouroboros.Consensus.Shelley.ShelleyHFC as Consensus
 
 import           Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), Value)
@@ -429,17 +426,3 @@ fromConsensusEraIndex CardanoMode = fromShelleyEraIndex
 
     fromShelleyEraIndex (Consensus.EraIndex (S (S (S (S (S (S (Z (K ()))))))))) =
       AnyEraInMode ConwayEraInCardanoMode
-
-withShelleyBasedEraConstraintForConsensus
-  :: forall era ledgerera a. ()
-  => ShelleyLedgerEra era ~ ledgerera
-  => ShelleyBasedEra era
-  -> (Consensus.ShelleyCompatible (ConsensusProtocol era) ledgerera => a)
-  -> a
-withShelleyBasedEraConstraintForConsensus = \case
-  ShelleyBasedEraShelley  -> id
-  ShelleyBasedEraAllegra  -> id
-  ShelleyBasedEraMary     -> id
-  ShelleyBasedEraAlonzo   -> id
-  ShelleyBasedEraBabbage  -> id
-  ShelleyBasedEraConway   -> id

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