Fix Peer Sharing issue #4642

docs/network-spec/miniprotocols.tex

@@ -584,10 +584,15 @@ \subsubsection{Node to node handshake mini-protocol}
 \subsubsection{Node to client handshake mini-protocol}
 \lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/handshake-node-to-client.cddl}
 
-\subsection{CDDL encoding specification ($\geq 11$)}\label{handshake-cddl}
+\subsection{CDDL encoding specification ($11$ to $12$)}\label{handshake-cddl}
 
 \subsubsection{Node to node handshake mini-protocol}
-\lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11.cddl}
+\lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11-12.cddl}
+
+\subsection{CDDL encoding specification ($\geq 13$)}\label{handshake-cddl}
+
+\subsubsection{Node to node handshake mini-protocol}
+\lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v13.cddl}
 
 \section{Chain-Sync mini-protocol}
 \label{chain-sync-protocol}
@@ -1394,8 +1399,11 @@ \subsection{Server Implementation Details}
 function application all the way to diffusion and share the relevant parts of
 \texttt{PeerSelectionState} with this function via a \texttt{TVar}.
 
-\subsection{CDDL encoding specification}
-\lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl}
+\subsection{CDDL encoding specification ($11$ to $12$)}\label{peersharing-cddl}
+\lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/peer-sharing-v11-12.cddl}
+
+\subsection{CDDL encoding specification ($\geq 13$)}\label{peersharing-cddl}
+\lstinputlisting[style=cddl]{../../ouroboros-network-protocols/test-cddl/specs/peer-sharing-v13.cddl}
 
 \section{Pipelining of Mini Protocols}
 \label{pipelining}

ouroboros-network-api/CHANGELOG.md

@@ -4,6 +4,14 @@
 
 ### Breaking changes
 
+* Remote `PeerSharingPrivate` option from the `PeerSharing` data type.
+* Rename `NoPeerSharing` and `PeerSharingPublic` to `PeerSharingDisabled` and
+  `PeerSharingEnabled`, respectively.
+* Add new `NodeToNodeV_13` that encodes and decodes the updated `PeerSharing` flag data
+  type.
+* Move remote address codec to 'src/Ouroboros/Network/NodeToNode/Version.hs'.
+* Make remote address codec receive 'NodeToNodeVersion'.
+
 ### Non-breaking changes
 
 * Restructured `decodeTerm` to prevent an impossible case and eliminate the

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

@@ -45,6 +45,7 @@ library
                        Ouroboros.Network.PeerSelection.PeerMetric.Type
                        Ouroboros.Network.PeerSelection.PeerAdvertise
                        Ouroboros.Network.PeerSelection.PeerSharing
+                       Ouroboros.Network.PeerSelection.PeerSharing.Codec
                        Ouroboros.Network.PeerSelection.RelayAccessPoint
   default-language:    Haskell2010
   build-depends:       base              >=4.14 && <4.19,

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

@@ -25,7 +25,6 @@ import           Ouroboros.Network.Handshake.Queryable (Queryable (..))
 import           Ouroboros.Network.Magic
 import           Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
 
-
 -- | Enumeration of node to node protocol versions.
 --
 data NodeToNodeVersion
@@ -58,6 +57,10 @@ data NodeToNodeVersion
     -- ^ Changes:
     --
     -- * Enable @CardanoNodeToNodeVersion7@, i.e., Conway
+    | NodeToNodeV_13
+    -- ^ Changes:
+    --
+    -- * Added `localPeerSharing` negotiation flag.
   deriving (Eq, Ord, Enum, Bounded, Show, Typeable)
 
 nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion
@@ -69,13 +72,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
@@ -127,7 +132,7 @@ instance Acceptable NodeToNodeVersionData where
       = Accept NodeToNodeVersionData
           { networkMagic  = networkMagic local
           , diffusionMode = diffusionMode local `min` diffusionMode remote
-          , peerSharing   = peerSharing remote
+          , peerSharing   = peerSharing local <> peerSharing remote
           , query         = query local || query remote
           }
       | otherwise
@@ -140,7 +145,7 @@ 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 }
           = CBOR.TList $
@@ -149,35 +154,79 @@ nodeToNodeCodecCBORTerm version
                              InitiatorOnlyDiffusionMode         -> True
                              InitiatorAndResponderDiffusionMode -> False)
               , CBOR.TInt (case peerSharing of
-                             NoPeerSharing      -> 0
-                             PeerSharingPrivate -> 1
-                             PeerSharingPublic  -> 2)
+                             PeerSharingDisabled -> 0
+                             PeerSharingEnabled  -> 1)
               , 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])
           | x >= 0
           , x <= 0xffffffff
