Merge pull request #773 from IntersectMBO/js/10-3-queries

Integrate new Consensus queries for 10.3

Author: jasagredo

cardano-api/src/Cardano/Api.hs

@@ -1039,6 +1039,8 @@ module Cardano.Api
   , queryProposals
   , queryCommitteeMembersState
   , queryStakeVoteDelegatees
+  , queryStakePoolDefaultVote
+  , queryLedgerConfig
 
     -- ** Committee State Query
   , MemberStatus (..)

cardano-api/src/Cardano/Api/Internal/Query.hs

@@ -149,6 +149,8 @@ data QueryInMode result where
     :: QueryInMode (WithOrigin BlockNo)
   QueryChainPoint
     :: QueryInMode ChainPoint
+  QueryLedgerConfig
+    :: QueryInMode (Consensus.CardanoLedgerConfig StandardCrypto)
 
 instance NodeToClientVersionOf (QueryInMode result) where
   nodeToClientVersionOf = \case
@@ -158,6 +160,7 @@ instance NodeToClientVersionOf (QueryInMode result) where
     QuerySystemStart -> NodeToClientV_16
     QueryChainBlockNo -> NodeToClientV_16
     QueryChainPoint -> NodeToClientV_16
+    QueryLedgerConfig -> NodeToClientV_20
 
 data EraHistory where
   EraHistory
@@ -298,6 +301,9 @@ data QueryInShelleyBasedEra era result where
     -> QueryInShelleyBasedEra era (Seq (L.GovActionState (ShelleyLedgerEra era)))
   QueryLedgerPeerSnapshot
     :: QueryInShelleyBasedEra era (Serialised LedgerPeerSnapshot)
+  QueryStakePoolDefaultVote
+    :: Ledger.KeyHash 'Ledger.StakePool
+    -> QueryInShelleyBasedEra era L.DefaultVote
 
 -- | Mapping for queries in Shelley-based eras returning minimal node-to-client protocol versions. More
 -- information about queries versioning can be found:
@@ -333,6 +339,7 @@ instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where
   nodeToClientVersionOf QueryRatifyState{} = NodeToClientV_17
   nodeToClientVersionOf QueryFuturePParams{} = NodeToClientV_18
   nodeToClientVersionOf QueryLedgerPeerSnapshot = NodeToClientV_19
+  nodeToClientVersionOf QueryStakePoolDefaultVote{} = NodeToClientV_20
 
 deriving instance Show (QueryInShelleyBasedEra era result)
 
@@ -557,6 +564,7 @@ toConsensusQuery (QueryInEra QueryByronUpdateState) =
         Consensus.GetUpdateInterfaceState
 toConsensusQuery (QueryInEra (QueryInShelleyBasedEra sbe q)) =
   shelleyBasedEraConstraints sbe $ toConsensusQueryShelleyBased sbe q
+toConsensusQuery QueryLedgerConfig = Some Consensus.GetLedgerConfig
 
 toConsensusQueryShelleyBased
   :: forall era protocol block result
@@ -709,6 +717,16 @@ toConsensusQueryShelleyBased sbe = \case
       sbe
   QueryLedgerPeerSnapshot ->
     Some (consensusQueryInEraInMode era (Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot))
+  QueryStakePoolDefaultVote govActs ->
+    caseShelleyToBabbageOrConwayEraOnwards
+      ( const $
+          error "toConsensusQueryShelleyBased: QueryStakePoolDefaultVote is only available in the Conway era"
+      )
+      ( const $
+          Some
+            (consensusQueryInEraInMode era (Consensus.QueryStakePoolDefaultVote govActs))
+      )
+      sbe
  where
   era = toCardanoEra sbe
 
@@ -770,6 +788,11 @@ fromConsensusQueryResult QueryCurrentEra q' r' =
     Consensus.BlockQuery (Consensus.QueryHardFork Consensus.GetCurrentEra) ->
       fromConsensusEraIndex r'
     _ -> fromConsensusQueryResultMismatch
+fromConsensusQueryResult QueryLedgerConfig q' r' =
+  case q' of
+    Consensus.GetLedgerConfig ->
+      r'
+    _ -> fromConsensusQueryResultMismatch
 fromConsensusQueryResult (QueryInEra QueryByronUpdateState) q' r' =
   case q' of
     Consensus.BlockQuery
@@ -1006,6 +1029,11 @@ fromConsensusQueryResultShelleyBased sbe sbeQuery q' r' =
         Consensus.GetCBOR Consensus.GetBigLedgerPeerSnapshot ->
           r'
         _ -> fromConsensusQueryResultMismatch
+    QueryStakePoolDefaultVote{} ->
+      case q' of
+        Consensus.QueryStakePoolDefaultVote{} ->
+          r'
+        _ -> fromConsensusQueryResultMismatch
 
 -- | This should /only/ happen if we messed up the mapping in 'toConsensusQuery'
 -- and 'fromConsensusQueryResult' so they are inconsistent with each other.

cardano-api/src/Cardano/Api/Internal/Query/Expr.hs

@@ -38,6 +38,8 @@ module Cardano.Api.Internal.Query.Expr
   , queryFuturePParams
   , queryStakeVoteDelegatees
   , queryProposals
+  , queryStakePoolDefaultVote
+  , queryLedgerConfig
   )
 where
 
@@ -67,6 +69,7 @@ import Cardano.Ledger.Hashes hiding (Hash)
 import Cardano.Ledger.Keys qualified as L
 import Cardano.Ledger.Shelley.LedgerState qualified as L
 import Cardano.Slotting.Slot
+import Ouroboros.Consensus.Cardano.Block qualified as Consensus
 import Ouroboros.Consensus.HardFork.Combinator.AcrossEras as Consensus
 import Ouroboros.Network.Block (Serialised)
 import Ouroboros.Network.PeerSelection.LedgerPeers (LedgerPeerSnapshot)
@@ -94,6 +97,21 @@ queryChainPoint
 queryChainPoint =
   queryExpr QueryChainPoint
 
+queryLedgerConfig
+  :: ()
+  => LocalStateQueryExpr
+       block
+       point
+       QueryInMode
+       r
+       IO
+       ( Either
+           UnsupportedNtcVersionError
+           (Consensus.CardanoLedgerConfig Ledger.StandardCrypto)
+       )
+queryLedgerConfig =
+  queryExpr QueryLedgerConfig
+
 queryCurrentEra
   :: ()
   => LocalStateQueryExpr block point QueryInMode r IO (Either UnsupportedNtcVersionError AnyCardanoEra)
@@ -536,3 +554,23 @@ queryProposals cOnwards govActionIds = do
   queryExpr $
     QueryInEra . QueryInShelleyBasedEra sbe $
       QueryProposals govActionIds
+
+queryStakePoolDefaultVote
+  :: forall era block point r
+   . ConwayEraOnwards era
+  -> L.KeyHash 'L.StakePool
+  -> LocalStateQueryExpr
+       block
+       point
+       QueryInMode
+       r
+       IO
+       ( Either
+           UnsupportedNtcVersionError
+           (Either EraMismatch L.DefaultVote)
+       )
+queryStakePoolDefaultVote cOnwards stakePools = do
+  let sbe = convert cOnwards
+  queryExpr $
+    QueryInEra . QueryInShelleyBasedEra sbe $
+      QueryStakePoolDefaultVote stakePools