Add protocol state query to new api

IntersectMBO · Jan 13, 2021 · cd2d0d4 · cd2d0d4
1 parent f48054a
commit cd2d0d4
Showing 1 changed file with 17 additions and 6 deletions.
diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs
@@ -26,6 +26,7 @@ module Cardano.Api.Query (
 
     -- TODO: Move me
     LedgerState(..),
+    ProtocolState(..),
   ) where
 
 import           Data.Bifunctor (bimap)
@@ -131,21 +132,24 @@ data QueryInShelleyBasedEra era result where
        -> QueryInShelleyBasedEra era (Map StakeCredential Lovelace,
                                       Map StakeCredential PoolId)
 
---     QueryPoolRanking
---       ::
---       -> QueryInShelleyBasedEra
+     -- TODO: Need to update ledger-specs dependency to access RewardProvenance
+     -- QueryPoolRanking
+     --   :: QueryInShelleyBasedEra era RewardProvenance
 
      QueryLedgerState
        :: QueryInShelleyBasedEra era (LedgerState era)
 
---     QueryProtocolState
---       :: QueryInShelleyBasedEra ProtocolState
---TODO: add support for these
+     QueryProtocolState
+       :: QueryInShelleyBasedEra era (ProtocolState era)
 
 deriving instance Show (QueryInShelleyBasedEra era result)
 
 newtype LedgerState era = LedgerState (Serialised (Shelley.NewEpochState (ShelleyLedgerEra era)))
 
+newtype ProtocolState era
+  = ProtocolState (Serialised (Shelley.ChainDepState (Ledger.Crypto (ShelleyLedgerEra era))))
+
+
 -- ----------------------------------------------------------------------------
 -- Wrapper types used in queries
 --
@@ -289,6 +293,8 @@ toConsensusQueryShelleyBased erainmode (QueryStakeAddresses creds) =
 toConsensusQueryShelleyBased erainmode QueryLedgerState =
     Some (consensusQueryInEraInMode erainmode (Consensus.GetCBOR Consensus.DebugNewEpochState))
 
+toConsensusQueryShelleyBased erainmode QueryProtocolState =
+    Some (consensusQueryInEraInMode erainmode (Consensus.GetCBOR Consensus.DebugChainDepState))
 
 consensusQueryInEraInMode
   :: forall era mode erablock modeblock result result' xs.
@@ -443,6 +449,11 @@ fromConsensusQueryResultShelleyBased QueryLedgerState{} q' r' =
       Consensus.GetCBOR Consensus.DebugNewEpochState -> LedgerState r'
       _                                              -> fromConsensusQueryResultMismatch
 
+fromConsensusQueryResultShelleyBased QueryProtocolState q' r' =
+    case q' of
+      Consensus.GetCBOR Consensus.DebugChainDepState -> ProtocolState r'
+      _                                              -> fromConsensusQueryResultMismatch
+
 -- | This should /only/ happen if we messed up the mapping in 'toConsensusQuery'
 -- and 'fromConsensusQueryResult' so they are inconsistent with each other.
 --