NodeToNodeVersion and NodeToClientVersion JSON instances

cardano-node/src/Cardano/Node/Tracing/StateRep.hs

@@ -3,7 +3,6 @@
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE StandaloneDeriving #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
 
@@ -74,12 +73,6 @@ data AddedToCurrentChain
   = AddedToCurrentChain !EpochNo !SlotNo !SyncPercentage
   deriving (Generic, FromJSON, ToJSON)
 
-deriving instance Generic NPV.NodeToClientVersion
-deriving instance Generic NPV.NodeToNodeVersion
-
-instance FromJSON NPV.NodeToClientVersion
-instance FromJSON NPV.NodeToNodeVersion
-
 data StartupState
   = StartupSocketConfigError Text
   | StartupDBValidation

cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE RecordWildCards #-}
@@ -17,6 +18,7 @@ import qualified Cardano.Api as Api
 import           Prelude
 
 import           Data.Aeson (ToJSON (..), Value (..), (.=))
+import qualified Data.Aeson as Aeson
 import           Data.List (intercalate)
 import qualified Data.Map.Strict as Map
 import           Data.Text (Text, pack)
@@ -121,6 +123,27 @@ getStartupInfo nc (SomeConsensusProtocol whichP pForInfo) fp = do
 -- -- StartupInfo Tracer
 -- --------------------------------------------------------------------------------
 
+
+-- | A tuple of consensus and network versions.  It's used to derive a custom
+-- `FromJSON` and `ToJSON` instances.
+--
+data ConsensusNetworkVersionTuple a b = ConsensusNetworkVersionTuple a b
+
+-- TODO: provide JSON instance for `BlockNodeToClientVersion`
+instance Show blkVersion => ToJSON (ConsensusNetworkVersionTuple NodeToClientVersion blkVersion) where
+    toJSON (ConsensusNetworkVersionTuple nodeToClientVersion blockVersion) =
+      Aeson.object [ "nodeToClientVersion" .= toJSON nodeToClientVersion
+                   , "blockVersion" .= String (pack . show $ blockVersion)
+                   ]
+
+-- TODO: provide JSON instance for `BlockNodeToNodeVersion`
+instance Show blkVersion => ToJSON (ConsensusNetworkVersionTuple NodeToNodeVersion blkVersion) where
+    toJSON (ConsensusNetworkVersionTuple nodeToClientVersion blockVersion) =
+      Aeson.object [ "nodeToNodeVersion" .= toJSON nodeToClientVersion
+                   , "blockVersion" .= String (pack . show $ blockVersion)
+                   ]
+
+
 instance ( Show (BlockNodeToNodeVersion blk)
          , Show (BlockNodeToClientVersion blk)
          )
@@ -142,9 +165,9 @@ instance ( Show (BlockNodeToNodeVersion blk)
         case dtal of
           DMaximum ->
             [ "nodeToNodeVersions" .=
-                toJSON (map show . Map.assocs $ supportedNodeToNodeVersions)
+                toJSON (map (uncurry ConsensusNetworkVersionTuple) . Map.assocs $ supportedNodeToNodeVersions)
             , "nodeToClientVersions" .=
-                toJSON (map show . Map.assocs $ supportedNodeToClientVersions)
+                toJSON (map (uncurry ConsensusNetworkVersionTuple) . Map.assocs $ supportedNodeToClientVersions)
             ]
           _ ->
             [ "maxNodeToNodeVersion" .=

cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs

@@ -17,7 +17,7 @@ module Cardano.Tracing.OrphanInstances.Network () where
 
 import           Control.Exception (Exception (..), SomeException (..))
 import           Control.Monad.Class.MonadTime (DiffTime, Time (..))
-import           Data.Aeson (Value (..))
+import           Data.Aeson (Value (..), FromJSON (..))
 import qualified Data.Aeson as Aeson
 import           Data.Aeson.Types (listValue)
 import           Data.Bifunctor (Bifunctor (..))
@@ -67,9 +67,9 @@ import qualified Ouroboros.Network.InboundGovernor as InboundGovernor
 import           Ouroboros.Network.InboundGovernor.State (InboundGovernorCounters (..))
 import           Ouroboros.Network.KeepAlive (TraceKeepAliveClient (..))
 import           Ouroboros.Network.Magic (NetworkMagic (..))
-import           Ouroboros.Network.NodeToClient (NodeToClientVersion, NodeToClientVersionData (..))
+import           Ouroboros.Network.NodeToClient (NodeToClientVersion (..), NodeToClientVersionData (..))
 import qualified Ouroboros.Network.NodeToClient as NtC
-import           Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), NodeToNodeVersion,
+import           Ouroboros.Network.NodeToNode (ErrorPolicyTrace (..), NodeToNodeVersion (..),
                    NodeToNodeVersionData (..), RemoteAddress, TraceSendRecv (..), WithAddr (..))
 import qualified Ouroboros.Network.NodeToNode as NtN
 import qualified Ouroboros.Network.PeerSelection.EstablishedPeers as EstablishedPeers
@@ -1756,10 +1756,40 @@ instance Show vNumber => ToJSON (HandshakeException vNumber) where
                  ]
 
 instance ToJSON NodeToNodeVersion where
-  toJSON x = String (pack $ show x)
+  toJSON NodeToNodeV_7  = Number 7
+  toJSON NodeToNodeV_8  = Number 8
+  toJSON NodeToNodeV_9  = Number 9
+  toJSON NodeToNodeV_10 = Number 10
+  toJSON NodeToNodeV_11  = Number 11
+
+instance FromJSON NodeToNodeVersion where
+  parseJSON (Number 7) = return NodeToNodeV_7
+  parseJSON (Number 8) = return NodeToNodeV_8
+  parseJSON (Number 9) = return NodeToNodeV_9
+  parseJSON (Number 10) = return NodeToNodeV_10
+  parseJSON (Number 11) = return NodeToNodeV_11
+  parseJSON (Number x) = fail ("FromJSON.NodeToNodeVersion: unsupported node-to-node protocol version " ++ show x)
+  parseJSON x          = fail ("FromJSON.NodeToNodeVersion: error parsing NodeToNodeVersion: " ++ show x)
 
 instance ToJSON NodeToClientVersion where
-  toJSON x = String (pack $ show x)
+  toJSON NodeToClientV_9  = Number 9
+  toJSON NodeToClientV_10 = Number 10
+  toJSON NodeToClientV_11 = Number 11
+  toJSON NodeToClientV_12 = Number 12
+  toJSON NodeToClientV_13 = Number 13
+  toJSON NodeToClientV_14 = Number 14
+  toJSON NodeToClientV_15 = Number 15
+
+instance FromJSON NodeToClientVersion where
+  parseJSON (Number 9) = return NodeToClientV_9
+  parseJSON (Number 10) = return NodeToClientV_10
+  parseJSON (Number 11) = return NodeToClientV_11
+  parseJSON (Number 12) = return NodeToClientV_12
+  parseJSON (Number 13) = return NodeToClientV_13
+  parseJSON (Number 14) = return NodeToClientV_14
+  parseJSON (Number 15) = return NodeToClientV_15
+  parseJSON (Number x) = fail ("FromJSON.NodeToClientVersion: unsupported node-to-client protocol version " ++ show x)
+  parseJSON x          = fail ("FromJSON.NodeToClientVersion: error parsing NodeToClientVersion: " ++ show x)
 
 instance ToJSON NodeToNodeVersionData where
   toJSON (NodeToNodeVersionData (NetworkMagic m) dm) =