diff --git a/cardano-node/src/Cardano/Node/Tracing/StateRep.hs b/cardano-node/src/Cardano/Node/Tracing/StateRep.hs index 5fc5b4559a9..e83433b13f0 100644 --- a/cardano-node/src/Cardano/Node/Tracing/StateRep.hs +++ b/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 diff --git a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs b/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs index efa90f7a7ab..1ccdbcec090 100644 --- a/cardano-node/src/Cardano/Node/Tracing/Tracers/Startup.hs +++ b/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" .= diff --git a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs b/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs index 1d4f77df1e2..da9ede66eea 100644 --- a/cardano-node/src/Cardano/Tracing/OrphanInstances/Network.hs +++ b/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) =