Add API support for queries for protocol params.

Several kinds of params: 1. current values of updateable protocol params 2. any pending proposed param updates 3. the non-updateable params fixed in the (Shelley) genesis file
IntersectMBO · Jan 7, 2021 · 0d31a98 · 0d31a98
1 parent 0e2586f
commit 0d31a98
Show file tree

Hide file tree

Showing 3 changed files with 50 additions and 11 deletions.
diff --git a/cardano-api/src/Cardano/Api/NetworkId.hs b/cardano-api/src/Cardano/Api/NetworkId.hs
@@ -5,12 +5,14 @@ module Cardano.Api.NetworkId (
     NetworkId(..),
     NetworkMagic(..),
     toNetworkMagic,
+    mainnetNetworkMagic,
 
     -- * Internal conversion functions
     toByronProtocolMagicId,
     toByronNetworkMagic,
     toByronRequiresNetworkMagic,
     toShelleyNetwork,
+    fromShelleyNetwork,
   ) where
 
 import           Prelude
@@ -35,9 +37,12 @@ data NetworkId = Mainnet
 
 toNetworkMagic :: NetworkId -> NetworkMagic
 toNetworkMagic (Testnet nm) = nm
-toNetworkMagic Mainnet      = NetworkMagic
-                            . Byron.unProtocolMagicId
-                            $ Byron.mainnetProtocolMagicId
+toNetworkMagic Mainnet      = mainnetNetworkMagic
+
+mainnetNetworkMagic :: NetworkMagic
+mainnetNetworkMagic = NetworkMagic
+                    . Byron.unProtocolMagicId
+                    $ Byron.mainnetProtocolMagicId
 
 
 -- ----------------------------------------------------------------------------
@@ -65,3 +70,9 @@ toShelleyNetwork :: NetworkId -> Shelley.Network
 toShelleyNetwork  Mainnet    = Shelley.Mainnet
 toShelleyNetwork (Testnet _) = Shelley.Testnet
 
+fromShelleyNetwork :: Shelley.Network -> NetworkMagic -> NetworkId
+fromShelleyNetwork Shelley.Testnet nm = Testnet nm
+fromShelleyNetwork Shelley.Mainnet nm
+  | nm == mainnetNetworkMagic = Mainnet
+  | otherwise = error "fromShelleyNetwork Mainnet: wrong mainnet network magic"
+
diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs
@@ -49,7 +49,9 @@ import qualified Shelley.Spec.Ledger.API        as Shelley
 import           Cardano.Api.Address
 import           Cardano.Api.Block
 import           Cardano.Api.Eras
+import           Cardano.Api.KeysShelley
 import           Cardano.Api.Modes
+import           Cardano.Api.ProtocolParameters
 import           Cardano.Api.TxBody
 
 
@@ -93,16 +95,17 @@ data QueryInShelleyBasedEra era result where
      QueryEpoch
        :: QueryInShelleyBasedEra era EpochNo
 
---TODO: add support for these
---     QueryGenesisParameters
---       :: QueryInShelleyBasedEra GenesisParameters
+     QueryGenesisParameters
+       :: QueryInShelleyBasedEra era GenesisParameters
 
---     QueryProtocolParameters
---       :: QueryInShelleyBasedEra ProtocolParameters
+     QueryProtocolParameters
+       :: QueryInShelleyBasedEra era ProtocolParameters
 
---     QueryProtocolParametersUpdate
---       :: QueryInShelleyBasedEra ProtocolParametersUpdate
+     QueryProtocolParametersUpdate
+       :: QueryInShelleyBasedEra era
+            (Map (Hash GenesisKey) ProtocolParametersUpdate)
 
+--TODO: add support for these
 --     QueryStakeDistribution
 --       :: QueryInShelleyBasedEra StakeDistribution
 
@@ -208,6 +211,15 @@ toConsensusQueryShelleyBased erainmode QueryChainPoint =
 toConsensusQueryShelleyBased erainmode QueryEpoch =
     Some (consensusQueryInEraInMode erainmode Consensus.GetEpochNo)
 
+toConsensusQueryShelleyBased erainmode QueryGenesisParameters =
+    Some (consensusQueryInEraInMode erainmode Consensus.GetGenesisConfig)
+
+toConsensusQueryShelleyBased erainmode QueryProtocolParameters =
+    Some (consensusQueryInEraInMode erainmode Consensus.GetCurrentPParams)
+
+toConsensusQueryShelleyBased erainmode QueryProtocolParametersUpdate =
+    Some (consensusQueryInEraInMode erainmode Consensus.GetProposedPParamsUpdates)
+
 toConsensusQueryShelleyBased erainmode (QueryUTxO Nothing) =
     Some (consensusQueryInEraInMode erainmode Consensus.GetUTxO)
 
@@ -327,6 +339,22 @@ fromConsensusQueryResultShelleyBased QueryEpoch q' epoch =
       Consensus.GetEpochNo -> epoch
       _                    -> fromConsensusQueryResultMismatch
 
+fromConsensusQueryResultShelleyBased QueryGenesisParameters q' r' =
+    case q' of
+      Consensus.GetGenesisConfig -> fromShelleyGenesis
+                                      (Consensus.getCompactGenesis r')
+      _                          -> fromConsensusQueryResultMismatch
+
+fromConsensusQueryResultShelleyBased QueryProtocolParameters q' r' =
+    case q' of
+      Consensus.GetCurrentPParams -> fromShelleyPParams r'
+      _                           -> fromConsensusQueryResultMismatch
+
+fromConsensusQueryResultShelleyBased QueryProtocolParametersUpdate q' r' =
+    case q' of
+      Consensus.GetProposedPParamsUpdates -> fromShelleyProposedPPUpdates r'
+      _                                   -> fromConsensusQueryResultMismatch
+
 fromConsensusQueryResultShelleyBased (QueryUTxO Nothing) q' utxo' =
     case q' of
       Consensus.GetUTxO -> fromShelleyUTxO utxo'

diff --git a/cardano-api/src/Cardano/Api/Typed.hs b/cardano-api/src/Cardano/Api/Typed.hs
@@ -515,7 +515,7 @@ import           Control.Tracer (nullTracer)
 --
 -- Common types, consensus, network
 --
-import           Cardano.Slotting.Slot (EpochNo (..), EpochSize (..), SlotNo (..))
+import           Cardano.Slotting.Slot (EpochNo (..), SlotNo (..))
 
 -- TODO: it'd be nice if the network imports needed were a bit more coherent
 import           Ouroboros.Network.Block (Point, Tip)