Fix Peer Sharing issue #4642

- Adds `LocalPeerSharing` and `RemotePeerSharing` newtypes
- Add `localPeerSharing` and `remotePeerSharing` fields to
  `NodeToNodeVersionData` and `DataFlowProtocolData`
- Renamed `cmGetPeerSharing` to `cmGetRemotePeerSharing`
- Used `LocalPeerSharing` and `RemotePeerSharing` whenever it is useful
- Add test to check that the bug is fixed

ouroboros-network-api/CHANGELOG.md

@@ -4,6 +4,9 @@
 
 ### Breaking changes
 
+- Create `LocalPeerSharing` and `RemotePeerSharing` newtypes.
+- Add `LocalPeerSharing` and `RemotePeerSharing` fields to `NodeToNodeVersionData`.
+
 ### Non-breaking changes
 
 ## 0.5.1.0 -- 2023-08-09

ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs

@@ -3,6 +3,8 @@
 module Ouroboros.Network.NodeToNode.Version
   ( NodeToNodeVersion (..)
   , NodeToNodeVersionData (..)
+  , LocalPeerSharing (..)
+  , RemotePeerSharing (..)
   , DiffusionMode (..)
   , ConnectionMode (..)
   , nodeToNodeVersionCodec
@@ -16,6 +18,7 @@ import           Data.Typeable (Typeable)
 
 import qualified Codec.CBOR.Term as CBOR
 
+import           Data.Coerce (coerce)
 import           Ouroboros.Network.BlockFetch.ConsensusInterface
                      (WhetherReceivingTentativeBlocks (..))
 import           Ouroboros.Network.CodecCBORTerm
@@ -108,15 +111,34 @@ data DiffusionMode
 -- | Version data for NodeToNode protocol
 --
 data NodeToNodeVersionData = NodeToNodeVersionData
-  { networkMagic  :: !NetworkMagic
-  , diffusionMode :: !DiffusionMode
-  , peerSharing   :: !PeerSharing
-  , query         :: !Bool
+  { networkMagic      :: !NetworkMagic
+  , diffusionMode     :: !DiffusionMode
+  , localPeerSharing  :: !LocalPeerSharing
+  , remotePeerSharing :: !RemotePeerSharing
+  , query             :: !Bool
   }
   deriving (Show, Typeable, Eq)
   -- 'Eq' instance is not provided, it is not what we need in version
   -- negotiation (see 'Acceptable' instance below).
 
+-- | Local side peer sharing value.
+--
+-- This newtype is useful to distinguish the relevant side of the needed
+-- peer sharing value.
+--
+newtype LocalPeerSharing =
+  LocalPeerSharing { getLocalPeerSharing :: PeerSharing }
+  deriving (Eq, Show)
+
+-- | Remote side peer sharing value.
+--
+-- This newtype is useful to distinguish the relevant side of the needed
+-- peer sharing value.
+--
+newtype RemotePeerSharing =
+  RemotePeerSharing { getRemotePeerSharing :: PeerSharing }
+  deriving (Eq, Show)
+
 instance Acceptable NodeToNodeVersionData where
     -- | Check that both side use the same 'networkMagic'.  Choose smaller one
     -- from both 'diffusionMode's, e.g. if one is running in 'InitiatorOnlyMode'
@@ -127,7 +149,8 @@ instance Acceptable NodeToNodeVersionData where
       = Accept NodeToNodeVersionData
           { networkMagic  = networkMagic local
           , diffusionMode = diffusionMode local `min` diffusionMode remote
-          , peerSharing   = peerSharing remote
+          , localPeerSharing  = localPeerSharing local
+          , remotePeerSharing = coerce $ localPeerSharing remote
           , query         = query local || query remote
           }
       | otherwise
@@ -142,42 +165,56 @@ nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVer
 nodeToNodeCodecCBORTerm version
   | version >= NodeToNodeV_11 =
     let encodeTerm :: NodeToNodeVersionData -> CBOR.Term
-        encodeTerm NodeToNodeVersionData { networkMagic, diffusionMode, peerSharing, query }
+        encodeTerm NodeToNodeVersionData { networkMagic, diffusionMode, localPeerSharing, remotePeerSharing, query }
           = CBOR.TList $
               [ CBOR.TInt (fromIntegral $ unNetworkMagic networkMagic)
               , CBOR.TBool (case diffusionMode of
                              InitiatorOnlyDiffusionMode         -> True
                              InitiatorAndResponderDiffusionMode -> False)
-              , CBOR.TInt (case peerSharing of
-                             NoPeerSharing      -> 0
-                             PeerSharingPrivate -> 1
-                             PeerSharingPublic  -> 2)
+              , CBOR.TInt (case localPeerSharing of
+                             LocalPeerSharing NoPeerSharing      -> 0
+                             LocalPeerSharing PeerSharingPrivate -> 1
+                             LocalPeerSharing PeerSharingPublic  -> 2)
+              , CBOR.TInt (case remotePeerSharing of
+                             RemotePeerSharing NoPeerSharing      -> 0
+                             RemotePeerSharing PeerSharingPrivate -> 1
+                             RemotePeerSharing PeerSharingPublic  -> 2)
               , CBOR.TBool query
               ]
 
         decodeTerm :: NodeToNodeVersion -> CBOR.Term -> Either Text NodeToNodeVersionData
-        decodeTerm _ (CBOR.TList [CBOR.TInt x, CBOR.TBool diffusionMode, CBOR.TInt peerSharing, CBOR.TBool query])
+        decodeTerm _ (CBOR.TList [CBOR.TInt x, CBOR.TBool diffusionMode, CBOR.TInt localPeerSharing, CBOR.TInt remotePeerSharing, CBOR.TBool query])
           | x >= 0
           , x <= 0xffffffff
-          , peerSharing >= 0
-          , peerSharing <= 2
+          , localPeerSharing >= 0
+          , localPeerSharing <= 2
+          , remotePeerSharing >= 0
+          , remotePeerSharing <= 2
           = Right
               NodeToNodeVersionData {
                   networkMagic = NetworkMagic (fromIntegral x),
                   diffusionMode = if diffusionMode
                                   then InitiatorOnlyDiffusionMode
                                   else InitiatorAndResponderDiffusionMode,
-                  peerSharing = case peerSharing of
-                                  0 -> NoPeerSharing
-                                  1 -> PeerSharingPrivate
-                                  2 -> PeerSharingPublic
+                  localPeerSharing = case localPeerSharing of
+                                  0 -> LocalPeerSharing NoPeerSharing
+                                  1 -> LocalPeerSharing PeerSharingPrivate
+                                  2 -> LocalPeerSharing PeerSharingPublic
+                                  _ -> error "decodeTerm: impossible happened!",
+                  remotePeerSharing = case remotePeerSharing of
+                                  0 -> RemotePeerSharing NoPeerSharing
+                                  1 -> RemotePeerSharing PeerSharingPrivate
+                                  2 -> RemotePeerSharing PeerSharingPublic
                                   _ -> error "decodeTerm: impossible happened!",
                   query = query
                 }
           | x < 0 || x > 0xffffffff
           = Left $ T.pack $ "networkMagic out of bound: " <> show x
-          | otherwise -- peerSharing < 0 || peerSharing > 2
-          = Left $ T.pack $ "peerSharing out of bound: " <> show peerSharing
+          | otherwise -- localPeerSharing < 0 || localPeerSharing > 2
+                      -- OR
+                      -- remotePeerSharing < 0 || remotePeerSharing > 2
+          = Left $ T.pack $ "Either localPeerSharing is out of bound: " <> show localPeerSharing
+                          <> "\nOr remotePeerSharing is out of bound: " <> show remotePeerSharing
         decodeTerm _ t
           = Left $ T.pack $ "unknown encoding: " ++ show t
      in CodecCBORTerm {encodeTerm, decodeTerm = decodeTerm version }
@@ -203,7 +240,8 @@ nodeToNodeCodecCBORTerm version
                                   else InitiatorAndResponderDiffusionMode
                   -- By default older versions do not participate in Peer
                   -- Sharing, since they do not support the new miniprotocol
-                , peerSharing = NoPeerSharing
+                , localPeerSharing = LocalPeerSharing NoPeerSharing
+                , remotePeerSharing = RemotePeerSharing NoPeerSharing
                 , query = False
                 }
           | otherwise

ouroboros-network-framework/CHANGELOG.md

@@ -4,6 +4,11 @@
 
 ### Breaking changes
 
+- Renamed `cmGetPeerSharing` to `cmGetRemotePeerSharing`
+- Used `LocalPeerSharing` and `RemotePeerSharing` new types instead of just
+  `PeerSharing`
+- Added `LocalPeerSharing` and `RemotePeerSharing` to `DataFlowProtocolData`
+
 ### Non-breaking changes
 
 ## 0.8.0.0 -- 2023-08-09

ouroboros-network-framework/demo/connection-manager.hs

@@ -65,6 +65,7 @@ import           Ouroboros.Network.Context
 import           Ouroboros.Network.IOManager
 import           Ouroboros.Network.Mux
 import           Ouroboros.Network.MuxMode
+import           Ouroboros.Network.NodeToNode.Version (RemotePeerSharing (..))
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           Ouroboros.Network.Protocol.Handshake
 import           Ouroboros.Network.Protocol.Handshake.Codec
@@ -247,7 +248,7 @@ withBidirectionalConnectionManager snocket makeBearer socket
               acceptedConnectionsSoftLimit = maxBound,
               acceptedConnectionsDelay     = 0
             },
