Merge pull request #143 from input-output-hk/newhoggy/provide-additio…

…nal-constraints-in-shelleyBasedEraConstraints Provide additional constraints in `shelleyBasedEraConstraints`
IntersectMBO · Jul 27, 2023 · b78a171 · b78a171
2 parents b3b7474 + f3d05c8
commit b78a171
Show file tree

Hide file tree

Showing 11 changed files with 782 additions and 649 deletions.
diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal
@@ -57,6 +57,8 @@ library internal
                         Cardano.Api.DRepMetadata
                         Cardano.Api.EraCast
                         Cardano.Api.Eras
+                        Cardano.Api.Eras.Constraints
+                        Cardano.Api.Eras.Core
                         Cardano.Api.Error
                         Cardano.Api.Feature
                         Cardano.Api.Feature.ConwayEraOnwards
@@ -160,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

diff --git a/cardano-api/internal/Cardano/Api/Block.hs b/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.

diff --git a/cardano-api/internal/Cardano/Api/Certificate.hs b/cardano-api/internal/Cardano/Api/Certificate.hs
@@ -818,11 +818,12 @@ 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 = \case
+  ShelleyToBabbageEraBabbage  -> id
+  ShelleyToBabbageEraAlonzo   -> id
+  ShelleyToBabbageEraMary     -> id
+  ShelleyToBabbageEraAllegra  -> id
+  ShelleyToBabbageEraShelley  -> id
 
 conwayCertificateConstraints
   :: ConwayEraOnwards era
@@ -831,5 +832,5 @@ conwayCertificateConstraints
       , Ledger.TxCert (ShelleyLedgerEra era) ~ Ledger.ConwayTxCert (ShelleyLedgerEra era)
       ) => a)
   -> a
-conwayCertificateConstraints ConwayEraOnwardsConway f = f
-
+conwayCertificateConstraints = \case
+  ConwayEraOnwardsConway      -> id