From ddee4d27a3508d7e2900c423dedbf09a38c755bf Mon Sep 17 00:00:00 2001 From: John Ky Date: Wed, 18 Jan 2023 08:19:06 +1100 Subject: [PATCH] New NodeToClientVersionOf typeclass --- cardano-api/cardano-api.cabal | 1 + cardano-api/src/Cardano/Api/Eras.hs | 1 - cardano-api/src/Cardano/Api/IPC/Version.hs | 37 +++++++++++++++++++ cardano-api/src/Cardano/Api/Query.hs | 36 +++++++++++++++++- .../src/Cardano/CLI/Shelley/Run/Query.hs | 4 +- 5 files changed, 75 insertions(+), 4 deletions(-) create mode 100644 cardano-api/src/Cardano/Api/IPC/Version.hs diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index c33ca750719..37ef8d1753b 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -72,6 +72,7 @@ library Cardano.Api.IPC Cardano.Api.IPC.Monad Cardano.Api.InMode + Cardano.Api.IPC.Version Cardano.Api.Json Cardano.Api.Keys.Byron Cardano.Api.Keys.Class diff --git a/cardano-api/src/Cardano/Api/Eras.hs b/cardano-api/src/Cardano/Api/Eras.hs index be686b277c8..29c44f4d0d9 100644 --- a/cardano-api/src/Cardano/Api/Eras.hs +++ b/cardano-api/src/Cardano/Api/Eras.hs @@ -58,7 +58,6 @@ import Data.Type.Equality (TestEquality (..), (:~:) (Refl)) import Ouroboros.Consensus.Shelley.Eras as Consensus (StandardAllegra, StandardAlonzo, StandardBabbage, StandardMary, StandardShelley) - -- | A type used as a tag to distinguish the Byron era. data ByronEra diff --git a/cardano-api/src/Cardano/Api/IPC/Version.hs b/cardano-api/src/Cardano/Api/IPC/Version.hs new file mode 100644 index 00000000000..fb56d63b9bf --- /dev/null +++ b/cardano-api/src/Cardano/Api/IPC/Version.hs @@ -0,0 +1,37 @@ +module Cardano.Api.IPC.Version + ( NodeToClientVersionOf (..) + , MinNodeToClientVersion + + -- *** Error types + , UnsupportedNtcVersionError(..) + ) where + +import Data.Eq (Eq) +import Text.Show (Show) + +import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..)) + +-- | The query 'a' is a versioned query, which means it requires the Node to support a minimum +-- Node-to-Client version. +-- +-- Background: The node to client protocol is such that it will disconnect on any +-- unrecognised queries. This means that for a Node-to-Client connection, if a query is sent +-- that was introduced in a Node-to-Client version that is newer than the Node-To-Client version +-- of the connection, the node will disconnect the client. The client will not get any +-- information about why the disconnect happened. This is a bad user experience for tools +-- such as the CLI. +-- +-- To improve the user experience the API needs to prevent the sending of queries that are +-- newer than the Node-To-Client version of the connection by checking the version of the +-- query before sending it. This affords the ability to return 'UnsupportedNtcVersionError', +-- informing the caller of a Node-To-Client versioning issue. +-- +-- For maintaining typeclass instances, see the 'NodeToClientVersion' type documentation for +-- a list of versions and the queries that were introduced for those versions. +class NodeToClientVersionOf a where + nodeToClientVersionOf :: a -> NodeToClientVersion + +type MinNodeToClientVersion = NodeToClientVersion + +data UnsupportedNtcVersionError = UnsupportedNtcVersionError !MinNodeToClientVersion !NodeToClientVersion + deriving (Eq, Show) diff --git a/cardano-api/src/Cardano/Api/Query.hs b/cardano-api/src/Cardano/Api/Query.hs index 1ebd5108063..275cd98f6df 100644 --- a/cardano-api/src/Cardano/Api/Query.hs +++ b/cardano-api/src/Cardano/Api/Query.hs @@ -110,6 +110,7 @@ import qualified Ouroboros.Consensus.Ledger.Query as Consensus import qualified Ouroboros.Consensus.Protocol.Abstract as Consensus import qualified Ouroboros.Consensus.Shelley.Ledger as Consensus import Ouroboros.Network.Block (Serialised (..)) +import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion (..)) import Cardano.Binary import Cardano.Slotting.Slot (WithOrigin (..)) @@ -129,6 +130,7 @@ import Cardano.Api.Certificate import Cardano.Api.EraCast import Cardano.Api.Eras import Cardano.Api.GenesisParameters +import Cardano.Api.IPC.Version import Cardano.Api.Keys.Shelley import Cardano.Api.Modes import Cardano.Api.NetworkId @@ -169,6 +171,14 @@ data QueryInMode mode result where :: ConsensusMode mode -> QueryInMode mode ChainPoint +instance NodeToClientVersionOf (QueryInMode mode result) where + nodeToClientVersionOf (QueryCurrentEra _) = NodeToClientV_9 + nodeToClientVersionOf (QueryInEra _ q) = nodeToClientVersionOf q + nodeToClientVersionOf (QueryEraHistory _) = NodeToClientV_9 + nodeToClientVersionOf QuerySystemStart = NodeToClientV_9 + nodeToClientVersionOf QueryChainBlockNo = NodeToClientV_10 + nodeToClientVersionOf (QueryChainPoint _) = NodeToClientV_10 + data EraHistory mode where EraHistory :: ConsensusBlockForMode mode ~ Consensus.HardForkBlock xs @@ -202,6 +212,10 @@ data QueryInEra era result where -> QueryInShelleyBasedEra era result -> QueryInEra era result +instance NodeToClientVersionOf (QueryInEra era result) where + nodeToClientVersionOf QueryByronUpdateState = NodeToClientV_9 + nodeToClientVersionOf (QueryInShelleyBasedEra _ q) = nodeToClientVersionOf q + deriving instance Show (QueryInEra era result) @@ -263,6 +277,23 @@ data QueryInShelleyBasedEra era result where :: PoolId -> QueryInShelleyBasedEra era (SerialisedStakeSnapshots era) +instance NodeToClientVersionOf (QueryInShelleyBasedEra era result) where + nodeToClientVersionOf QueryEpoch = NodeToClientV_9 + nodeToClientVersionOf QueryGenesisParameters = NodeToClientV_9 + nodeToClientVersionOf QueryProtocolParameters = NodeToClientV_9 + nodeToClientVersionOf QueryProtocolParametersUpdate = NodeToClientV_9 + nodeToClientVersionOf QueryStakeDistribution = NodeToClientV_9 + nodeToClientVersionOf (QueryUTxO f) = nodeToClientVersionOf f + nodeToClientVersionOf (QueryStakeAddresses _ _) = NodeToClientV_9 + nodeToClientVersionOf QueryStakePools = NodeToClientV_9 + nodeToClientVersionOf (QueryStakePoolParameters _) = NodeToClientV_9 + nodeToClientVersionOf QueryDebugLedgerState = NodeToClientV_9 + nodeToClientVersionOf QueryProtocolState = NodeToClientV_9 + nodeToClientVersionOf QueryCurrentEpochState = NodeToClientV_9 + nodeToClientVersionOf (QueryPoolState _) = NodeToClientV_14 + nodeToClientVersionOf (QueryPoolDistribution _) = NodeToClientV_14 + nodeToClientVersionOf (QueryStakeSnapshot _) = NodeToClientV_14 + deriving instance Show (QueryInShelleyBasedEra era result) @@ -288,7 +319,10 @@ data QueryUTxOFilter = | QueryUTxOByTxIn (Set TxIn) deriving (Eq, Show) ---TODO: provide appropriate instances for these types as needed, e.g. JSON +instance NodeToClientVersionOf QueryUTxOFilter where + nodeToClientVersionOf QueryUTxOWhole = NodeToClientV_9 + nodeToClientVersionOf (QueryUTxOByAddress _) = NodeToClientV_9 + nodeToClientVersionOf (QueryUTxOByTxIn _) = NodeToClientV_9 newtype ByronUpdateState = ByronUpdateState Byron.Update.State deriving Show diff --git a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs index 5f1372def8f..67380ab3ca6 100644 --- a/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/Shelley/Run/Query.hs @@ -89,7 +89,7 @@ import Cardano.Slotting.EpochInfo (EpochInfo (..), epochInfoSlotToUTCT import Ouroboros.Consensus.BlockchainTime.WallClock.Types (RelativeTime (..), toRelativeTime) import Ouroboros.Consensus.Cardano.Block as Consensus (EraMismatch (..)) -import Ouroboros.Consensus.Protocol.TPraos ( StandardCrypto ) +import Ouroboros.Consensus.Protocol.TPraos (StandardCrypto) import Ouroboros.Network.Block (Serialised (..)) import qualified Ouroboros.Consensus.HardFork.History as Consensus @@ -868,7 +868,7 @@ writeStakeSnapshot qState = ] <> poolFields snapshot where poolFields :: Consensus.StakeSnapshots (Ledger.Crypto (ShelleyLedgerEra era)) -> [Aeson.Pair] poolFields snapshot = case Map.elems (Consensus.ssStakeSnapshots snapshot) of - [pool] -> + [pool] -> [ "poolStakeMark" .= Consensus.ssMarkPool pool , "poolStakeSet" .= Consensus.ssSetPool pool , "poolStakeGo" .= Consensus.ssGoPool pool