-          cmGetPeerSharing = \_ -> NoPeerSharing
+          cmGetRemotePeerSharing = \_ -> RemotePeerSharing NoPeerSharing
         }
         (makeConnectionHandler
           muxTracer

ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs

@@ -63,7 +63,7 @@ import qualified Ouroboros.Network.ConnectionManager.Types as CM
 import           Ouroboros.Network.InboundGovernor.Event
                      (NewConnectionInfo (..))
 import           Ouroboros.Network.MuxMode
-import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
+import           Ouroboros.Network.NodeToNode.Version (RemotePeerSharing)
 import           Ouroboros.Network.Server.RateLimiting
                      (AcceptedConnectionsLimit (..))
 import           Ouroboros.Network.Snocket
@@ -140,8 +140,9 @@ data ConnectionManagerArguments handlerTrace socket peerAddr handle handleError
         cmPrunePolicy         :: PrunePolicy peerAddr (STM m),
         cmConnectionsLimits   :: AcceptedConnectionsLimit,
 
-        -- | How to extract PeerSharing information from versionData
-        cmGetPeerSharing      :: versionData -> PeerSharing
+        -- | How to extract remote side's PeerSharing information from
+        -- versionData
+        cmGetRemotePeerSharing :: versionData -> RemotePeerSharing
       }
 
 