-          = case peerSharing of
-            0 -> good NoPeerSharing
-            1 -> good PeerSharingPrivate
-            2 -> good PeerSharingPublic
-            _ -> bad
-          | otherwise -- x < 0 || x > 0xffffffff
-          = Left $ T.pack $ "networkMagic out of expected range [0..ffffffff]: " <> show x
-          where
-            good sharing
-              = Right
-                  NodeToNodeVersionData {
-                      networkMagic = NetworkMagic (fromIntegral x),
-                      diffusionMode = if diffusionMode
-                                      then InitiatorOnlyDiffusionMode
-                                      else InitiatorAndResponderDiffusionMode,
-                      peerSharing = sharing,
-                      query = query
-                    }
-            bad = Left $ T.pack $ "peerSharing out of expected range [0..2]: " <> show peerSharing
+          , Just ps <- case peerSharing of
+                        0 -> Just PeerSharingDisabled
+                        1 -> Just PeerSharingEnabled
+                        _ -> Nothing
+          = Right
+              NodeToNodeVersionData {
+                  networkMagic = NetworkMagic (fromIntegral x),
+                  diffusionMode = if diffusionMode
+                                  then InitiatorOnlyDiffusionMode
+                                  else InitiatorAndResponderDiffusionMode,
+                  peerSharing = ps,
+                  query = query
+                }
+          | x < 0 || x > 0xffffffff
+          = Left $ T.pack $ "networkMagic out of bound: " <> show x
+          | otherwise -- peerSharing < 0 || peerSharing > 1
+          = Left $ T.pack $ "peerSharing is out of bound: " <> show peerSharing
+        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, peerSharing, query }
+          = CBOR.TList
+              [ CBOR.TInt (fromIntegral $ unNetworkMagic networkMagic)
+              , CBOR.TBool (case diffusionMode of
+                             InitiatorOnlyDiffusionMode         -> True
+                             InitiatorAndResponderDiffusionMode -> False)
+                          -- Need to be careful mapping here since older
+                          -- versions will map PeerSharingPrivate to 1.
+              , CBOR.TInt (case peerSharing of
+                             PeerSharingDisabled -> 0
+                             PeerSharingEnabled  -> 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])
+          | x >= 0
+          , x <= 0xffffffff
+          , peerSharing >= 0
+          , peerSharing <= 2
+            -- This means if an older version node with
+            -- NodeToNodeV_{11,12} talks with a >NodeToNodeV_13
+            -- one it will map PeerSharingPrivate to PeerSharingDisabled
+          , Just ps <- case peerSharing of
+                        0 -> Just PeerSharingDisabled
+                        1 -> Just PeerSharingDisabled
+                        2 -> Just PeerSharingEnabled
+                        _ -> Nothing
+          = Right
+              NodeToNodeVersionData {
+                  networkMagic = NetworkMagic (fromIntegral x),
+                  diffusionMode = if diffusionMode
+                                  then InitiatorOnlyDiffusionMode
+                                  else InitiatorAndResponderDiffusionMode,
+                  peerSharing = ps,
+                  query = query
+                }
+          | x < 0 || x > 0xffffffff
+          = Left $ T.pack $ "networkMagic out of bound: " <> show x
+          | otherwise -- peerSharing < 0 || peerSharing > 2
+          = 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 +252,7 @@ nodeToNodeCodecCBORTerm version
                                   else InitiatorAndResponderDiffusionMode
                   -- By default older versions do not participate in Peer
                   -- Sharing, since they do not support the new miniprotocol
-                , peerSharing = NoPeerSharing
+                , peerSharing = PeerSharingDisabled
                 , query = False
                 }
           | otherwise
@@ -215,7 +264,6 @@ nodeToNodeCodecCBORTerm version
 
 data ConnectionMode = UnidirectionalMode | DuplexMode
 
-
 -- | Check whether a version enabling diffusion pipelining has been
 -- negotiated.
 --

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

@@ -1,26 +1,11 @@
 {-# LANGUAGE DeriveGeneric #-}
 
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE InstanceSigs  #-}
 
-module Ouroboros.Network.PeerSelection.PeerSharing
-  ( PeerSharing (..)
-  , combinePeerInformation
-  , encodePortNumber
-  , decodePortNumber
-  , encodeRemoteAddress
-  , decodeRemoteAddress
-  ) where
+module Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) where
 
-import qualified Codec.CBOR.Decoding as CBOR
-import qualified Codec.CBOR.Encoding as CBOR
-import           Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..),
-                     withText)
-import qualified Data.Text as Text
 import           GHC.Generics (Generic)
-import           Network.Socket (PortNumber, SockAddr (..))
-import           Ouroboros.Network.PeerSelection.PeerAdvertise
-                     (PeerAdvertise (..))
-import           Text.Read (readMaybe)
 
 -- | Is a peer willing to participate in Peer Sharing? If yes are others allowed
 -- to share this peer's address?
@@ -29,88 +14,28 @@ import           Text.Read (readMaybe)
 --
 -- NOTE: This information is only useful if P2P flag is enabled.
 --
