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
- Add new `NodeToNodeV_13`
- Renamed spec files and added V13 CDDL handshake and
  `NodeToNodeVersionData` specs

ouroboros-network-api/CHANGELOG.md

@@ -4,6 +4,10 @@
 
 ### Breaking changes
 
+- Create `LocalPeerSharing` and `RemotePeerSharing` newtypes.
+- Add `LocalPeerSharing` and `RemotePeerSharing` fields to `NodeToNodeVersionData`.
+- Add new `NodeToNodeV_13`
+
 ### 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
@@ -58,6 +61,10 @@ data NodeToNodeVersion
     -- ^ Changes:
     --
     -- * Enable @CardanoNodeToNodeVersion7@, i.e., Conway
+    | NodeToNodeV_13
+    -- ^ Changes:
+    --
+    -- * Adds a fix for PeerSharing handshake negotiation
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
@@ -69,13 +76,15 @@ nodeToNodeVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm }
     encodeTerm NodeToNodeV_10 = CBOR.TInt 10
     encodeTerm NodeToNodeV_11 = CBOR.TInt 11
     encodeTerm NodeToNodeV_12 = CBOR.TInt 12
+    encodeTerm NodeToNodeV_13 = CBOR.TInt 13
 
     decodeTerm (CBOR.TInt 7) = Right NodeToNodeV_7
     decodeTerm (CBOR.TInt 8) = Right NodeToNodeV_8
     decodeTerm (CBOR.TInt 9) = Right NodeToNodeV_9
     decodeTerm (CBOR.TInt 10) = Right NodeToNodeV_10
     decodeTerm (CBOR.TInt 11) = Right NodeToNodeV_11
     decodeTerm (CBOR.TInt 12) = Right NodeToNodeV_12
+    decodeTerm (CBOR.TInt 13) = Right NodeToNodeV_13
     decodeTerm (CBOR.TInt n) = Left ( T.pack "decode NodeToNodeVersion: unknonw tag: "
                                         <> T.pack (show n)
                                     , Just n
@@ -108,15 +117,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 +155,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
@@ -140,18 +169,74 @@ instance Queryable NodeToNodeVersionData where
 
 nodeToNodeCodecCBORTerm :: NodeToNodeVersion -> CodecCBORTerm Text NodeToNodeVersionData
 nodeToNodeCodecCBORTerm version
-  | version >= NodeToNodeV_11 =
+  | version >= NodeToNodeV_13 =
     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 localPeerSharing, CBOR.TInt remotePeerSharing, CBOR.TBool query])
+          | x >= 0
+          , x <= 0xffffffff
+          , localPeerSharing >= 0
+          , localPeerSharing <= 2
+          , remotePeerSharing >= 0
+          , remotePeerSharing <= 2
+          = Right
+              NodeToNodeVersionData {
+                  networkMagic = NetworkMagic (fromIntegral x),
+                  diffusionMode = if diffusionMode
+                                  then InitiatorOnlyDiffusionMode
+                                  else InitiatorAndResponderDiffusionMode,
+                  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 -- 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 }
+  | version >= NodeToNodeV_11
+  , version <= NodeToNodeV_12 =
+    let encodeTerm :: NodeToNodeVersionData -> CBOR.Term
+        encodeTerm NodeToNodeVersionData { networkMagic, diffusionMode, remotePeerSharing, query }
+          = CBOR.TList
+              [ CBOR.TInt (fromIntegral $ unNetworkMagic networkMagic)
+              , CBOR.TBool (case diffusionMode of
+                             InitiatorOnlyDiffusionMode         -> True
+                             InitiatorAndResponderDiffusionMode -> False)
+              , CBOR.TInt (case remotePeerSharing of
+                             RemotePeerSharing NoPeerSharing      -> 0
+                             RemotePeerSharing PeerSharingPrivate -> 1
+                             RemotePeerSharing PeerSharingPublic  -> 2)
               , CBOR.TBool query
               ]
 
@@ -167,17 +252,21 @@ nodeToNodeCodecCBORTerm version
                   diffusionMode = if diffusionMode
                                   then InitiatorOnlyDiffusionMode
                                   else InitiatorAndResponderDiffusionMode,
-                  peerSharing = case peerSharing of
-                                  0 -> NoPeerSharing
-                                  1 -> PeerSharingPrivate
-                                  2 -> PeerSharingPublic
+                  -- This means if a NodeToNodeV_{11,12} talks with a
+                  -- >NodeToNodeV_13 one it will see it as having Peer Sharing
+                  -- disabled
+                  localPeerSharing = LocalPeerSharing NoPeerSharing,
+                  remotePeerSharing = case peerSharing 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
+          = Left $ T.pack $ "Either peerSharing is out of bound: " <> show peerSharing
         decodeTerm _ t
           = Left $ T.pack $ "unknown encoding: " ++ show t
      in CodecCBORTerm {encodeTerm, decodeTerm = decodeTerm version }
@@ -203,7 +292,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.