@@ -559,7 +560,7 @@ withConnectionManager
     -> InResponderMode muxMode (InformationChannel (NewConnectionInfo peerAddr handle) m)
     -- ^ On outbound duplex connections we need to notify the server about
     -- a new connection.
-    -> InResponderMode muxMode (InformationChannel (peerAddr, PeerSharing) m)
+    -> InResponderMode muxMode (InformationChannel (peerAddr, RemotePeerSharing) m)
     -- ^ On inbound duplex connections we need to notify the outbound governor about
     -- a new connection.
     -> (ConnectionManager muxMode socket peerAddr handle handleError m -> m a)
@@ -582,7 +583,7 @@ withConnectionManager ConnectionManagerArguments {
                           connectionDataFlow,
                           cmPrunePolicy,
                           cmConnectionsLimits,
-                          cmGetPeerSharing
+                          cmGetRemotePeerSharing
                         }
                       ConnectionHandler {
                           connectionHandler
@@ -1206,7 +1207,7 @@ withConnectionManager ConnectionManagerArguments {
                       InResponderMode infoChannel | notifyOutboundGov ->
                         atomically $ InfoChannel.writeMessage
                                        infoChannel
-                                       (peerAddr, cmGetPeerSharing versionData)
+                                       (peerAddr, cmGetRemotePeerSharing versionData)
 
                       _ -> return ()
 
@@ -1815,11 +1816,11 @@ withConnectionManager ConnectionManagerArguments {
                           let connState' = OutboundDupState connId connThread handle Ticking
                               notifyInboundGov =
                                 case provenance' of
-                                  Inbound  -> False
-                                  -- ^ This is a connection to oneself; We don't
+                                  -- This is a connection to oneself; We don't
                                   -- need to notify the inbound governor, as
                                   -- it's already done by
                                   -- `includeInboundConnectionImpl`
+                                  Inbound  -> False
                                   Outbound -> True
                           writeTVar connVar connState'
                           case inboundGovernorInfoChannel of

ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/InformationChannel.hs

@@ -11,7 +11,7 @@ import           Ouroboros.Network.ConnectionHandler (Handle)
 import           Ouroboros.Network.Context (ResponderContext)
 import           Ouroboros.Network.InboundGovernor.Event (NewConnectionInfo)
 import           Ouroboros.Network.Mux (MuxMode)
-import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
+import           Ouroboros.Network.NodeToNode.Version (RemotePeerSharing)
 
 -- | Information channel.
 --
@@ -42,7 +42,7 @@ type InboundGovernorInfoChannel (muxMode :: MuxMode) initiatorCtx peerAddr versi
 -- Server.
 --
 type OutboundGovernorInfoChannel peerAddr m =
-    InformationChannel (peerAddr, PeerSharing) m
+    InformationChannel (peerAddr, RemotePeerSharing) m
 
 
 newInformationChannel :: forall a m.

ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs

@@ -26,6 +26,8 @@ import           Network.TypedProtocol.Codec
 
 import           Ouroboros.Network.CodecCBORTerm
 import           Ouroboros.Network.ConnectionManager.Types (DataFlow (..))
+import           Ouroboros.Network.NodeToNode.Version (LocalPeerSharing (..),
+                     RemotePeerSharing (..))
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           Ouroboros.Network.Protocol.Handshake.Codec
 import           Ouroboros.Network.Protocol.Handshake.Type
@@ -76,36 +78,59 @@ unversionedProtocol = simpleSingletonVersions UnversionedProtocol UnversionedPro
 --
 data DataFlowProtocolData =
     DataFlowProtocolData {
-      getProtocolDataFlow    :: DataFlow,
-      getProtocolPeerSharing :: PeerSharing
+      getProtocolDataFlow          :: DataFlow,
+      getProtocolLocalPeerSharing  :: LocalPeerSharing,
+      getProtocolRemotePeerSharing :: RemotePeerSharing
     }
   deriving (Eq, Show)
 
 instance Acceptable DataFlowProtocolData where
-  acceptableVersion (DataFlowProtocolData local _) (DataFlowProtocolData remote ps) =
-    Accept (DataFlowProtocolData (local `min` remote) ps)
+  acceptableVersion (DataFlowProtocolData local _ _) (DataFlowProtocolData remote lps rps) =
+    Accept (DataFlowProtocolData (local `min` remote) lps rps)
 
 instance Queryable DataFlowProtocolData where
-  queryVersion (DataFlowProtocolData _ _) = False
+  queryVersion (DataFlowProtocolData _ _ _) = False
 
 dataFlowProtocolDataCodec :: UnversionedProtocol -> CodecCBORTerm Text DataFlowProtocolData
 dataFlowProtocolDataCodec _ = CodecCBORTerm {encodeTerm, decodeTerm}
     where
       encodeTerm :: DataFlowProtocolData -> CBOR.Term
-      encodeTerm (DataFlowProtocolData Unidirectional NoPeerSharing)      = CBOR.TList [CBOR.TBool False, CBOR.TInt 0]
-      encodeTerm (DataFlowProtocolData Unidirectional PeerSharingPrivate) = CBOR.TList [CBOR.TBool False, CBOR.TInt 1]
-      encodeTerm (DataFlowProtocolData Unidirectional PeerSharingPublic)  = CBOR.TList [CBOR.TBool False, CBOR.TInt 2]
-      encodeTerm (DataFlowProtocolData Duplex NoPeerSharing)      = CBOR.TList [CBOR.TBool True, CBOR.TInt 0]
-      encodeTerm (DataFlowProtocolData Duplex PeerSharingPrivate) = CBOR.TList [CBOR.TBool True, CBOR.TInt 1]
-      encodeTerm (DataFlowProtocolData Duplex PeerSharingPublic)  = CBOR.TList [CBOR.TBool True, CBOR.TInt 2]
+      encodeTerm (DataFlowProtocolData Unidirectional (LocalPeerSharing a) (RemotePeerSharing b)) =
+        let localPeerSharing = case a of
+              NoPeerSharing      -> 0
+              PeerSharingPrivate -> 1
+              PeerSharingPublic  -> 2
+            remotePeerSharing = case b of
+              NoPeerSharing      -> 0
+              PeerSharingPrivate -> 1
+              PeerSharingPublic  -> 2
+         in CBOR.TList [CBOR.TBool False, CBOR.TInt localPeerSharing, CBOR.TInt remotePeerSharing]
+      encodeTerm (DataFlowProtocolData Duplex (LocalPeerSharing a) (RemotePeerSharing b)) =
+        let localPeerSharing = case a of
+              NoPeerSharing      -> 0
+              PeerSharingPrivate -> 1
+              PeerSharingPublic  -> 2
+            remotePeerSharing = case b of
+              NoPeerSharing      -> 0
+              PeerSharingPrivate -> 1
+              PeerSharingPublic  -> 2
+         in CBOR.TList [CBOR.TBool True, CBOR.TInt localPeerSharing, CBOR.TInt remotePeerSharing]
+
+      toLocalPeerSharing :: Int -> LocalPeerSharing
+      toLocalPeerSharing 0 = LocalPeerSharing NoPeerSharing
+      toLocalPeerSharing 1 = LocalPeerSharing PeerSharingPrivate
+      toLocalPeerSharing 2 = LocalPeerSharing PeerSharingPublic
+      toLocalPeerSharing _ = error "toLocalPeerSharing: out of bounds"
+
+      toRemotePeerSharing :: Int -> RemotePeerSharing
+      toRemotePeerSharing 0 = RemotePeerSharing NoPeerSharing
+      toRemotePeerSharing 1 = RemotePeerSharing PeerSharingPrivate
+      toRemotePeerSharing 2 = RemotePeerSharing PeerSharingPublic
+      toRemotePeerSharing _ = error "toRemotePeerSharing: out of bounds"
 
       decodeTerm :: CBOR.Term -> Either Text DataFlowProtocolData
-      decodeTerm (CBOR.TList [CBOR.TBool False, CBOR.TInt 0]) = Right (DataFlowProtocolData Unidirectional NoPeerSharing)
-      decodeTerm (CBOR.TList [CBOR.TBool False, CBOR.TInt 1]) = Right (DataFlowProtocolData Unidirectional PeerSharingPrivate)
-      decodeTerm (CBOR.TList [CBOR.TBool False, CBOR.TInt 2]) = Right (DataFlowProtocolData Unidirectional PeerSharingPublic)
-      decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt 0])  = Right (DataFlowProtocolData Duplex NoPeerSharing)
-      decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt 1])  = Right (DataFlowProtocolData Duplex PeerSharingPrivate)
-      decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt 2])  = Right (DataFlowProtocolData Duplex PeerSharingPublic)
+      decodeTerm (CBOR.TList [CBOR.TBool False, CBOR.TInt a, CBOR.TInt b]) = Right (DataFlowProtocolData Unidirectional (toLocalPeerSharing a) (toRemotePeerSharing b))
+      decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt a, CBOR.TInt b])  = Right (DataFlowProtocolData Duplex (toLocalPeerSharing a) (toRemotePeerSharing b))
       decodeTerm t                  = Left $ T.pack $ "unexpected term: " ++ show t
 
 dataFlowProtocol :: DataFlow
