NetworkState - ToJSON instances

Author: coot

ouroboros-network-api/src/Ouroboros/Network/ConnectionId.hs

@@ -1,17 +1,18 @@
 {-# LANGUAGE DeriveFunctor       #-}
 {-# LANGUAGE DeriveGeneric       #-}
-{-# LANGUAGE DerivingStrategies  #-}
 {-# LANGUAGE DerivingVia         #-}
+{-# LANGUAGE NamedFieldPuns      #-}
 {-# LANGUAGE RankNTypes          #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving  #-}
 {-# LANGUAGE StaticPointers      #-}
 
 module Ouroboros.Network.ConnectionId where
 
 import NoThunks.Class (InspectHeap (..), NoThunks)
 
+import Data.Aeson qualified as Aeson
 import Data.Hashable
+import Data.String (fromString)
 import GHC.Generics (Generic)
 import Ouroboros.Network.Util.ShowProxy (Proxy (..), ShowProxy (..))
 
@@ -29,6 +30,14 @@ data ConnectionId addr = ConnectionId {
   deriving NoThunks via InspectHeap (ConnectionId addr)
   deriving Functor
 
+instance Aeson.ToJSON addr => Aeson.ToJSONKey (ConnectionId addr) where
+instance Aeson.ToJSON addr => Aeson.ToJSON (ConnectionId addr) where
+    toEncoding ConnectionId {remoteAddress, localAddress} =
+      Aeson.pairs $
+           fromString "remoteAddress" Aeson..= remoteAddress
+        <> fromString "localAddress"  Aeson..= localAddress
+
+
 -- | Order first by `remoteAddress` then by `localAddress`.
 --
 -- /Note:/ we relay on the fact that `remoteAddress` is an order

ouroboros-network-api/src/Ouroboros/Network/ConnectionManager/Public.hs

@@ -1,11 +1,17 @@
+{-# LANGUAGE DeriveGeneric #-}
+
 module Ouroboros.Network.ConnectionManager.Public
   ( Provenance (..)
   , DataFlow (..)
   , TimeoutExpired (..)
   , AbstractState (..)
   ) where
 
+import Data.Aeson qualified as Aeson
+import Data.Aeson.Encoding qualified as Aeson
+import Data.String (fromString)
 import Data.Typeable (Typeable)
+import GHC.Generics
 
 
 -- | Each connection is is either initiated locally (outbound) or by a remote
@@ -19,8 +25,10 @@ data Provenance =
     -- | An outbound connection: one that was initiated by us.
     --
   | Outbound
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Generic)
 
+instance Aeson.ToJSON Provenance where
+  toEncoding = Aeson.string . show
 
 -- | Each connection negotiates if it is uni- or bi-directional.  'DataFlow'
 -- is a life time property of a connection, once negotiated it never changes.
@@ -33,13 +41,19 @@ data Provenance =
 data DataFlow
     = Unidirectional
     | Duplex
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Generic)
+
+instance Aeson.ToJSON DataFlow where
+  toEncoding = Aeson.string . show
 
 
 -- | Boolean like type which indicates if the timeout on 'OutboundStateDuplex'
 -- has expired.
 data TimeoutExpired = Expired | Ticking
-  deriving (Eq, Ord, Show)
+  deriving (Eq, Ord, Show, Generic)
+
+instance Aeson.ToJSON TimeoutExpired where
+  toEncoding = Aeson.string . show
 
 
 -- | Useful for tracing and error messages.
@@ -59,4 +73,36 @@ data AbstractState =
     | WaitRemoteIdleSt
     | TerminatingSt
     | TerminatedSt
-    deriving (Eq, Ord, Show, Typeable)
+    deriving (Eq, Ord, Show, Typeable, Generic)
+
+instance Aeson.ToJSON AbstractState where
+  toEncoding UnknownConnectionSt =
+    Aeson.pairs $ fromString "type" Aeson..= "UnknownConnectionState"
+  toEncoding ReservedOutboundSt =
+    Aeson.pairs $ fromString "type" Aeson..= "ReservedOutboundState"
+  toEncoding (UnnegotiatedSt a) =
+    Aeson.pairs $ fromString "type" Aeson..= "UnnegotiatedState"
+               <> fromString "provenance" Aeson..= a
+  toEncoding (InboundIdleSt a) =
+    Aeson.pairs $ fromString "type" Aeson..= "InboundIdleState"
+               <> fromString "dataFlow" Aeson..= a
+  toEncoding (InboundSt a) =
+    Aeson.pairs $ fromString "type" Aeson..= "InboundState"
+               <> fromString "dataFlow" Aeson..= a
+  toEncoding OutboundUniSt =
+    Aeson.pairs $ fromString "type" Aeson..= "OutboundUnidirectionalState"
+  toEncoding (OutboundDupSt a) =
+    Aeson.pairs $ fromString "type" Aeson..= "OutboundDuplexState"
+               <> fromString "timeout" Aeson..= a
+  toEncoding (OutboundIdleSt a) =
+    Aeson.pairs $ fromString "type" Aeson..= "OutboundIdleState"
+               <> fromString "dataFlow" Aeson..= a
+  toEncoding DuplexSt =
+    Aeson.pairs $ fromString "type" Aeson..= "DuplexState"
+  toEncoding WaitRemoteIdleSt =
+    Aeson.pairs $ fromString "type" Aeson..= "WaitRemoteIdleState"
+  toEncoding TerminatingSt =
+    Aeson.pairs $ fromString "type" Aeson..= "TerminatingState"
+  toEncoding TerminatedSt =
+    Aeson.pairs $ fromString "type" Aeson..= "TerminatedState"
+

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE LambdaCase        #-}
 
@@ -12,6 +13,8 @@ module Ouroboros.Network.PeerSelection.PeerSharing.Codec
 import Codec.CBOR.Decoding qualified as CBOR
 import Codec.CBOR.Encoding qualified as CBOR
 import Codec.Serialise (Serialise (..))
+import Data.Aeson qualified as Aeson
+import GHC.Generics
 
 import Network.Socket (PortNumber, SockAddr (..))
 
@@ -72,11 +75,15 @@ decodeRemoteAddress = do
 --
 newtype RemoteAddressEncoding addr =
     RemoteAddressEncoding { getRemoteAddressEncoding :: addr }
-  deriving (Eq, Ord)
+  deriving (Eq, Ord, Generic)
 
 -- | This instance is used by `LocalStateQuery` mini-protocol codec in
 -- `ouroboros-consensus-diffusion`.
 --
 instance Serialise (RemoteAddressEncoding SockAddr) where
   encode = encodeRemoteAddress . getRemoteAddressEncoding
   decode = RemoteAddressEncoding <$> decodeRemoteAddress
+
+instance Aeson.ToJSON (RemoteAddressEncoding SockAddr) where
+  toJSON     (RemoteAddressEncoding addr) = Aeson.toJSON (show addr)
+  toEncoding (RemoteAddressEncoding addr) = Aeson.toEncoding (show addr)

ouroboros-network-api/src/Ouroboros/Network/PublicState.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveGeneric    #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE NamedFieldPuns   #-}
 
@@ -25,10 +26,13 @@ import Codec.CBOR.Encoding
 import Codec.Serialise (Serialise)
 import Codec.Serialise.Class (decode, encode)
 import Control.Monad (replicateM)
+import Data.Aeson qualified as Aeson
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
+import Data.String (fromString)
+import GHC.Generics
 
 import Ouroboros.Network.ConnectionId
 import Ouroboros.Network.ConnectionManager.Public
@@ -44,7 +48,7 @@ data ConnectionManagerState peeraddr = ConnectionManagerState {
     registeredOutboundConnections :: Set peeraddr
     -- ^ set of outbound connections in `ReserverdOutboundSt` state.
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
 
 -- | Map 'ConnectionManagerState'
 --
@@ -64,14 +68,32 @@ mapConnectionManagerStateMonotonic
     registeredOutboundConnections = Set.mapMonotonic fn registeredOutboundConnections
   }
 
+instance Aeson.ToJSON peeraddr => Aeson.ToJSON (ConnectionManagerState peeraddr) where
+  toEncoding ConnectionManagerState { connectionMap, registeredOutboundConnections } =
+    Aeson.pairs $
+         fromString "connectionMap" Aeson..= connectionMap
+      <> fromString "registeredOutboundConnections" Aeson..= registeredOutboundConnections
 
 data InboundState peeraddr = InboundState {
     remoteHotSet  :: !(Set (ConnectionId peeraddr)),
     remoteWarmSet :: !(Set (ConnectionId peeraddr)),
     remoteColdSet :: !(Set (ConnectionId peeraddr)),
     remoteIdleSet :: !(Set (ConnectionId peeraddr))
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+
+instance Aeson.ToJSON peeraddr => Aeson.ToJSON (InboundState peeraddr) where
+  toEncoding InboundState {
+      remoteHotSet,
+      remoteWarmSet,
+      remoteColdSet,
+      remoteIdleSet
+    } =
+    Aeson.pairs $
+         fromString "remoteHotSet" Aeson..= remoteHotSet
+      <> fromString "remoteWarmSet" Aeson..= remoteWarmSet
+      <> fromString "remoteColdSet" Aeson..= remoteColdSet
+      <> fromString "remoteIdleSet" Aeson..= remoteIdleSet
 
 mapInboundStateMonotonic
   :: (peeraddr -> peeraddr')
@@ -106,7 +128,18 @@ data OutboundState peeraddr = OutboundState {
     warmPeers :: Set peeraddr,
     hotPeers  :: Set peeraddr
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+
+instance Aeson.ToJSON peeraddr => Aeson.ToJSON (OutboundState peeraddr) where
+  toEncoding OutboundState {
+      hotPeers,
+      warmPeers,
+      coldPeers
+    } =
+    Aeson.pairs $
+         fromString "hotPeers"  Aeson..= hotPeers
+      <> fromString "warmPeers" Aeson..= warmPeers
+      <> fromString "coldPeers" Aeson..= coldPeers
 
 mapOutboundStateMonotonic
   :: (peeraddr -> peeraddr')
@@ -135,7 +168,18 @@ data NetworkState peeraddr = NetworkState {
     inboundGovernorState   :: InboundState peeraddr,
     outboundGovernorState  :: OutboundState peeraddr
   }
-  deriving (Eq, Show)
+  deriving (Eq, Show, Generic)
+
+instance Aeson.ToJSON peeraddr => Aeson.ToJSON (NetworkState peeraddr) where
+  toEncoding NetworkState {
+      connectionManagerState,
+      inboundGovernorState,
+      outboundGovernorState
+    } =
+    Aeson.pairs $
+         fromString "connectionManagerState" Aeson..= connectionManagerState
+      <> fromString "inboundGovernorState"   Aeson..= inboundGovernorState
+      <> fromString "outboundGovernorState"  Aeson..= outboundGovernorState
 
 mapNetworkStateMonotonic
   :: (peeraddr -> peeraddr')