Public Network State

cardano-client/src/Cardano/Client/Subscription.hs

@@ -50,6 +50,8 @@ import Ouroboros.Network.NodeToClient (Handshake, LocalAddress (..),
            NodeToClientVersion, NodeToClientVersionData (..), TraceSendRecv,
            Versions)
 import Ouroboros.Network.NodeToClient qualified as NtC
+import Ouroboros.Network.NodeToNode (RemoteAddress)
+import Ouroboros.Network.PublicState qualified as Public
 import Ouroboros.Network.Snocket qualified as Snocket
 
 type MuxMode  = Mx.Mode
@@ -104,7 +106,7 @@ subscribe
   -> SubscriptionParams a
   -> (   NodeToClientVersion
       -> blockVersion
-      -> NodeToClientProtocols Mx.InitiatorMode LocalAddress BSL.ByteString IO a Void)
+      -> NodeToClientProtocols Mx.InitiatorMode RemoteAddress LocalAddress BSL.ByteString IO a Void)
   -> IO ()
 subscribe snocket networkMagic supportedVersions
                   SubscriptionTracers {
@@ -154,7 +156,7 @@ versionedProtocols ::
   -- ^ Use `supportedNodeToClientVersions` from `ouroboros-consensus`.
   -> (   NodeToClientVersion
       -> blockVersion
-      -> NodeToClientProtocols appType LocalAddress bytes m a Void)
+      -> NodeToClientProtocols appType RemoteAddress LocalAddress bytes m a Void)
      -- ^ callback which receives codecs, connection id and STM action which
      -- can be checked if the networking runtime system requests the protocols
      -- to stop.
@@ -165,7 +167,7 @@ versionedProtocols ::
   -> Versions
        NodeToClientVersion
        NodeToClientVersionData
-       (OuroborosApplicationWithMinimalCtx appType LocalAddress bytes m a Void)
+       (OuroborosApplicationWithMinimalCtx appType (Public.NetworkState RemoteAddress) LocalAddress bytes m a Void)
 versionedProtocols networkMagic supportedVersions callback =
     NtC.foldMapVersions applyVersion (Map.toList supportedVersions)
   where
@@ -174,7 +176,7 @@ versionedProtocols networkMagic supportedVersions callback =
       -> Versions
            NodeToClientVersion
            NodeToClientVersionData
-           (OuroborosApplicationWithMinimalCtx appType LocalAddress bytes m a Void)
+           (OuroborosApplicationWithMinimalCtx appType (Public.NetworkState RemoteAddress) LocalAddress bytes m a Void)
     applyVersion (version, blockVersion) =
       NtC.versionedNodeToClientProtocols
         version

ouroboros-network-api/ouroboros-network-api.cabal

@@ -33,6 +33,8 @@ library
     Ouroboros.Network.Block
     Ouroboros.Network.BlockFetch.ConsensusInterface
     Ouroboros.Network.CodecCBORTerm
+    Ouroboros.Network.ConnectionId
+    Ouroboros.Network.ConnectionManager.Public
     Ouroboros.Network.ControlMessage
     Ouroboros.Network.Handshake
     Ouroboros.Network.Handshake.Acceptable
@@ -45,10 +47,11 @@ library
     Ouroboros.Network.PeerSelection.PeerAdvertise
     Ouroboros.Network.PeerSelection.PeerMetric.Type
     Ouroboros.Network.PeerSelection.PeerSharing
-    Ouroboros.Network.PeerSelection.PeerSharing.Codec
     Ouroboros.Network.PeerSelection.RelayAccessPoint
     Ouroboros.Network.Point
     Ouroboros.Network.Protocol.Limits
+    Ouroboros.Network.PublicState
+    Ouroboros.Network.RemoteAddress.Codec
     Ouroboros.Network.SizeInBytes
     Ouroboros.Network.Util.ShowProxy
 
@@ -67,6 +70,7 @@ library
     contra-tracer,
     deepseq,
     dns,
+    hashable,
     io-classes ^>=1.5.0,
     iproute ^>=1.7.15,
     measures,
@@ -93,3 +97,61 @@ library
 
   if flag(asserts)
     ghc-options: -fno-ignore-asserts