@@ -114,7 +139,7 @@ dataFlowProtocol :: DataFlow
                              DataFlowProtocolData
                              app
 dataFlowProtocol dataFlow =
-    simpleSingletonVersions UnversionedProtocol (DataFlowProtocolData dataFlow NoPeerSharing)
+    simpleSingletonVersions UnversionedProtocol (DataFlowProtocolData dataFlow (LocalPeerSharing NoPeerSharing) (RemotePeerSharing NoPeerSharing))
 
 -- | 'Handshake' codec used in various tests.
 --

ouroboros-network-framework/test/Test/Ouroboros/Network/ConnectionManager.hs

@@ -67,6 +67,7 @@ import           Ouroboros.Network.Snocket (Accept (..), Accepted (..),
 import           Ouroboros.Network.ConnectionManager.InformationChannel
                      (newInformationChannel)
 import qualified Ouroboros.Network.ConnectionManager.InformationChannel as InfoChannel
+import           Ouroboros.Network.NodeToNode.Version (RemotePeerSharing (..))
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 import           TestLib.ConnectionManager (verifyAbstractTransition)
 
@@ -772,7 +773,7 @@ prop_valid_transitions (SkewedBool bindToLocalAddress) scheduleMap =
                 },
               cmTimeWaitTimeout = testTimeWaitTimeout,
               cmOutboundIdleTimeout = testOutboundIdleTimeout,
-              cmGetPeerSharing = \_ -> NoPeerSharing
+              cmGetRemotePeerSharing = \_ -> RemotePeerSharing NoPeerSharing
             }
             connectionHandler
             (\_ -> HandshakeFailure)