wip

IntersectMBO · Jul 6, 2023 · 4cd2216 · 4cd2216
1 parent 0df480e
commit 4cd2216
Show file tree

Hide file tree

Showing 4 changed files with 64 additions and 0 deletions.
diff --git a/cabal.project b/cabal.project
@@ -15,6 +15,8 @@ repository cardano-haskell-packages
 index-state:
   , hackage.haskell.org 2023-07-02T00:00:00Z
   , cardano-haskell-packages 2023-07-02T00:00:00Z
+  -- , hackage.haskell.org 2023-07-05T00:00:00Z
+  -- , cardano-haskell-packages 2023-07-05T00:00:00Z
 
 packages:
     cardano-api
@@ -41,3 +43,40 @@ write-ghc-environment-files: always
 -- IMPORTANT
 -- Do NOT add more source-repository-package stanzas here unless they are strictly
 -- temporary! Please read the section in CONTRIBUTING about updating dependencies.
+
+source-repository-package
+  type: git
+  location: [email protected]:input-output-hk/ouroboros-consensus.git
+  tag: b2a934e5a545afc312b58768caa31d292a5cfd68
+  --sha256: 04z1p8kvqckcwa9812kqf4wd72dlvq8wdizb5cpq4x3v0i204ryw
+  subdir: 
+    ouroboros-consensus-cardano
+    ouroboros-consensus-protocol
+    ouroboros-consensus-diffusion
+    ouroboros-consensus
+
+-- source-repository-package
+--   type: git
+--   location: [email protected]:input-output-hk/plutus.git
+--   tag: e32264af9b56de5585009f30b2689e6481b273ec
+--   subdir: plutus-ledger-api
+
+source-repository-package
+  type: git
+  location: https://github.com/input-output-hk/cardano-ledger.git
+  tag: 9b3a09485f1ba14ce8dc267d5596f85116ce5330
+  --sha256: 0ldwf90ybbs89vww4jm4z9k7cf6lhmjlb3znpgm17rf6rifjda7y
+  subdir:
+    eras/shelley/impl
+    eras/conway/impl
+    eras/allegra/impl
+    eras/mary/impl
+    eras/babbage/impl
+    eras/babbage/test-suite
+    eras/alonzo/impl
+    eras/alonzo/test-suite
+    libs/cardano-ledger-api
+    libs/cardano-ledger-core
+    eras/conway/test-suite
+    libs/cardano-protocol-tpraos
+    libs/cardano-ledger-pretty
diff --git a/cardano-api/internal/Cardano/Api/Query.hs b/cardano-api/internal/Cardano/Api/Query.hs
@@ -94,6 +94,9 @@ import           Cardano.Api.Value
 
 import qualified Cardano.Chain.Update.Validation.Interface as Byron.Update
 import           Cardano.Ledger.Binary
+import           Cardano.Ledger.SafeHash (SafeHash)
+import           Data.ByteString (ByteString)
+import           Cardano.Ledger.Core (EraCrypto)
 import qualified Cardano.Ledger.Binary.Plain as Plain
 import qualified Cardano.Ledger.Credential as Shelley
 import           Cardano.Ledger.Crypto (Crypto)
@@ -294,6 +297,10 @@ data QueryInShelleyBasedEra era result where
     :: Set StakeCredential
     -> QueryInShelleyBasedEra era (Map StakeCredential Lovelace)
 
+  QueryConstitutionHash
+    :: QueryInShelleyBasedEra era (Maybe (SafeHash (EraCrypto era) ByteString))
+
+
 instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
   nodeToClientVersionOf QueryEpoch = NodeToClientV_9
   nodeToClientVersionOf QueryGenesisParameters = NodeToClientV_9
@@ -311,6 +318,7 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
   nodeToClientVersionOf (QueryPoolDistribution _) = NodeToClientV_14
   nodeToClientVersionOf (QueryStakeSnapshot _) = NodeToClientV_14
   nodeToClientVersionOf (QueryStakeDelegDeposits _) = NodeToClientV_15
+  nodeToClientVersionOf QueryConstitutionHash = NodeToClientV_15
 
 deriving instance Show (QueryInShelleyBasedEra era result)
 
@@ -623,6 +631,9 @@ toConsensusQueryShelleyBased
 toConsensusQueryShelleyBased erainmode QueryEpoch =
     Some (consensusQueryInEraInMode erainmode Consensus.GetEpochNo)
 
+toConsensusQueryShelleyBased erainmode QueryConstitutionHash =
+    Some (consensusQueryInEraInMode erainmode Consensus.GetConstitutionHash)
+
 toConsensusQueryShelleyBased erainmode QueryGenesisParameters =
     Some (consensusQueryInEraInMode erainmode Consensus.GetGenesisConfig)
 
@@ -861,6 +872,11 @@ fromConsensusQueryResultShelleyBased _ QueryEpoch q' epoch =
       Consensus.GetEpochNo -> epoch
       _                    -> fromConsensusQueryResultMismatch
 
+fromConsensusQueryResultShelleyBased _ QueryConstitutionHash q' mCHash =
+    case q' of
+      Consensus.GetConstitutionHash -> mCHash
+      _                    -> fromConsensusQueryResultMismatch
+
 fromConsensusQueryResultShelleyBased _ QueryGenesisParameters q' r' =
     case q' of
       Consensus.GetGenesisConfig -> fromShelleyGenesis

diff --git a/cardano-api/internal/Cardano/Api/Query/Expr.hs b/cardano-api/internal/Cardano/Api/Query/Expr.hs
@@ -7,6 +7,7 @@ module Cardano.Api.Query.Expr
   , queryCurrentEra
   , queryDebugLedgerState
   , queryEpoch
+  , queryConstitutionHash
   , queryEraHistory
   , queryGenesisParameters
   , queryPoolDistribution
@@ -126,6 +127,13 @@ queryProtocolParameters :: ()
 queryProtocolParameters eraInMode sbe =
   queryExpr $ QueryInEra eraInMode $ QueryInShelleyBasedEra sbe QueryProtocolParameters
 
+queryConstitutionHash :: ()
+  => EraInMode era mode
+  -> ShelleyBasedEra era
+  -> LocalStateQueryExpr block point (QueryInMode mode) r IO (Either UnsupportedNtcVersionError (Either EraMismatch (Maybe (SafeHash (EraCrypto era) ByteString))))
+queryConstitutionHash eraInMode sbe =
+  queryExpr $ QueryInEra eraInMode $ QueryInShelleyBasedEra sbe QueryConstitutionHash
+
 queryProtocolParametersUpdate :: ()
   => EraInMode era mode
   -> ShelleyBasedEra era

diff --git a/cardano-api/src/Cardano/Api.hs b/cardano-api/src/Cardano/Api.hs
@@ -873,6 +873,7 @@ module Cardano.Api (
     queryCurrentEra,
     queryDebugLedgerState,
     queryEpoch,
+    queryConstitutionHash,
     queryEraHistory,
     queryGenesisParameters,
     queryPoolDistribution,