+
+library testlib
+  visibility: public
+  hs-source-dirs: testlib
+  exposed-modules:
+    Test.Ouroboros.Network.PublicState.Generators
+
+  default-language: Haskell2010
+  default-extensions: ImportQualifiedPost
+  build-depends:
+    QuickCheck,
+    base,
+    containers,
+    ouroboros-network-api,
+
+  ghc-options:
+    -Wall
+    -Wno-unticked-promoted-constructors
+    -Wcompat
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -Wpartial-fields
+    -Widentities
+    -Wredundant-constraints
+    -Wunused-packages
+
+  if flag(asserts)
+    ghc-options: -fno-ignore-asserts
+
+test-suite test
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  hs-source-dirs: test
+  other-modules:
+    Test.Ouroboros.Network.PublicState
+
+  default-language: Haskell2010
+  default-extensions: ImportQualifiedPost
+  build-depends:
+    base,
+    bytestring,
+    cborg,
+    ouroboros-network-api:{ouroboros-network-api, testlib},
+    serialise,
+    tasty,
+    tasty-quickcheck,
+    with-utf8,
+
+  ghc-options:
+    -Wall
+    -Wno-unticked-promoted-constructors
+    -Wcompat
+    -Wincomplete-uni-patterns
+    -Wincomplete-record-updates
+    -Wpartial-fields
+    -Widentities
+    -Wredundant-constraints
+    -Wunused-packages

ouroboros-network-framework/src/Ouroboros/Network/ConnectionId.hs → 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

@@ -0,0 +1,108 @@
+{-# 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
+-- peer (inbound).
+--
+data Provenance =
+    -- | An inbound connection: one that was initiated by a remote peer.
+    --
+    Inbound
+
+    -- | An outbound connection: one that was initiated by us.
+    --
+  | Outbound
+  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.
+--
+-- NOTE: This type is isomorphic to `DiffusionMode` for `node-to-node`
+-- connections (see `Ouroboros.Network.Diffusion.P2P.ntnDataFlow`), but it isn't
+-- for `node-to-client` connections (see
+-- `Ouroboros.Network.Diffusion.P2P.ntcDataFlow).
+--
+data DataFlow
+    = Unidirectional
+    | Duplex
+  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, Generic)
+
+instance Aeson.ToJSON TimeoutExpired where
+  toEncoding = Aeson.string . show
+
+
+-- | Useful for tracing and error messages.
+--
+data AbstractState =
+    -- | Unknown connection.  This state indicates the connection manager
+    -- removed this connection from its state.
+      UnknownConnectionSt
+    | ReservedOutboundSt
+    | UnnegotiatedSt !Provenance
+    | InboundIdleSt  !DataFlow
+    | InboundSt      !DataFlow
+    | OutboundUniSt
+    | OutboundDupSt  !TimeoutExpired
+    | OutboundIdleSt !DataFlow
+    | DuplexSt
+    | WaitRemoteIdleSt
+    | TerminatingSt
+    | TerminatedSt
+    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/NodeToClient/Version.hs

@@ -53,6 +53,8 @@ data NodeToClientVersion
     -- ^ added @GetLedgerPeerSnapshot@
     | NodeToClientV_20
     -- ^ added @QueryStakePoolDefaultVote@
+    | NodeToClientV_21
+    -- ^ added @GetNetworkState@
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable, Generic, NFData)
 
 -- | We set 16ths bit to distinguish `NodeToNodeVersion` and
@@ -71,6 +73,7 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
           NodeToClientV_18 -> enc 18
           NodeToClientV_19 -> enc 19
           NodeToClientV_20 -> enc 20
+          NodeToClientV_21 -> enc 21
         where
           enc :: Int -> CBOR.Term
           enc = CBOR.TInt . (`setBit` nodeToClientVersionBit)
@@ -82,6 +85,7 @@ nodeToClientVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
             18 -> Right NodeToClientV_18
             19 -> Right NodeToClientV_19
             20 -> Right NodeToClientV_20
+            21 -> Right NodeToClientV_21
             n  -> Left (unknownTag n)
         where
           dec :: CBOR.Term -> Either (Text, Maybe Int) Int