-data PeerSharing = NoPeerSharing -- ^ Peer does not participate in Peer Sharing
-                                 -- at all
-                 | PeerSharingPrivate -- ^ Peer participates in Peer Sharing but
-                                      -- its address should be private
-                 | PeerSharingPublic -- ^ Peer participates in Peer Sharing
+data PeerSharing = PeerSharingDisabled -- ^ Peer does not participate in Peer Sharing
+                                       -- at all
+                 | PeerSharingEnabled -- ^ Peer participates in Peer Sharing
   deriving  (Eq, Show, Read, Generic)
 
-instance FromJSON PeerSharing where
-  parseJSON = withText "PeerSharing" $ \t ->
-    case readMaybe (Text.unpack t) of
-      Nothing -> fail ("PeerSharing.parseJSON: could not parse value: "
-                     ++ Text.unpack t)
-      Just ps -> return ps
-
-instance ToJSON PeerSharing where
-  toJSON = String . Text.pack . show
-
--- Combine a 'PeerSharing' value and a 'PeerAdvertise' value into a
--- resulting 'PeerSharing' that can be used to decide if we should
--- share or not the given Peer. According to the following rules:
---
--- - If no PeerSharing value is known then there's nothing we can assess
--- - If a peer is not participating in Peer Sharing ignore all other information
--- - If a peer said it wasn't okay to share its address, respect that no matter what.
--- - If a peer was privately configured with DoNotAdvertisePeer respect that no matter
--- what.
---
-combinePeerInformation :: PeerSharing -> PeerAdvertise -> PeerSharing
-combinePeerInformation NoPeerSharing      _                  = NoPeerSharing
-combinePeerInformation PeerSharingPrivate _                  = PeerSharingPrivate
-combinePeerInformation PeerSharingPublic  DoNotAdvertisePeer = PeerSharingPrivate
-combinePeerInformation _                         _           = PeerSharingPublic
-
-encodePortNumber :: PortNumber -> CBOR.Encoding
-encodePortNumber = CBOR.encodeWord16 . fromIntegral
-
-decodePortNumber :: CBOR.Decoder s PortNumber
-decodePortNumber = fromIntegral <$> CBOR.decodeWord16
-
-
--- | This encoder should be faithful to the PeerSharing
--- CDDL Specification.
+-- | The combination of two 'PeerSharing' values forms a Monoid where the unit
+-- is 'PeerSharingEnabled'.
 --
--- See the network design document for more details
+-- This operation is used in the connection handshake.
 --
-encodeRemoteAddress :: SockAddr -> CBOR.Encoding
-encodeRemoteAddress (SockAddrInet pn w) = CBOR.encodeListLen 3
-                           <> CBOR.encodeWord 0
-                           <> CBOR.encodeWord32 w
-                           <> encodePortNumber pn
-encodeRemoteAddress (SockAddrInet6 pn fi (w1, w2, w3, w4) si) = CBOR.encodeListLen 8
-                                                <> CBOR.encodeWord 1
-                                                <> CBOR.encodeWord32 w1
-                                                <> CBOR.encodeWord32 w2
-                                                <> CBOR.encodeWord32 w3
-                                                <> CBOR.encodeWord32 w4
-                                                <> CBOR.encodeWord32 fi
-                                                <> CBOR.encodeWord32 si
-                                                <> encodePortNumber pn
-encodeRemoteAddress (SockAddrUnix _) = error "Should never be encoding a SockAddrUnix!"
+instance Semigroup PeerSharing where
+  (<>) :: PeerSharing -> PeerSharing -> PeerSharing
+  PeerSharingDisabled <> _                   = PeerSharingDisabled
+  _                   <> PeerSharingDisabled = PeerSharingDisabled
+  _                   <> _                   = PeerSharingEnabled
 
--- | This decoder should be faithful to the PeerSharing
--- CDDL Specification.
+-- | The Monoid laws are witnessed by the following denotation function:
 --
--- See the network design document for more details
+-- ⟦_⟧ :: PeerSharing -> All
+-- ⟦ PeerSharingDisabled ⟧ = All False
+-- ⟦ PeerSharingEnabled ⟧  = All True
 --
-decodeRemoteAddress :: CBOR.Decoder s SockAddr
-decodeRemoteAddress = do
-  _ <- CBOR.decodeListLen
-  tok <- CBOR.decodeWord
-  case tok of
-    0 -> do
-      w <- CBOR.decodeWord32
-      pn <- decodePortNumber
-      return (SockAddrInet pn w)
-    1 -> do
-      w1 <- CBOR.decodeWord32
-      w2 <- CBOR.decodeWord32
-      w3 <- CBOR.decodeWord32
-      w4 <- CBOR.decodeWord32
-      fi <- CBOR.decodeWord32
-      si <- CBOR.decodeWord32
-      pn <- decodePortNumber
-      return (SockAddrInet6 pn fi (w1, w2, w3, w4) si)
-    _ -> fail ("Serialise.decode.SockAddr unexpected tok " ++ show tok)
+instance Monoid PeerSharing where
+  mempty :: PeerSharing
+  mempty = PeerSharingEnabled