New NodeToClientVersionOf typeclass

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

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
 

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)

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

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