From 314574fc8ed80c0cd99327291e61d43b4a5eec11 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Thu, 17 Aug 2023 09:37:02 +0100 Subject: [PATCH 1/4] Fix Peer Sharing issue #4642 - Remove `PeerSharingPrivate` option and renamed others to `PeerSharingDisabled` and `PeerSharingEnabled` - Add test to check that the bug is fixed - Add new `NodeToNodeV_13` - Renamed spec files and added V13 CDDL handshake and `NodeToNodeVersionData` specs --- docs/network-spec/miniprotocols.tex | 9 +- ouroboros-network-api/CHANGELOG.md | 6 + .../Ouroboros/Network/NodeToNode/Version.hs | 104 +++++++++--- .../Network/PeerSelection/PeerSharing.hs | 32 ++-- ouroboros-network-framework/CHANGELOG.md | 2 + .../demo/connection-manager.hs | 2 +- .../Ouroboros/Network/ConnectionManager.hs | 2 +- .../Test/Ouroboros/Network/Server2/Sim.hs | 1 - .../Network/ConnectionManager/Core.hs | 5 +- .../Network/Protocol/Handshake/Unversioned.hs | 38 +++-- ouroboros-network-protocols/CHANGELOG.md | 4 + ouroboros-network-protocols/test-cddl/Main.hs | 159 ++++++++++++------ ...ddl => handshake-node-to-node-v11-12.cddl} | 2 +- .../specs/handshake-node-to-node-v13.cddl | 36 ++++ ... => node-to-node-version-data-v11-12.cddl} | 2 +- .../specs/node-to-node-version-data-v13.cddl | 12 ++ .../Network/Protocol/Handshake/Test.hs | 102 +++++++++-- ouroboros-network/CHANGELOG.md | 2 + .../io-tests/Test/Ouroboros/Network/Socket.hs | 4 +- .../Test/Ouroboros/Network/Diffusion/Node.hs | 36 ++-- .../Network/Diffusion/Node/MiniProtocols.hs | 2 +- .../Ouroboros/Network/NodeToNode/Version.hs | 7 +- .../Test/Ouroboros/Network/PeerSelection.hs | 27 +-- .../Network/PeerSelection/Instances.hs | 7 +- .../Network/PeerSelection/MockEnvironment.hs | 20 ++- .../Network/PeerSelection/PeerGraph.hs | 22 ++- .../Test/Ouroboros/Network/Testnet.hs | 12 +- .../Network/Testnet/Simulation/Node.hs | 2 +- .../src/Ouroboros/Network/Diffusion/P2P.hs | 8 +- .../src/Ouroboros/Network/NodeToNode.hs | 2 +- .../PeerSelection/Governor/BigLedgerPeers.hs | 2 +- .../Governor/EstablishedPeers.hs | 2 - .../PeerSelection/Governor/KnownPeers.hs | 2 +- .../PeerSelection/Governor/RootPeers.hs | 2 +- .../Network/PeerSelection/Governor/Types.hs | 2 +- .../Network/PeerSelection/PeerStateActions.hs | 4 +- .../Network/PeerSelection/State/KnownPeers.hs | 13 +- 37 files changed, 475 insertions(+), 221 deletions(-) rename ouroboros-network-protocols/test-cddl/specs/{handshake-node-to-node-v11.cddl => handshake-node-to-node-v11-12.cddl} (96%) create mode 100644 ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v13.cddl rename ouroboros-network-protocols/test-cddl/specs/{node-to-node-version-data-v11.cddl => node-to-node-version-data-v11-12.cddl} (87%) create mode 100644 ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v13.cddl diff --git a/docs/network-spec/miniprotocols.tex b/docs/network-spec/miniprotocols.tex index 39ad86cbefa..66eeaa22e5d 100644 --- a/docs/network-spec/miniprotocols.tex +++ b/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} diff --git a/ouroboros-network-api/CHANGELOG.md b/ouroboros-network-api/CHANGELOG.md index fb61a4f3bbd..a60e38a322a 100644 --- a/ouroboros-network-api/CHANGELOG.md +++ b/ouroboros-network-api/CHANGELOG.md @@ -4,6 +4,12 @@ ### 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. + ### Non-breaking changes * Restructured `decodeTerm` to prevent an impossible case and eliminate the diff --git a/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs index e92e0f6d608..811d22d1b7e 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs @@ -23,7 +23,8 @@ import Ouroboros.Network.Handshake.Acceptable (Accept (..), Acceptable (..)) import Ouroboros.Network.Handshake.Queryable (Queryable (..)) import Ouroboros.Network.Magic -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..), + combinePeerSharing) -- | Enumeration of node to node protocol versions. @@ -58,6 +59,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,6 +74,7 @@ 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 @@ -76,6 +82,7 @@ nodeToNodeVersionCodec = CodecCBORTerm { encodeTerm, decodeTerm } 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 +134,8 @@ instance Acceptable NodeToNodeVersionData where = Accept NodeToNodeVersionData { networkMagic = networkMagic local , diffusionMode = diffusionMode local `min` diffusionMode remote - , peerSharing = peerSharing remote + , peerSharing = combinePeerSharing (peerSharing local) + (peerSharing remote) , query = query local || query remote } | otherwise @@ -140,7 +148,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,9 +157,8 @@ nodeToNodeCodecCBORTerm version InitiatorOnlyDiffusionMode -> True InitiatorAndResponderDiffusionMode -> False) , CBOR.TInt (case peerSharing of - NoPeerSharing -> 0 - PeerSharingPrivate -> 1 - PeerSharingPublic -> 2) + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1) , CBOR.TBool query ] @@ -159,25 +166,70 @@ nodeToNodeCodecCBORTerm version 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 +255,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 diff --git a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs index 11f19f08ed7..120308295be 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs @@ -4,7 +4,7 @@ module Ouroboros.Network.PeerSelection.PeerSharing ( PeerSharing (..) - , combinePeerInformation + , combinePeerSharing , encodePortNumber , decodePortNumber , encodeRemoteAddress @@ -18,8 +18,6 @@ import Data.Aeson.Types (FromJSON (..), ToJSON (..), Value (..), 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 @@ -29,11 +27,9 @@ 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 @@ -46,21 +42,13 @@ instance FromJSON PeerSharing where 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: +-- | Combine two 'PeerSharing' values -- --- - 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 +-- 'PeerSharingDisabled' is the absorbing element +combinePeerSharing :: PeerSharing -> PeerSharing -> PeerSharing +combinePeerSharing PeerSharingDisabled _ = PeerSharingDisabled +combinePeerSharing _ PeerSharingDisabled = PeerSharingDisabled +combinePeerSharing _ _ = PeerSharingEnabled encodePortNumber :: PortNumber -> CBOR.Encoding encodePortNumber = CBOR.encodeWord16 . fromIntegral diff --git a/ouroboros-network-framework/CHANGELOG.md b/ouroboros-network-framework/CHANGELOG.md index 206041061e8..5892b6bb351 100644 --- a/ouroboros-network-framework/CHANGELOG.md +++ b/ouroboros-network-framework/CHANGELOG.md @@ -6,6 +6,8 @@ ### Non-breaking changes +* Update code to accommodate changes on `PeerSharing` data type. + ## 0.10.0.0 -- 2023-10-26 ### Breaking changes diff --git a/ouroboros-network-framework/demo/connection-manager.hs b/ouroboros-network-framework/demo/connection-manager.hs index 6695f7d90c8..13a439a5774 100644 --- a/ouroboros-network-framework/demo/connection-manager.hs +++ b/ouroboros-network-framework/demo/connection-manager.hs @@ -247,7 +247,7 @@ withBidirectionalConnectionManager snocket makeBearer socket acceptedConnectionsSoftLimit = maxBound, acceptedConnectionsDelay = 0 }, - cmGetPeerSharing = \_ -> NoPeerSharing + cmGetPeerSharing = \_ -> PeerSharingDisabled } (makeConnectionHandler muxTracer diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs index 42ce7d4f5a7..03ba384c50a 100644 --- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs +++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/ConnectionManager.hs @@ -773,7 +773,7 @@ prop_valid_transitions (SkewedBool bindToLocalAddress) scheduleMap = }, cmTimeWaitTimeout = testTimeWaitTimeout, cmOutboundIdleTimeout = testOutboundIdleTimeout, - cmGetPeerSharing = \_ -> NoPeerSharing + cmGetPeerSharing = \_ -> PeerSharingDisabled } connectionHandler (\_ -> HandshakeFailure) diff --git a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs index 6cf0c0e518d..b65164f06bc 100644 --- a/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs +++ b/ouroboros-network-framework/sim-tests/Test/Ouroboros/Network/Server2/Sim.hs @@ -153,7 +153,6 @@ tests = -- Server tests -- - prop_unidirectional_Sim :: ClientAndServerData Int -> Property prop_unidirectional_Sim clientAndServerData = diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs index fff2f04c59b..a91319655ab 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs @@ -141,7 +141,8 @@ data ConnectionManagerArguments handlerTrace socket peerAddr handle handleError cmPrunePolicy :: PrunePolicy peerAddr (STM m), cmConnectionsLimits :: AcceptedConnectionsLimit, - -- | How to extract PeerSharing information from versionData + -- | How to extract remote side's PeerSharing information from + -- versionData cmGetPeerSharing :: versionData -> PeerSharing } @@ -1843,11 +1844,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 -- need to notify the inbound governor, as -- it's already done by -- `includeInboundConnectionImpl` + Inbound -> False Outbound -> True writeTVar connVar connState' case inboundGovernorInfoChannel of diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs index ed6f0030bba..65e0552ddbb 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs @@ -26,7 +26,8 @@ import Network.TypedProtocol.Codec import Ouroboros.Network.CodecCBORTerm import Ouroboros.Network.ConnectionManager.Types (DataFlow (..)) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..), + combinePeerSharing) import Ouroboros.Network.Protocol.Handshake.Codec import Ouroboros.Network.Protocol.Handshake.Type import Ouroboros.Network.Protocol.Handshake.Version @@ -82,8 +83,8 @@ data DataFlowProtocolData = deriving (Eq, Show) instance Acceptable DataFlowProtocolData where - acceptableVersion (DataFlowProtocolData local _) (DataFlowProtocolData remote ps) = - Accept (DataFlowProtocolData (local `min` remote) ps) + acceptableVersion (DataFlowProtocolData local lps) (DataFlowProtocolData remote rps) = + Accept (DataFlowProtocolData (local `min` remote) (combinePeerSharing lps rps)) instance Queryable DataFlowProtocolData where queryVersion (DataFlowProtocolData _ _) = False @@ -92,20 +93,25 @@ dataFlowProtocolDataCodec :: UnversionedProtocol -> CodecCBORTerm Text DataFlowP 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 ps) = + let peerSharing = case ps of + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1 + in CBOR.TList [CBOR.TBool False, CBOR.TInt peerSharing] + encodeTerm (DataFlowProtocolData Duplex ps) = + let peerSharing = case ps of + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1 + in CBOR.TList [CBOR.TBool True, CBOR.TInt peerSharing] + + toPeerSharing :: Int -> PeerSharing + toPeerSharing 0 = PeerSharingDisabled + toPeerSharing 1 = PeerSharingEnabled + toPeerSharing _ = error "toPeerSharing: 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]) = Right (DataFlowProtocolData Unidirectional (toPeerSharing a)) + decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt a]) = Right (DataFlowProtocolData Duplex (toPeerSharing a)) decodeTerm t = Left $ T.pack $ "unexpected term: " ++ show t dataFlowProtocol :: DataFlow @@ -114,7 +120,7 @@ dataFlowProtocol :: DataFlow DataFlowProtocolData app dataFlowProtocol dataFlow = - simpleSingletonVersions UnversionedProtocol (DataFlowProtocolData dataFlow NoPeerSharing) + simpleSingletonVersions UnversionedProtocol (DataFlowProtocolData dataFlow PeerSharingDisabled) -- | 'Handshake' codec used in various tests. -- diff --git a/ouroboros-network-protocols/CHANGELOG.md b/ouroboros-network-protocols/CHANGELOG.md index caf33fbf53a..5c0cc90ded2 100644 --- a/ouroboros-network-protocols/CHANGELOG.md +++ b/ouroboros-network-protocols/CHANGELOG.md @@ -16,6 +16,10 @@ * Add a 3673s timeout to chainsync's StIdle state. * Add a 97s timeout to keepalive's StClient state. +- Add a test to check that Peer Sharing values after handshake are symmetric + relative to the initiator and responder side. +- Adds cddl specs and tests for `NodeToNodeV_13` and handshake + ## 0.5.2.0 -- 2023-09-08 ### Non-breaking changes diff --git a/ouroboros-network-protocols/test-cddl/Main.hs b/ouroboros-network-protocols/test-cddl/Main.hs index c88c61dfe62..f0af1bc01a9 100644 --- a/ouroboros-network-protocols/test-cddl/Main.hs +++ b/ouroboros-network-protocols/test-cddl/Main.hs @@ -150,11 +150,13 @@ tests CDDLSpecs { cddlChainSync , cddlKeepAlive , cddlLocalStateQuery , cddlHandshakeNodeToNodeV7To10 - , cddlHandshakeNodeToNodeV11ToLast + , cddlHandshakeNodeToNodeV11ToV12 + , cddlHandshakeNodeToNodeV13ToLast , cddlHandshakeNodeToClient , cddlPeerSharing , cddlNodeToNodeVersionDataV7To10 - , cddlNodeToNodeVersionDataV11ToLast + , cddlNodeToNodeVersionDataV11ToV12 + , cddlNodeToNodeVersionDataV13ToLast } = adjustOption (const $ QuickCheckMaxSize 10) $ testGroup "cddl" @@ -163,9 +165,12 @@ tests CDDLSpecs { cddlChainSync [ testProperty "NodeToNode.Handshake V7 to V10" (prop_encodeHandshakeNodeToNodeV7To10 cddlHandshakeNodeToNodeV7To10) - , testProperty "NodeToNode.Handshake V11 to Last" - (prop_encodeHandshakeNodeToNodeV11ToLast - cddlHandshakeNodeToNodeV11ToLast) + , testProperty "NodeToNode.Handshake V11 to V12" + (prop_encodeHandshakeNodeToNodeV11ToV12 + cddlHandshakeNodeToNodeV11ToV12) + , testProperty "NodeToNode.Handshake V13 to Last" + (prop_encodeHandshakeNodeToNodeV13ToLast + cddlHandshakeNodeToNodeV13ToLast) , -- If this fails whilst adding a new node-to-client version, ensure that -- all the necessary changes are included: -- @@ -194,17 +199,22 @@ tests CDDLSpecs { cddlChainSync , testProperty "NodeToNodeVersionData V7 to V10" (prop_encodeNodeToNodeVersionDataV7To10 cddlNodeToNodeVersionDataV7To10) - , testProperty "NodeToNodeVersionData V11 to Last" (prop_encodeNodeToNodeVersionDataV11ToLast - cddlNodeToNodeVersionDataV11ToLast) + , testProperty "NodeToNodeVersionData V11 to V12" (prop_encodeNodeToNodeVersionDataV11ToV12 + cddlNodeToNodeVersionDataV11ToV12) + , testProperty "NodeToNodeVersionData V13 to Last" (prop_encodeNodeToNodeVersionDataV13ToLast + cddlNodeToNodeVersionDataV13ToLast) ] , testGroup "decoder" -- validate decoder by generating messages from the specification [ testCase "NodeToNode.Handshake V7 to V10" (unit_decodeHandshakeNodeToNode cddlHandshakeNodeToNodeV7To10) - , testCase "NodeToNode.Handshake V11 to Last" + , testCase "NodeToNode.Handshake V11 to V12" (unit_decodeHandshakeNodeToNode - cddlHandshakeNodeToNodeV11ToLast) + cddlHandshakeNodeToNodeV11ToV12) + , testCase "NodeToNode.Handshake V13 to Last" + (unit_decodeHandshakeNodeToNode + cddlHandshakeNodeToNodeV13ToLast) , testCase "NodeToClient.Handshake" (unit_decodeHandshakeNodeToClient cddlHandshakeNodeToClient) @@ -227,8 +237,10 @@ tests CDDLSpecs { cddlChainSync , testCase "NodeToNodeVersionData V7 to V10" (unit_decodeNodeToNodeVersionData cddlNodeToNodeVersionDataV7To10) - , testCase "NodeToNodeVersionData V11 to Last" (unit_decodeNodeToNodeVersionDataV11ToLast - cddlNodeToNodeVersionDataV11ToLast) + , testCase "NodeToNodeVersionData V11 to V12" (unit_decodeNodeToNodeVersionDataV11ToV12 + cddlNodeToNodeVersionDataV11ToV12) + , testCase "NodeToNodeVersionData V13 to Last" (unit_decodeNodeToNodeVersionDataV13ToLast + cddlNodeToNodeVersionDataV13ToLast) ] ] @@ -239,7 +251,8 @@ newtype CDDLSpec ps = CDDLSpec BL.ByteString data CDDLSpecs = CDDLSpecs { cddlHandshakeNodeToClient :: CDDLSpec (Handshake NodeToClientVersion CBOR.Term), cddlHandshakeNodeToNodeV7To10 :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), - cddlHandshakeNodeToNodeV11ToLast :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), + cddlHandshakeNodeToNodeV11ToV12 :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), + cddlHandshakeNodeToNodeV13ToLast :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term), cddlChainSync :: CDDLSpec (ChainSync BlockHeader HeaderPoint HeaderTip), cddlBlockFetch :: CDDLSpec (BlockFetch Block BlockPoint), cddlTxSubmission2 :: CDDLSpec (TxSubmission2 TxId Tx), @@ -252,7 +265,8 @@ data CDDLSpecs = CDDLSpecs { cddlPeerSharing :: CDDLSpec (PeerSharing.PeerSharing SockAddr), cddlNodeToNodeVersionDataV7To10 :: CDDLSpec NodeToNodeVersionData, - cddlNodeToNodeVersionDataV11ToLast :: CDDLSpec NodeToNodeVersionData + cddlNodeToNodeVersionDataV11ToV12 :: CDDLSpec NodeToNodeVersionData, + cddlNodeToNodeVersionDataV13ToLast :: CDDLSpec NodeToNodeVersionData } @@ -264,7 +278,8 @@ readCDDLSpecs = do common <- BL.readFile (dir "common.cddl") handshakeNodeToClient <- BL.readFile (dir "handshake-node-to-client.cddl") handshakeNodeToNodeV7To10 <- BL.readFile (dir "handshake-node-to-node.cddl") - handshakeNodeToNodeV11ToLast <- BL.readFile (dir "handshake-node-to-node-v11.cddl") + handshakeNodeToNodeV11ToV12 <- BL.readFile (dir "handshake-node-to-node-v11-12.cddl") + handshakeNodeToNodeV13ToLast <- BL.readFile (dir "handshake-node-to-node-v13.cddl") chainSync <- BL.readFile (dir "chain-sync.cddl") blockFetch <- BL.readFile (dir "block-fetch.cddl") txSubmission2 <- BL.readFile (dir "tx-submission2.cddl") @@ -275,13 +290,15 @@ readCDDLSpecs = do peerSharing <- BL.readFile (dir "peer-sharing.cddl") nodeToNodeVersionDataV7To10 <- BL.readFile (dir "node-to-node-version-data.cddl") - nodeToNodeVersionDataV11ToLast <- BL.readFile (dir "node-to-node-version-data-v11.cddl") + nodeToNodeVersionDataV11ToV12 <- BL.readFile (dir "node-to-node-version-data-v11-12.cddl") + nodeToNodeVersionDataV13ToLast <- BL.readFile (dir "node-to-node-version-data-v13.cddl") -- append common definitions; they must be appended since the first -- definition is the entry point for a cddl spec. return CDDLSpecs { cddlHandshakeNodeToClient = CDDLSpec $ handshakeNodeToClient, cddlHandshakeNodeToNodeV7To10 = CDDLSpec $ handshakeNodeToNodeV7To10, - cddlHandshakeNodeToNodeV11ToLast = CDDLSpec $ handshakeNodeToNodeV11ToLast, + cddlHandshakeNodeToNodeV11ToV12 = CDDLSpec $ handshakeNodeToNodeV11ToV12, + cddlHandshakeNodeToNodeV13ToLast = CDDLSpec $ handshakeNodeToNodeV13ToLast, cddlChainSync = CDDLSpec $ chainSync <> common, cddlBlockFetch = CDDLSpec $ blockFetch @@ -299,7 +316,8 @@ readCDDLSpecs = do <> common, cddlNodeToNodeVersionDataV7To10 = CDDLSpec nodeToNodeVersionDataV7To10, - cddlNodeToNodeVersionDataV11ToLast = CDDLSpec nodeToNodeVersionDataV11ToLast + cddlNodeToNodeVersionDataV11ToV12 = CDDLSpec nodeToNodeVersionDataV11ToV12, + cddlNodeToNodeVersionDataV13ToLast = CDDLSpec nodeToNodeVersionDataV13ToLast } @@ -475,15 +493,22 @@ validateCBOR (CDDLSpec spec) blob = -- | Newtype for testing Handshake CDDL Specification from version 7 to -- version 10. After version 10 (i.e. version 11) a new extra parameter is -- added and we need a new CDDL specification (see --- specs/handshake-node-to-node-v11.cddl). +-- specs/handshake-node-to-node-v11-12.cddl). After version 12 a fix for a bug +-- with Peer Sharing required yet another parameter ((see +-- specs/handshake-node-to-node-v13.cddl) -- newtype NtNHandshakeV7To10 = NtNHandshakeV7To10 (AnyMessageAndAgency (Handshake NodeToNodeVersion CBOR.Term)) deriving Show -newtype NtNHandshakeV11ToLast = - NtNHandshakeV11ToLast +newtype NtNHandshakeV11ToV12 = + NtNHandshakeV11ToV12 + (AnyMessageAndAgency (Handshake NodeToNodeVersion CBOR.Term)) + deriving Show + +newtype NtNHandshakeV13ToLast = + NtNHandshakeV13ToLast (AnyMessageAndAgency (Handshake NodeToNodeVersion CBOR.Term)) deriving Show @@ -513,11 +538,9 @@ genNtNHandshake genVersion = oneof [ pure InitiatorOnlyDiffusionMode , pure InitiatorAndResponderDiffusionMode ] - <*> oneof - [ pure NoPeerSharing - , pure PeerSharingPrivate - , pure PeerSharingPublic - ] + <*> elements [ PeerSharingDisabled + , PeerSharingEnabled + ] <*> arbitrary genRefuseReason :: Gen (Handshake.RefuseReason NodeToNodeVersion) @@ -539,11 +562,15 @@ instance Arbitrary NtNHandshakeV7To10 where let genVersion = elements [minBound .. NodeToNodeV_10] NtNHandshakeV7To10 <$> genNtNHandshake genVersion -instance Arbitrary NtNHandshakeV11ToLast where +instance Arbitrary NtNHandshakeV11ToV12 where arbitrary = do - let genVersion = elements [NodeToNodeV_11 ..] - NtNHandshakeV11ToLast <$> genNtNHandshake genVersion + let genVersion = elements [NodeToNodeV_11, NodeToNodeV_12] + NtNHandshakeV11ToV12 <$> genNtNHandshake genVersion +instance Arbitrary NtNHandshakeV13ToLast where + arbitrary = do + let genVersion = elements [NodeToNodeV_13 ..] + NtNHandshakeV13ToLast <$> genNtNHandshake genVersion prop_encodeHandshakeNodeToNodeV7To10 :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term) @@ -552,11 +579,18 @@ prop_encodeHandshakeNodeToNodeV7To10 prop_encodeHandshakeNodeToNodeV7To10 spec (NtNHandshakeV7To10 x) = validateEncoder spec nodeToNodeHandshakeCodec x -prop_encodeHandshakeNodeToNodeV11ToLast +prop_encodeHandshakeNodeToNodeV11ToV12 :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term) - -> NtNHandshakeV11ToLast + -> NtNHandshakeV11ToV12 -> Property -prop_encodeHandshakeNodeToNodeV11ToLast spec (NtNHandshakeV11ToLast x) = +prop_encodeHandshakeNodeToNodeV11ToV12 spec (NtNHandshakeV11ToV12 x) = + validateEncoder spec nodeToNodeHandshakeCodec x + +prop_encodeHandshakeNodeToNodeV13ToLast + :: CDDLSpec (Handshake NodeToNodeVersion CBOR.Term) + -> NtNHandshakeV13ToLast + -> Property +prop_encodeHandshakeNodeToNodeV13ToLast spec (NtNHandshakeV13ToLast x) = validateEncoder spec nodeToNodeHandshakeCodec x -- TODO: add our regular tests for `Handshake NodeToClientVerision CBOR.Term` @@ -684,14 +718,19 @@ newtype NtNVersionV7To10 = NtNVersionV7To10 NodeToNodeVersion deriving Show newtype NtNVersionV11 = NtNVersionV11 NodeToNodeVersion deriving Show -newtype NtNVersionV11ToLast = NtNVersionV11ToLast NodeToNodeVersion +newtype NtNVersionV11ToV12 = NtNVersionV11ToV12 NodeToNodeVersion + deriving Show +newtype NtNVersionV13ToLast = NtNVersionV13ToLast NodeToNodeVersion deriving Show instance Arbitrary NtNVersionV7To10 where arbitrary = NtNVersionV7To10 <$> elements [NodeToNodeV_7 .. NodeToNodeV_10] -instance Arbitrary NtNVersionV11ToLast where - arbitrary = NtNVersionV11ToLast <$> elements [NodeToNodeV_11 ..] +instance Arbitrary NtNVersionV11ToV12 where + arbitrary = NtNVersionV11ToV12 <$> elements [NodeToNodeV_11, NodeToNodeV_12] + +instance Arbitrary NtNVersionV13ToLast where + arbitrary = NtNVersionV13ToLast <$> elements [NodeToNodeV_13 ..] instance Arbitrary NodeToNodeVersionData where arbitrary = @@ -700,20 +739,28 @@ instance Arbitrary NodeToNodeVersionData where <*> oneof [ pure InitiatorOnlyDiffusionMode , pure InitiatorAndResponderDiffusionMode ] - <*> oneof [ pure NoPeerSharing - , pure PeerSharingPrivate - , pure PeerSharingPublic - ] + <*> elements [ PeerSharingDisabled + , PeerSharingEnabled + ] <*> arbitrary -newtype NtNVersionDataV11ToLast = NtNVersionDataV11ToLast (NodeToNodeVersion, NodeToNodeVersionData) +newtype NtNVersionDataV11ToV12 = NtNVersionDataV11ToV12 (NodeToNodeVersion , NodeToNodeVersionData) deriving Show -instance Arbitrary NtNVersionDataV11ToLast where +newtype NtNVersionDataV13ToLast = NtNVersionDataV13ToLast (NodeToNodeVersion, NodeToNodeVersionData) + deriving Show + +instance Arbitrary NtNVersionDataV11ToV12 where arbitrary = do - NtNVersionV11ToLast ntnVersion <- arbitrary + NtNVersionV11ToV12 ntnVersion <- arbitrary ntnVersionData <- arbitrary - return (NtNVersionDataV11ToLast (ntnVersion, ntnVersionData)) + return (NtNVersionDataV11ToV12 (ntnVersion, ntnVersionData)) + +instance Arbitrary NtNVersionDataV13ToLast where + arbitrary = do + NtNVersionV13ToLast ntnVersion <- arbitrary + ntnVersionData <- arbitrary + return (NtNVersionDataV13ToLast (ntnVersion, ntnVersionData)) prop_encodeNodeToNodeVersionDataV7To10 :: CDDLSpec NodeToNodeVersionData @@ -722,15 +769,22 @@ prop_encodeNodeToNodeVersionDataV7To10 -> Property prop_encodeNodeToNodeVersionDataV7To10 spec (NtNVersionV7To10 v) a = validateCBORTermEncoder spec (nodeToNodeCodecCBORTerm v) - a { peerSharing = NoPeerSharing, + a { peerSharing = PeerSharingDisabled, NtNVersion.query = False } -prop_encodeNodeToNodeVersionDataV11ToLast +prop_encodeNodeToNodeVersionDataV11ToV12 :: CDDLSpec NodeToNodeVersionData - -> NtNVersionDataV11ToLast + -> NtNVersionDataV11ToV12 -> Property -prop_encodeNodeToNodeVersionDataV11ToLast spec (NtNVersionDataV11ToLast (v, a)) = +prop_encodeNodeToNodeVersionDataV11ToV12 spec (NtNVersionDataV11ToV12 (v, a)) = + validateCBORTermEncoder spec (nodeToNodeCodecCBORTerm v) a + +prop_encodeNodeToNodeVersionDataV13ToLast + :: CDDLSpec NodeToNodeVersionData + -> NtNVersionDataV13ToLast + -> Property +prop_encodeNodeToNodeVersionDataV13ToLast spec (NtNVersionDataV13ToLast (v, a)) = validateCBORTermEncoder spec (nodeToNodeCodecCBORTerm v) a -- @@ -1007,11 +1061,18 @@ unit_decodeNodeToNodeVersionData spec = forM_ [NodeToNodeV_7 .. NodeToNodeV_10] $ \v -> validateCBORTermDecoder Nothing spec (nodeToNodeCodecCBORTerm v) 100 -unit_decodeNodeToNodeVersionDataV11ToLast +unit_decodeNodeToNodeVersionDataV11ToV12 + :: CDDLSpec NodeToNodeVersionData + -> Assertion +unit_decodeNodeToNodeVersionDataV11ToV12 spec = + forM_ [NodeToNodeV_11, NodeToNodeV_12] $ \v -> + validateCBORTermDecoder Nothing spec (nodeToNodeCodecCBORTerm v) 100 + +unit_decodeNodeToNodeVersionDataV13ToLast :: CDDLSpec NodeToNodeVersionData -> Assertion -unit_decodeNodeToNodeVersionDataV11ToLast spec = - forM_ [NodeToNodeV_11 ..] $ \v -> +unit_decodeNodeToNodeVersionDataV13ToLast spec = + forM_ [NodeToNodeV_13 ..] $ \v -> validateCBORTermDecoder Nothing spec (nodeToNodeCodecCBORTerm v) 100 -- diff --git a/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11.cddl b/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11-12.cddl similarity index 96% rename from ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11.cddl rename to ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11-12.cddl index a9390bb31bf..9ed79491109 100644 --- a/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v11-12.cddl @@ -1,5 +1,5 @@ ; -; NodeToNode Handshake, v11 +; NodeToNode Handshake, v11 to v12 ; handshakeMessage = msgProposeVersions diff --git a/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v13.cddl b/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v13.cddl new file mode 100644 index 00000000000..fa99df5078b --- /dev/null +++ b/ouroboros-network-protocols/test-cddl/specs/handshake-node-to-node-v13.cddl @@ -0,0 +1,36 @@ +; +; NodeToNode Handshake, v13 +; +handshakeMessage + = msgProposeVersions + / msgAcceptVersion + / msgRefuse + / msgQueryReply + +msgProposeVersions = [0, versionTable] +msgAcceptVersion = [1, versionNumber, nodeToNodeVersionData] +msgRefuse = [2, refuseReason] +msgQueryReply = [3, versionTable] + +versionTable = { * versionNumber => nodeToNodeVersionData } + +versionNumber = 13 + +nodeToNodeVersionData = [ networkMagic, initiatorAndResponderDiffusionMode, peerSharing, query ] + +; range between 0 and 0xffffffff +networkMagic = 0..4294967295 +initiatorAndResponderDiffusionMode = bool +; range between 0 and 1 +peerSharing = 0..1 +query = bool + +refuseReason + = refuseReasonVersionMismatch + / refuseReasonHandshakeDecodeError + / refuseReasonRefused + +refuseReasonVersionMismatch = [0, [ *versionNumber ] ] +refuseReasonHandshakeDecodeError = [1, versionNumber, tstr] +refuseReasonRefused = [2, versionNumber, tstr] + diff --git a/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v11.cddl b/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v11-12.cddl similarity index 87% rename from ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v11.cddl rename to ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v11-12.cddl index 51da54a9b9f..6e31a0fdf62 100644 --- a/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v11.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v11-12.cddl @@ -1,5 +1,5 @@ ; -; NodeToNodeVersionData, v11 +; NodeToNodeVersionData, v11 to v12 ; nodeToNodeVersionData = [ networkMagic, initiatorAndResponderDiffusionMode, peerSharing, query ] diff --git a/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v13.cddl b/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v13.cddl new file mode 100644 index 00000000000..ef0e7f4cfb3 --- /dev/null +++ b/ouroboros-network-protocols/test-cddl/specs/node-to-node-version-data-v13.cddl @@ -0,0 +1,12 @@ +; +; NodeToNodeVersionData, v13 +; + +nodeToNodeVersionData = [ networkMagic, initiatorAndResponderDiffusionMode, peerSharing, query ] + +; range between 0 and 0xffffffff +networkMagic = 0..4294967295 +initiatorAndResponderDiffusionMode = bool +; range between 0 and 1 +peerSharing = 0..1 +query = bool diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs index 30d3bd1681d..ca79691426a 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs @@ -116,6 +116,8 @@ tests = prop_query_version_NodeToNode_IO , testProperty "query version SimNet" prop_query_version_NodeToNode_SimNet + , testProperty "peerSharing symmetry" + prop_peerSharing_symmetric_NodeToNode_SimNet ] , testGroup "NodeToClient" @@ -657,9 +659,9 @@ newtype ArbitraryNodeToNodeVersionData = -- between parties. -- instance Eq ArbitraryNodeToNodeVersionData where - (==) (ArbitraryNodeToNodeVersionData (NodeToNodeVersionData nm dm _ _)) - (ArbitraryNodeToNodeVersionData (NodeToNodeVersionData nm' dm' _ _)) - = nm == nm' && dm == dm' + (==) (ArbitraryNodeToNodeVersionData (NodeToNodeVersionData nm dm ps _)) + (ArbitraryNodeToNodeVersionData (NodeToNodeVersionData nm' dm' ps' _)) + = nm == nm' && dm == dm' && ps == ps' instance Queryable ArbitraryNodeToNodeVersionData where queryVersion = queryVersion . getNodeToNodeVersionData @@ -671,9 +673,8 @@ instance Arbitrary ArbitraryNodeToNodeVersionData where <*> elements [ InitiatorOnlyDiffusionMode , InitiatorAndResponderDiffusionMode ] - <*> elements [ NoPeerSharing - , PeerSharingPrivate - , PeerSharingPublic + <*> elements [ PeerSharingDisabled + , PeerSharingEnabled ] <*> arbitrary shrink (ArbitraryNodeToNodeVersionData @@ -697,9 +698,8 @@ instance Arbitrary ArbitraryNodeToNodeVersionData where shrinkMode InitiatorOnlyDiffusionMode = [] shrinkMode InitiatorAndResponderDiffusionMode = [InitiatorOnlyDiffusionMode] - shrinkPeerSharing PeerSharingPublic = [PeerSharingPrivate, NoPeerSharing] - shrinkPeerSharing PeerSharingPrivate = [NoPeerSharing] - shrinkPeerSharing NoPeerSharing = [] + shrinkPeerSharing PeerSharingDisabled = [] + shrinkPeerSharing PeerSharingEnabled = [PeerSharingDisabled] newtype ArbitraryNodeToNodeVersions = ArbitraryNodeToNodeVersions @@ -831,8 +831,12 @@ prop_query_version_NodeToNode_ST (cborTermVersionDataCodec (fmap transformNodeToNodeVersionData nodeToNodeCodecCBORTerm)) clientVersions serverVersions - (>= NodeToNodeV_12) - (\(ArbitraryNodeToNodeVersionData vd) -> ArbitraryNodeToNodeVersionData $ vd {NTN.query = True}) + (>= NodeToNodeV_13) + (\(ArbitraryNodeToNodeVersionData vd) -> + ArbitraryNodeToNodeVersionData $ + vd { NTN.query = True + , NTN.peerSharing = PeerSharingEnabled + }) -- | Run 'prop_query_version' in the IO monad. -- @@ -848,8 +852,12 @@ prop_query_version_NodeToNode_IO (cborTermVersionDataCodec (fmap transformNodeToNodeVersionData nodeToNodeCodecCBORTerm)) clientVersions serverVersions - (>= NodeToNodeV_12) - (\(ArbitraryNodeToNodeVersionData vd) -> ArbitraryNodeToNodeVersionData $ vd {NTN.query = True}) + (>= NodeToNodeV_13) + (\(ArbitraryNodeToNodeVersionData vd) -> + ArbitraryNodeToNodeVersionData $ + vd { NTN.query = True + , NTN.peerSharing = PeerSharingEnabled + }) -- | Run 'prop_query_version' with SimNet. -- @@ -865,8 +873,12 @@ prop_query_version_NodeToNode_SimNet (cborTermVersionDataCodec (fmap transformNodeToNodeVersionData nodeToNodeCodecCBORTerm)) clientVersions serverVersions - (>= NodeToNodeV_12) - (\(ArbitraryNodeToNodeVersionData vd) -> ArbitraryNodeToNodeVersionData $ vd {NTN.query = True}) + (>= NodeToNodeV_13) + (\(ArbitraryNodeToNodeVersionData vd) -> + ArbitraryNodeToNodeVersionData $ + vd { NTN.query = True + , NTN.peerSharing = PeerSharingEnabled + }) -- | Run 'prop_query_version' in the simulation monad. -- @@ -971,6 +983,66 @@ prop_query_version createChannels codec versionDataCodec clientVersions serverVe clientVersions' = setQueryVersions clientVersions +-- | Run a query for the server's supported version. +-- +prop_peerSharing_symmetric :: ( MonadAsync m + , MonadCatch m + , MonadST m + ) + => m (Channel m ByteString, Channel m ByteString) + -> Codec (Handshake NodeToNodeVersion CBOR.Term) + CBOR.DeserialiseFailure m ByteString + -> VersionDataCodec CBOR.Term NodeToNodeVersion ArbitraryNodeToNodeVersionData + -> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool + -> Versions NodeToNodeVersion ArbitraryNodeToNodeVersionData Bool + -> m Property +prop_peerSharing_symmetric createChannels codec versionDataCodec clientVersions serverVersions = do + (clientRes, serverRes) <- + runConnectedPeers + createChannels nullTracer codec + (handshakeClientPeer + versionDataCodec + acceptableVersion + clientVersions) + (handshakeServerPeer + versionDataCodec + acceptableVersion + queryVersion + serverVersions) + pure $ case (clientRes, serverRes) of + ( Right (HandshakeNegotiationResult _ v (ArbitraryNodeToNodeVersionData clientResult)) + , Right (HandshakeNegotiationResult _ v' (ArbitraryNodeToNodeVersionData serverResult)) + ) | v == v' + , v >= NodeToNodeV_13 -> + counterexample + ( "VersionNumber: " ++ show v ++ "\n" + ++ "Client Result:\n" ++ show clientResult ++ "\n" + ++ "Server Result:\n" ++ show serverResult + ) + $ clientResult == serverResult + | v == v' + , v < NodeToNodeV_13 -> property True + | otherwise -> counterexample "Version mismatch" False + (Right _, Left _) -> counterexample "Acceptance mismatch" False + (Left _, Right _) -> counterexample "Acceptance mismatch" False + _ -> property True + +-- | Run 'prop_peerSharing_symmetric' with SimNet. +-- +prop_peerSharing_symmetric_NodeToNode_SimNet + :: ArbitraryNodeToNodeVersions + -> ArbitraryNodeToNodeVersions + -> Property +prop_peerSharing_symmetric_NodeToNode_SimNet + (ArbitraryNodeToNodeVersions clientVersions) + (ArbitraryNodeToNodeVersions serverVersions) = + runSimOrThrow $ prop_peerSharing_symmetric + createConnectedChannels + (codecHandshake nodeToNodeVersionCodec) + (cborTermVersionDataCodec (fmap transformNodeToNodeVersionData nodeToNodeCodecCBORTerm)) + clientVersions + serverVersions + -- | 'acceptOrRefuse' is symmetric in the following sense: -- -- Either both sides: diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md index 6c57847851d..74e9c048048 100644 --- a/ouroboros-network/CHANGELOG.md +++ b/ouroboros-network/CHANGELOG.md @@ -6,6 +6,8 @@ ### Non-breaking changes +* Update types to accommodate `PeerSharing` data type changes. + ## 0.9.2.0 -- 2023-10-26 ### Breaking changes diff --git a/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs b/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs index 17aba9a186a..774040371cc 100644 --- a/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs +++ b/ouroboros-network/io-tests/Test/Ouroboros/Network/Socket.hs @@ -171,7 +171,7 @@ demo chain0 updates = withIOManager $ \iocp -> do (NodeToNodeVersionData { networkMagic = NetworkMagic 0, diffusionMode = InitiatorAndResponderDiffusionMode, - peerSharing = NoPeerSharing, + peerSharing = PeerSharingDisabled, query = False }) (SomeResponderApplication responderApp)) nullErrorPolicies @@ -191,7 +191,7 @@ demo chain0 updates = withIOManager $ \iocp -> do (NodeToNodeVersionData { networkMagic = NetworkMagic 0, diffusionMode = InitiatorOnlyDiffusionMode, - peerSharing = NoPeerSharing, + peerSharing = PeerSharingDisabled, query = False }) initiatorApp) (Just consumerAddress) diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs index 98d892567bb..089df3c5a86 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs @@ -366,23 +366,25 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = where encodeData _ NtNVersionData { ntnDiffusionMode, ntnPeerSharing } = case ntnDiffusionMode of - InitiatorOnlyDiffusionMode -> case ntnPeerSharing of - NoPeerSharing -> CBOR.TList [CBOR.TBool False, CBOR.TInt 0] - PeerSharingPrivate -> CBOR.TList [CBOR.TBool False, CBOR.TInt 1] - PeerSharingPublic -> CBOR.TList [CBOR.TBool False, CBOR.TInt 2] - InitiatorAndResponderDiffusionMode -> case ntnPeerSharing of - NoPeerSharing -> CBOR.TList [CBOR.TBool True, CBOR.TInt 0] - PeerSharingPrivate -> CBOR.TList [CBOR.TBool True, CBOR.TInt 1] - PeerSharingPublic -> CBOR.TList [CBOR.TBool True, CBOR.TInt 2] - decodeData _ bytes = case bytes of - CBOR.TList [CBOR.TBool False, CBOR.TInt 0] -> Right (NtNVersionData InitiatorOnlyDiffusionMode NoPeerSharing) - CBOR.TList [CBOR.TBool False, CBOR.TInt 1] -> Right (NtNVersionData InitiatorOnlyDiffusionMode PeerSharingPrivate) - CBOR.TList [CBOR.TBool False, CBOR.TInt 2] -> Right (NtNVersionData InitiatorOnlyDiffusionMode PeerSharingPublic) - - CBOR.TList [CBOR.TBool True, CBOR.TInt 0] -> Right (NtNVersionData InitiatorAndResponderDiffusionMode NoPeerSharing) - CBOR.TList [CBOR.TBool True, CBOR.TInt 1] -> Right (NtNVersionData InitiatorAndResponderDiffusionMode PeerSharingPrivate) - CBOR.TList [CBOR.TBool True, CBOR.TInt 2] -> Right (NtNVersionData InitiatorAndResponderDiffusionMode PeerSharingPublic) - _ -> Left (Text.pack "unversionedDataCodec: unexpected term") + InitiatorOnlyDiffusionMode -> + let peerSharing = case ntnPeerSharing of + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1 + in CBOR.TList [CBOR.TBool False, CBOR.TInt peerSharing] + InitiatorAndResponderDiffusionMode -> + let peerSharing = case ntnPeerSharing of + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1 + in CBOR.TList [CBOR.TBool True, CBOR.TInt peerSharing] + + toPeerSharing :: Int -> PeerSharing + toPeerSharing 0 = PeerSharingDisabled + toPeerSharing 1 = PeerSharingEnabled + toPeerSharing _ = error "toPeerSharing: out of bounds" + + decodeData _ (CBOR.TList [CBOR.TBool False, CBOR.TInt a]) = Right (NtNVersionData InitiatorOnlyDiffusionMode (toPeerSharing a)) + decodeData _ (CBOR.TList [CBOR.TBool True, CBOR.TInt a]) = Right (NtNVersionData InitiatorAndResponderDiffusionMode (toPeerSharing a)) + decodeData _ _ = Left (Text.pack "unversionedDataCodec: unexpected term") args :: Diff.Arguments (NtNFD m) NtNAddr (NtCFD m) NtCAddr args = Diff.Arguments diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs index 354480df28f..4a4cf74279f 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs @@ -336,7 +336,7 @@ applications debugTracer nodeKernel keepAliveInitiator keepAliveResponder } - ] ++ if aaOwnPeerSharing /= PSTypes.NoPeerSharing + ] ++ if aaOwnPeerSharing /= PSTypes.PeerSharingDisabled then [ MiniProtocol { miniProtocolNum = peerSharingMiniProtocolNum , miniProtocolLimits = peerSharingLimits limits diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/NodeToNode/Version.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/NodeToNode/Version.hs index ae81c9f1d61..ac0143271ef 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/NodeToNode/Version.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/NodeToNode/Version.hs @@ -32,10 +32,9 @@ instance Arbitrary NodeToNodeVersionData where <*> oneof [ pure InitiatorOnlyDiffusionMode , pure InitiatorAndResponderDiffusionMode ] - <*> oneof [ pure NoPeerSharing - , pure PeerSharingPrivate - , pure PeerSharingPublic - ] + <*> elements [ PeerSharingDisabled + , PeerSharingEnabled + ] <*> arbitrary prop_nodeToNodeCodec :: NodeToNodeVersion -> NodeToNodeVersionData -> Bool diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs index 1ede66baaf6..24e404b714f 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs @@ -1368,7 +1368,7 @@ governorEventuallyTakesPeerShareOpportunities peerSharing = && isNothing peerShareEvent -- Peer Sharing must be enabled - && peerSharing /= NoPeerSharing + && peerSharing /= PeerSharingDisabled -- Note that if a peer share does take place, we do /not/ require -- the peer sharing target to be a member of the peerShareOpportunities. @@ -2883,7 +2883,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains peerSharing = do peerSharing = peerSharing, readPeerSelectionTargets = return targets, requestPeerShare = \_ _ -> return (PeerSharingResult []), - peerConnToPeerSharing = \ps -> ps, + peerConnToPeerSharing = id, requestPublicRootPeers = \_ -> return (Map.empty, 0), readNewInboundConnection = retry, requestBigLedgerPeers = \_ -> return (Set.empty, 0), @@ -2926,10 +2926,10 @@ prop_issue_3550 :: Property prop_issue_3550 = prop_governor_target_established_below $ GovernorMockEnvironment { peerGraph = PeerGraph - [ (PeerAddr 4,[],GovernorScripts {peerShareScript = Script (Just ([],PeerShareTimeSlow) :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), - (PeerAddr 14,[],GovernorScripts {peerShareScript = Script (Nothing :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), - (PeerAddr 16,[],GovernorScripts {peerShareScript = Script (Nothing :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), - (PeerAddr 29,[],GovernorScripts {peerShareScript = Script (Nothing :| []), connectionScript = Script ((ToWarm,NoDelay) :| [(ToCold,NoDelay),(Noop,NoDelay)])}) + [ (PeerAddr 4,[],GovernorScripts {peerShareScript = Script (Just ([],PeerShareTimeSlow) :| []), peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), + (PeerAddr 14,[],GovernorScripts {peerShareScript = Script (Nothing :| []), peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), + (PeerAddr 16,[],GovernorScripts {peerShareScript = Script (Nothing :| []), peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), + (PeerAddr 29,[],GovernorScripts {peerShareScript = Script (Nothing :| []), peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((ToWarm,NoDelay) :| [(ToCold,NoDelay),(Noop,NoDelay)])}) ], localRootPeers = LocalRootPeers.fromGroups [(1,1,Map.fromList [(PeerAddr 16,DoAdvertisePeer)]),(1,1,Map.fromList [(PeerAddr 4,DoAdvertisePeer)])], publicRootPeers = Map.fromList @@ -2950,7 +2950,7 @@ prop_issue_3550 = prop_governor_target_established_below $ pickHotPeersToDemote = Script (PickSome (Set.fromList [PeerAddr 29]) :| []), pickWarmPeersToDemote = Script (PickFirst :| []), pickColdPeersToForget = Script (PickFirst :| []), - peerSharing = PeerSharingPublic + peerSharing = PeerSharingEnabled } -- | issue #3515 @@ -2967,6 +2967,7 @@ prop_issue_3515 = prop_governor_nolivelock $ peerGraph = PeerGraph [(PeerAddr 10,[],GovernorScripts { peerShareScript = Script (Nothing :| []), + peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((ToCold,NoDelay) :| [(Noop,NoDelay)]) })], localRootPeers = LocalRootPeers.fromGroups [(1,1,Map.fromList [(PeerAddr 10,DoAdvertisePeer)])], @@ -2984,7 +2985,7 @@ prop_issue_3515 = prop_governor_nolivelock $ pickHotPeersToDemote = Script (PickFirst :| []), pickWarmPeersToDemote = Script (PickFirst :| []), pickColdPeersToForget = Script (PickFirst :| []), - peerSharing = PeerSharingPublic + peerSharing = PeerSharingEnabled } -- | issue #3494 @@ -2999,6 +3000,7 @@ prop_issue_3494 = prop_governor_nofail $ GovernorMockEnvironment { peerGraph = PeerGraph [(PeerAddr 64,[],GovernorScripts { peerShareScript = Script (Nothing :| []), + peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((ToCold,NoDelay) :| [(Noop,NoDelay)]) })], localRootPeers = LocalRootPeers.fromGroups [(1,1,Map.fromList [(PeerAddr 64,DoAdvertisePeer)])], @@ -3018,7 +3020,7 @@ prop_issue_3494 = prop_governor_nofail $ pickHotPeersToDemote = Script (PickFirst :| []), pickWarmPeersToDemote = Script (PickFirst :| []), pickColdPeersToForget = Script (PickFirst :| []), - peerSharing = PeerSharingPublic + peerSharing = PeerSharingEnabled } -- | issue #3233 @@ -3029,6 +3031,7 @@ prop_issue_3233 = prop_governor_nolivelock $ peerGraph = PeerGraph [(PeerAddr 4,[],GovernorScripts { peerShareScript = Script (Nothing :| []), + peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((ToCold,NoDelay) :| [(ToCold,NoDelay), (Noop,NoDelay), @@ -3037,8 +3040,8 @@ prop_issue_3233 = prop_governor_nolivelock $ (Noop,NoDelay) ]) }), - (PeerAddr 13,[],GovernorScripts {peerShareScript = Script (Nothing :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), - (PeerAddr 15,[],GovernorScripts {peerShareScript = Script (Just ([],PeerShareTimeSlow) :| []), connectionScript = Script ((Noop,NoDelay) :| [])}) + (PeerAddr 13,[],GovernorScripts {peerShareScript = Script (Nothing :| []), peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((Noop,NoDelay) :| [])}), + (PeerAddr 15,[],GovernorScripts {peerShareScript = Script (Just ([],PeerShareTimeSlow) :| []), peerSharingScript = Script (PeerSharingDisabled :| []), connectionScript = Script ((Noop,NoDelay) :| [])}) ], localRootPeers = LocalRootPeers.fromGroups [(1,1,Map.fromList [(PeerAddr 15,DoAdvertisePeer)]),(1,1,Map.fromList [(PeerAddr 13,DoAdvertisePeer)])], publicRootPeers = Map.fromList [(PeerAddr 4, (DoNotAdvertisePeer, IsNotLedgerPeer))], @@ -3064,7 +3067,7 @@ prop_issue_3233 = prop_governor_nolivelock $ pickHotPeersToDemote = Script (PickFirst :| []), pickWarmPeersToDemote = Script (PickFirst :| []), pickColdPeersToForget = Script (PickFirst :| []), - peerSharing = PeerSharingPublic + peerSharing = PeerSharingEnabled } diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/Instances.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/Instances.hs index 4cbe9c9bd7f..25f4ee5ce4e 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/Instances.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/Instances.hs @@ -57,10 +57,9 @@ instance Arbitrary PeerAdvertise where shrink DoNotAdvertisePeer = [DoAdvertisePeer] instance Arbitrary PeerSharing where - arbitrary = elements [ NoPeerSharing, PeerSharingPrivate, PeerSharingPublic ] - shrink PeerSharingPublic = [PeerSharingPrivate, NoPeerSharing] - shrink PeerSharingPrivate = [NoPeerSharing] - shrink NoPeerSharing = [] + arbitrary = elements [ PeerSharingDisabled, PeerSharingEnabled ] + shrink PeerSharingDisabled = [] + shrink PeerSharingEnabled = [PeerSharingDisabled] instance Arbitrary IsLedgerPeer where arbitrary = elements [ IsLedgerPeer, IsNotLedgerPeer ] diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index de5dea6b709..ee8ad9cd65e 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs @@ -61,7 +61,7 @@ import Ouroboros.Network.Testing.Data.Script (PickScript, Script (..), ScriptDelay (..), TimedScript, arbitraryPickScript, arbitraryScriptOf, initScript', interpretPickScript, playTimedScript, prop_shrink_Script, singletonScript, - stepScript) + stepScript, stepScriptSTM') import Ouroboros.Network.Testing.Utils (ShrinkCarefully, arbitrarySubset, nightlyTest, prop_shrink_nonequal, prop_shrink_valid) @@ -74,7 +74,8 @@ import Test.Ouroboros.Network.PeerSelection.PeerGraph import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer, IsLedgerPeer) import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing, + combinePeerSharing) import Ouroboros.Network.PeerSelection.Types (PeerStatus (..)) import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount, PeerSharingResult (..)) @@ -261,12 +262,14 @@ mockPeerSelectionActions tracer policy = do scripts <- Map.fromList <$> sequence - [ (\a b -> (addr, (a, b))) + [ (\a b c -> (addr, (a, b, c))) <$> initScript' peerShareScript + <*> initScript' peerSharingScript <*> initScript' connectionScript | let PeerGraph adjacency = peerGraph , (addr, _, GovernorScripts { peerShareScript, + peerSharingScript, connectionScript }) <- adjacency ] @@ -302,7 +305,7 @@ mockPeerSelectionActions' :: forall m. => Tracer m TraceMockEnv -> GovernorMockEnvironment -> PeerSelectionPolicy PeerAddr m - -> Map PeerAddr (TVar m PeerShareScript, TVar m ConnectionScript) + -> Map PeerAddr (TVar m PeerShareScript, TVar m PeerSharingScript, TVar m ConnectionScript) -> TVar m PeerSelectionTargets -> TVar m (Map PeerAddr (TVar m PeerStatus)) -> PeerSelectionActions PeerAddr (PeerConn m) m @@ -361,7 +364,7 @@ mockPeerSelectionActions' tracer requestPeerShare :: PeerSharingAmount -> PeerAddr -> m (PeerSharingResult PeerAddr) requestPeerShare _ addr = do - let Just (peerShareScript, _) = Map.lookup addr scripts + let Just (peerShareScript, _, _) = Map.lookup addr scripts mPeerShare <- stepScript peerShareScript traceWith tracer (TraceEnvPeerShareRequest addr mPeerShare) _ <- async $ do @@ -382,13 +385,14 @@ mockPeerSelectionActions' tracer --TODO: add support for variable delays and synchronous failure traceWith tracer (TraceEnvEstablishConn peeraddr) threadDelay 1 + let Just (_, peerSharingScript, connectScript) = Map.lookup peeraddr scripts conn@(PeerConn _ _ v) <- atomically $ do conn <- newTVar PeerWarm conns <- readTVar connsVar let !conns' = Map.insert peeraddr conn conns writeTVar connsVar conns' - return (PeerConn peeraddr peerSharing conn) - let Just (_, connectScript) = Map.lookup peeraddr scripts + remotePeerSharing <- stepScriptSTM' peerSharingScript + return (PeerConn peeraddr (combinePeerSharing peerSharing remotePeerSharing) conn) _ <- async $ -- monitoring loop which does asynchronous demotions. It will terminate -- as soon as either of the events: @@ -480,7 +484,7 @@ mockPeerSelectionActions' tracer monitorPeerConnection :: PeerConn m -> STM m (PeerStatus, Maybe ReconnectDelay) monitorPeerConnection (PeerConn _peeraddr _ conn) = (,) <$> readTVar conn - <*> pure Nothing + <*> pure Nothing snapshotPeersStatus :: MonadInspectSTM m diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs index e610e4adb58..73a09e218d8 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs @@ -60,8 +60,9 @@ newtype PeerGraph = PeerGraph [(PeerAddr, [PeerAddr], PeerInfo)] type PeerInfo = GovernorScripts data GovernorScripts = GovernorScripts { - peerShareScript :: PeerShareScript, - connectionScript :: ConnectionScript + peerShareScript :: PeerShareScript, + peerSharingScript :: PeerSharingScript, + connectionScript :: ConnectionScript } deriving (Eq, Show) @@ -213,13 +214,18 @@ instance Arbitrary AsyncDemotion where instance Arbitrary GovernorScripts where arbitrary = GovernorScripts <$> arbitrary + <*> arbitrary <*> (fixConnectionScript <$> arbitrary) - shrink GovernorScripts { peerShareScript, connectionScript } = - [ GovernorScripts peerShareScript' connectionScript + shrink GovernorScripts { peerShareScript, peerSharingScript, connectionScript } = + [ GovernorScripts peerShareScript' peerSharingScript connectionScript | peerShareScript' <- shrink peerShareScript ] ++ - [ GovernorScripts peerShareScript connectionScript' + [ GovernorScripts peerShareScript peerSharingScript' connectionScript + | peerSharingScript' <- shrink peerSharingScript + ] + ++ + [ GovernorScripts peerShareScript peerSharingScript connectionScript' | connectionScript' <- map fixConnectionScript (shrink connectionScript) -- fixConnectionScript can result in re-creating the same script -- which would cause shrinking to loop. Filter out such cases. @@ -247,8 +253,9 @@ instance Arbitrary PeerGraph where [ (from, Set.singleton (PeerAddr to)) | (from, to) <- edges ] graph <- sequence [ do peerShareScript <- arbitraryPeerShareScript outedges + peerSharingScript <- arbitraryScriptOf (length outedges) arbitrary connectionScript <- fixConnectionScript <$> arbitrary - let node = GovernorScripts { peerShareScript, connectionScript } + let node = GovernorScripts { peerShareScript, peerSharingScript, connectionScript } return (PeerAddr n, outedges, node) | n <- [0..numNodes-1] , let outedges = maybe [] Set.toList @@ -292,11 +299,12 @@ prunePeerGraphEdges :: [(PeerAddr, [PeerAddr], PeerInfo)] prunePeerGraphEdges graph = [ (nodeaddr, edges', node) | let nodes = Set.fromList [ nodeaddr | (nodeaddr, _, _) <- graph ] - , (nodeaddr, edges, GovernorScripts { peerShareScript = Script peershare, connectionScript }) <- graph + , (nodeaddr, edges, GovernorScripts { peerShareScript = Script peershare, peerSharingScript, connectionScript }) <- graph , let edges' = pruneEdgeList nodes edges peershare' = prunePeerShareScript (Set.fromList edges') peershare node = GovernorScripts { peerShareScript = Script peershare', + peerSharingScript, connectionScript } ] diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs index a482bba6e7f..cd537c81f41 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs @@ -373,7 +373,7 @@ unit_4177 = prop_inbound_governor_transitions_coverage absNoAttenuation script [ ( NodeArgs (-6) InitiatorAndResponderDiffusionMode (Just 180) (Map.fromList [(RelayAccessDomain "test2" 65535, DoAdvertisePeer)]) (TestAddress (IPAddr (read "0:7:0:7::") 65533)) - NoPeerSharing + PeerSharingDisabled [(1,1,Map.fromList [(RelayAccessDomain "test2" 65535,DoNotAdvertisePeer),(RelayAccessAddress "0:6:0:3:0:6:0:5" 65530,DoNotAdvertisePeer)])] (Script (LedgerPools [] :| [])) nullPeerSelectionTargets { @@ -400,7 +400,7 @@ unit_4177 = prop_inbound_governor_transitions_coverage absNoAttenuation script , ( NodeArgs (1) InitiatorAndResponderDiffusionMode (Just 135) (Map.fromList [(RelayAccessAddress "0:7:0:7::" 65533, DoAdvertisePeer)]) (TestAddress (IPAddr (read "0:6:0:3:0:6:0:5") 65530)) - NoPeerSharing + PeerSharingDisabled [] (Script (LedgerPools [] :| [])) nullPeerSelectionTargets { @@ -858,7 +858,7 @@ unit_4191 = prop_diffusion_dns_can_recover absInfo script (Just 224) Map.empty (TestAddress (IPAddr (read "0.0.1.236") 65527)) - NoPeerSharing + PeerSharingDisabled [ (2,2,Map.fromList [ (RelayAccessDomain "test2" 15,DoNotAdvertisePeer) , (RelayAccessDomain "test3" 4,DoAdvertisePeer)]) ] @@ -1883,7 +1883,7 @@ async_demotion_network_script = = Nothing, naChainSyncEarlyExit = False, - naPeerSharing = NoPeerSharing + naPeerSharing = PeerSharingDisabled } @@ -2303,7 +2303,7 @@ prop_unit_4258 = (Just 224) Map.empty (TestAddress (IPAddr (read "0.0.0.4") 9)) - NoPeerSharing + PeerSharingDisabled [(1,1,Map.fromList [(RelayAccessAddress "0.0.0.8" 65531,DoNotAdvertisePeer)])] (Script (LedgerPools [] :| [])) PeerSelectionTargets { @@ -2337,7 +2337,7 @@ prop_unit_4258 = (Just 269) (Map.fromList [(RelayAccessAddress "0.0.0.4" 9, DoNotAdvertisePeer)]) (TestAddress (IPAddr (read "0.0.0.8") 65531)) - NoPeerSharing + PeerSharingDisabled [(1,1,Map.fromList [(RelayAccessAddress "0.0.0.4" 9,DoNotAdvertisePeer)])] (Script (LedgerPools [] :| [])) PeerSelectionTargets { diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs index 8ce3e62e52c..fbee2324f3c 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs @@ -193,7 +193,7 @@ data NodeArgs = , naAddr :: NtNAddr -- ^ 'Arguments' 'aIPAddress' value , naPeerSharing :: PeerSharing - -- ^ 'Arguments' 'aIPAddress' value + -- ^ 'Arguments' 'aOwnPeerSharing' value , naLocalRootPeers :: [( HotValency , WarmValency , Map RelayAccessPoint PeerAdvertise diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs index 898d8be3535..5b0aa192dc0 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -446,8 +446,8 @@ data Interfaces ntnFd ntnAddr ntnVersion ntnVersionData diNtnDataFlow :: ntnVersion -> ntnVersionData -> DataFlow, - -- | peer sharing information used by peer selection governor to - -- decide which peers are available for performing peer sharing + -- | remote side peer sharing information used by peer selection governor + -- to decide which peers are available for performing peer sharing diNtnPeerSharing :: ntnVersionData -> PeerSharing, @@ -715,7 +715,7 @@ runM Interfaces -- local thread does not start a Outbound Governor -- so it doesn't matter what we put here. -- 'NoPeerSharing' is set for all connections. - cmGetPeerSharing = \_ -> NoPeerSharing + cmGetPeerSharing = \_ -> PeerSharingDisabled } withConnectionManager @@ -891,7 +891,7 @@ runM Interfaces peerSharingRng))) classifyHandleError (InResponderMode inbndInfoChannel) - (if daOwnPeerSharing /= NoPeerSharing + (if daOwnPeerSharing /= PeerSharingDisabled then InResponderMode (Just outbndInfoChannel) else InResponderMode Nothing) diff --git a/ouroboros-network/src/Ouroboros/Network/NodeToNode.hs b/ouroboros-network/src/Ouroboros/Network/NodeToNode.hs index 7292e5a3b90..96bdc44f68c 100644 --- a/ouroboros-network/src/Ouroboros/Network/NodeToNode.hs +++ b/ouroboros-network/src/Ouroboros/Network/NodeToNode.hs @@ -286,7 +286,7 @@ nodeToNodeProtocols miniProtocolParameters protocols version ownPeerSharing = -- Only register PeerSharing Protocol if version >= NodeToNodeV_11 and if peer -- has PeerSharing enabled NodeToNodeProtocols { keepAliveProtocol, peerSharingProtocol } - | version >= NodeToNodeV_11 && ownPeerSharing /= NoPeerSharing -> + | version >= NodeToNodeV_11 && ownPeerSharing /= PeerSharingDisabled -> [ MiniProtocol { miniProtocolNum = keepAliveMiniProtocolNum, miniProtocolLimits = keepAliveProtocolLimits miniProtocolParameters, diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs index 4e71837991b..b55c2b615d5 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/BigLedgerPeers.hs @@ -116,7 +116,7 @@ jobReqBigLedgerPeers PeerSelectionActions{ requestBigLedgerPeers } knownPeers' = KnownPeers.insert - (Map.fromSet (\_ -> ( Just NoPeerSharing + (Map.fromSet (\_ -> ( Just PeerSharingDisabled -- the peer sharing flag will be -- updated once we negotiate -- the connection diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs index 6d78a921d3b..a34f611436f 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/EstablishedPeers.hs @@ -413,8 +413,6 @@ jobPromoteColdPeer PeerSelectionActions { let establishedPeers' = EstablishedPeers.insert peeraddr peerconn establishedPeers -- Update PeerSharing value in KnownPeers - -- This will compute the appropriate peer sharing value using - -- 'combinePeerInformation' knownPeers' = KnownPeers.insert (Map.singleton peeraddr (Just peerSharing, Nothing, Nothing)) $ KnownPeers.clearTepidFlag peeraddr $ KnownPeers.resetFailCount diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs index c36cb5137b0..54b5983daf7 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs @@ -59,7 +59,7 @@ belowTarget actions } } -- Only start Peer Sharing request if PeerSharing was enabled - | peerSharing /= NoPeerSharing + | peerSharing /= PeerSharingDisabled -- Are we under target for number of known peers? , numKnownPeers < targetNumberOfKnownPeers diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/RootPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/RootPeers.hs index f1dbebde5a7..e1231943619 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/RootPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/RootPeers.hs @@ -118,7 +118,7 @@ jobReqPublicRootPeers PeerSelectionActions{ requestPublicRootPeers knownPeers' = KnownPeers.insert -- When we don't know about the PeerSharing information -- we default to NoPeerSharing - (Map.map (\(a, b) -> (Just NoPeerSharing, Just a, Just b)) newPeers) + (Map.map (\(a, b) -> (Just PeerSharingDisabled, Just a, Just b)) newPeers) (knownPeers st) -- We got a successful response to our request, but if we're still diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs index 9c6353f6c26..47c3b68234f 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -262,7 +262,7 @@ data PeerSelectionActions peeraddr peerconn m = PeerSelectionActions { -- peerSharing :: PeerSharing, - -- | Get a PeerSharing value from 'peerconn' + -- | Get the remote's side PeerSharing value from 'peerconn' -- -- 'peerconn' ideally comes from a call to 'establishPeerConnection'. -- This will establish a connection and perform handshake. The returned diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs index e8498186616..aab6bdb5c5d 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs @@ -456,8 +456,8 @@ instance (Show peerAddr, Show versionData) "PeerConnectionHandle " ++ show pchConnectionId ++ " " ++ show pchVersionData pchPeerSharing :: (versionData -> PeerSharing) - -> PeerConnectionHandle muxMode responderCtx peerAddr versionData bytes m a b - -> PeerSharing + -> PeerConnectionHandle muxMode responderCtx peerAddr versionData bytes m a b + -> PeerSharing pchPeerSharing f = f . pchVersionData -- diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/State/KnownPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/State/KnownPeers.hs index 9c258d54622..8ac8c46dd97 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/State/KnownPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/State/KnownPeers.hs @@ -48,8 +48,7 @@ import Data.Maybe (fromMaybe) import Ouroboros.Network.PeerSelection.LedgerPeers (IsLedgerPeer (..)) import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..)) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..), - combinePeerInformation) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) ------------------------------- @@ -197,9 +196,7 @@ insert peeraddrs where newPeerInfo (peerSharing, peerAdvertise, ledgerPeers) = let peerAdvertise' = fromMaybe DoNotAdvertisePeer peerAdvertise - peerSharing' = fromMaybe NoPeerSharing peerSharing - `combinePeerInformation` - peerAdvertise' + peerSharing' = fromMaybe PeerSharingDisabled peerSharing in KnownPeerInfo { knownPeerFailCount = 0 , knownPeerTepid = False @@ -213,8 +210,7 @@ insert peeraddrs , knownPeerTepid = knownPeerTepid old -- It might be the case we are updating a peer's particular willingness -- flags or we just learned this peer comes from ledger. - , knownPeerSharing = combinePeerInformation (knownPeerSharing new) - (knownPeerAdvertise new) + , knownPeerSharing = knownPeerSharing new , knownPeerAdvertise = knownPeerAdvertise new -- Preserve Ledger Peer information if the peer is ledger. , knownLedgerPeer = case knownLedgerPeer old of @@ -387,8 +383,7 @@ setConnectTimes times canPeerShareRequest :: Ord peeraddr => peeraddr -> KnownPeers peeraddr -> Bool canPeerShareRequest pa KnownPeers { allPeers } = case Map.lookup pa allPeers of - Just (KnownPeerInfo _ _ PeerSharingPublic _ _) -> True - Just (KnownPeerInfo _ _ PeerSharingPrivate _ _) -> True + Just (KnownPeerInfo _ _ PeerSharingEnabled _ _) -> True _ -> False -- Filter available for Peer Sharing peers according to their PeerSharing From ce94809aa75bfa526fd62b5201903686fdebbf20 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Mon, 25 Sep 2023 14:16:29 +0100 Subject: [PATCH 2/4] Fix IPv6 enc/decoding Fixes #4679 --- .../src/Ouroboros/Network/PeerSelection/PeerSharing.hs | 8 ++------ .../test-cddl/specs/peer-sharing.cddl | 6 ++---- ouroboros-network/CHANGELOG.md | 1 + 3 files changed, 5 insertions(+), 10 deletions(-) diff --git a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs index 120308295be..3b6fb03e440 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs @@ -67,14 +67,12 @@ 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 +encodeRemoteAddress (SockAddrInet6 pn _ (w1, w2, w3, w4) _) = CBOR.encodeListLen 6 <> 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!" @@ -97,8 +95,6 @@ decodeRemoteAddress = do 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) + return (SockAddrInet6 pn 0 (w1, w2, w3, w4) 0) _ -> fail ("Serialise.decode.SockAddr unexpected tok " ++ show tok) diff --git a/ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl b/ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl index b46706211be..fef67334de0 100644 --- a/ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl +++ b/ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl @@ -14,9 +14,7 @@ peerAddresses = [* peerAddress] byte = 0..255 -peerAddress = [0, word32, portNumber] ; ipv4 + portNumber - / [1, word32, word32, word32, word32, flowInfo, scopeId, portNumber] ; ipv6 + portNumber +peerAddress = [0, word32, portNumber] ; ipv4 + portNumber + / [1, word32, word32, word32, word32, portNumber] ; ipv6 + portNumber portNumber = word16 -flowInfo = word32 -scopeId = word32 diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md index 74e9c048048..34269b91063 100644 --- a/ouroboros-network/CHANGELOG.md +++ b/ouroboros-network/CHANGELOG.md @@ -7,6 +7,7 @@ ### Non-breaking changes * Update types to accommodate `PeerSharing` data type changes. +* Fix PeerSharing IPv6 enc/decoding ## 0.9.2.0 -- 2023-10-26 From 50bab68fb9a6d8004d86acbfb51a09db3f2a563b Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Tue, 26 Sep 2023 15:20:15 +0100 Subject: [PATCH 3/4] Address review comments --- docs/network-spec/miniprotocols.tex | 7 +- ouroboros-network-api/CHANGELOG.md | 8 +- .../ouroboros-network-api.cabal | 1 + .../Ouroboros/Network/NodeToNode/Version.hs | 10 +- .../Network/PeerSelection/PeerSharing.hs | 93 +++------------- .../PeerSelection/PeerSharing/Codec.hs | 102 ++++++++++++++++++ .../Network/ConnectionManager/Core.hs | 2 +- .../Network/Protocol/Handshake/Unversioned.hs | 20 ++-- ouroboros-network-protocols/CHANGELOG.md | 6 +- ouroboros-network-protocols/test-cddl/Main.hs | 71 +++++++++--- .../test-cddl/specs/peer-sharing-v11-12.cddl | 22 ++++ ...eer-sharing.cddl => peer-sharing-v13.cddl} | 0 .../Network/Protocol/Handshake/Test.hs | 7 +- ouroboros-network/CHANGELOG.md | 10 ++ .../Test/Ouroboros/Network/Diffusion/Node.hs | 14 +-- .../Network/PeerSelection/MockEnvironment.hs | 5 +- .../Test/Ouroboros/Network/Testnet.hs | 5 +- .../PeerSelection/Governor/KnownPeers.hs | 2 +- .../Network/PeerSelection/PeerStateActions.hs | 4 +- 19 files changed, 252 insertions(+), 137 deletions(-) create mode 100644 ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs create mode 100644 ouroboros-network-protocols/test-cddl/specs/peer-sharing-v11-12.cddl rename ouroboros-network-protocols/test-cddl/specs/{peer-sharing.cddl => peer-sharing-v13.cddl} (100%) diff --git a/docs/network-spec/miniprotocols.tex b/docs/network-spec/miniprotocols.tex index 66eeaa22e5d..79b6319e247 100644 --- a/docs/network-spec/miniprotocols.tex +++ b/docs/network-spec/miniprotocols.tex @@ -1399,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} diff --git a/ouroboros-network-api/CHANGELOG.md b/ouroboros-network-api/CHANGELOG.md index a60e38a322a..7e944f15d23 100644 --- a/ouroboros-network-api/CHANGELOG.md +++ b/ouroboros-network-api/CHANGELOG.md @@ -4,11 +4,13 @@ ### Breaking changes -- Remote `PeerSharingPrivate` option from the `PeerSharing` data type. -- Rename `NoPeerSharing` and `PeerSharingPublic` to `PeerSharingDisabled` and +* 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 +* 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 diff --git a/ouroboros-network-api/ouroboros-network-api.cabal b/ouroboros-network-api/ouroboros-network-api.cabal index b9fb19aad61..dc9bb96e8e2 100644 --- a/ouroboros-network-api/ouroboros-network-api.cabal +++ b/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, diff --git a/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs index 811d22d1b7e..d448b2254e9 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs @@ -23,9 +23,7 @@ import Ouroboros.Network.Handshake.Acceptable (Accept (..), Acceptable (..)) import Ouroboros.Network.Handshake.Queryable (Queryable (..)) import Ouroboros.Network.Magic -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..), - combinePeerSharing) - +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) -- | Enumeration of node to node protocol versions. -- @@ -62,7 +60,7 @@ data NodeToNodeVersion | NodeToNodeV_13 -- ^ Changes: -- - -- * Adds a fix for PeerSharing handshake negotiation + -- * Added `localPeerSharing` negotiation flag. deriving (Eq, Ord, Enum, Bounded, Show, Typeable) nodeToNodeVersionCodec :: CodecCBORTerm (Text, Maybe Int) NodeToNodeVersion @@ -134,8 +132,7 @@ instance Acceptable NodeToNodeVersionData where = Accept NodeToNodeVersionData { networkMagic = networkMagic local , diffusionMode = diffusionMode local `min` diffusionMode remote - , peerSharing = combinePeerSharing (peerSharing local) - (peerSharing remote) + , peerSharing = peerSharing local <> peerSharing remote , query = query local || query remote } | otherwise @@ -267,7 +264,6 @@ nodeToNodeCodecCBORTerm version data ConnectionMode = UnidirectionalMode | DuplexMode - -- | Check whether a version enabling diffusion pipelining has been -- negotiated. -- diff --git a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs index 3b6fb03e440..c3933e00db7 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs @@ -1,24 +1,11 @@ {-# LANGUAGE DeriveGeneric #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE InstanceSigs #-} -module Ouroboros.Network.PeerSelection.PeerSharing - ( PeerSharing (..) - , combinePeerSharing - , 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 Text.Read (readMaybe) -- | Is a peer willing to participate in Peer Sharing? If yes are others allowed -- to share this peer's address? @@ -32,69 +19,23 @@ data PeerSharing = PeerSharingDisabled -- ^ Peer does not participate in Peer Sh | 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 two 'PeerSharing' values --- --- 'PeerSharingDisabled' is the absorbing element -combinePeerSharing :: PeerSharing -> PeerSharing -> PeerSharing -combinePeerSharing PeerSharingDisabled _ = PeerSharingDisabled -combinePeerSharing _ PeerSharingDisabled = PeerSharingDisabled -combinePeerSharing _ _ = PeerSharingEnabled - -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 _ (w1, w2, w3, w4) _) = CBOR.encodeListLen 6 - <> CBOR.encodeWord 1 - <> CBOR.encodeWord32 w1 - <> CBOR.encodeWord32 w2 - <> CBOR.encodeWord32 w3 - <> CBOR.encodeWord32 w4 - <> 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 - pn <- decodePortNumber - return (SockAddrInet6 pn 0 (w1, w2, w3, w4) 0) - _ -> fail ("Serialise.decode.SockAddr unexpected tok " ++ show tok) +instance Monoid PeerSharing where + mempty :: PeerSharing + mempty = PeerSharingEnabled diff --git a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs new file mode 100644 index 00000000000..6fcb6ca71bb --- /dev/null +++ b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs @@ -0,0 +1,102 @@ +module Ouroboros.Network.PeerSelection.PeerSharing.Codec + ( encodePortNumber + , decodePortNumber + , encodeRemoteAddress + , decodeRemoteAddress + ) where + +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR + +import Network.Socket (PortNumber, SockAddr (..)) +import Ouroboros.Network.NodeToNode.Version (NodeToNodeVersion (..)) + +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. +-- +-- See the network design document for more details +--- +-- /Invariant:/ not a unix socket address type. +--- +encodeRemoteAddress :: NodeToNodeVersion -> SockAddr -> CBOR.Encoding +encodeRemoteAddress ntnVersion sockAddr + | ntnVersion >= NodeToNodeV_13 = + case sockAddr of + SockAddrInet pn w -> CBOR.encodeListLen 3 + <> CBOR.encodeWord 0 + <> CBOR.encodeWord32 w + <> encodePortNumber pn + SockAddrInet6 pn _ (w1, w2, w3, w4) _ -> CBOR.encodeListLen 6 + <> CBOR.encodeWord 1 + <> CBOR.encodeWord32 w1 + <> CBOR.encodeWord32 w2 + <> CBOR.encodeWord32 w3 + <> CBOR.encodeWord32 w4 + <> encodePortNumber pn + SockAddrUnix _ -> error "Should never be encoding a SockAddrUnix!" + | otherwise = + case sockAddr of + SockAddrInet pn w -> CBOR.encodeListLen 3 + <> CBOR.encodeWord 0 + <> CBOR.encodeWord32 w + <> encodePortNumber pn + 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 + SockAddrUnix _ -> error "Should never be encoding a SockAddrUnix!" + +-- | This decoder should be faithful to the PeerSharing +-- CDDL Specification. +-- +-- See the network design document for more details +-- +decodeRemoteAddress :: NodeToNodeVersion -> CBOR.Decoder s SockAddr +decodeRemoteAddress ntnVersion + | ntnVersion >= NodeToNodeV_13 = 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 + pn <- decodePortNumber + return (SockAddrInet6 pn 0 (w1, w2, w3, w4) 0) + _ -> fail ("Serialise.decode.SockAddr unexpected tok " ++ show tok) + | otherwise = 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 0 (w1, w2, w3, w4) 0) + _ -> fail ("Serialise.decode.SockAddr unexpected tok " ++ show tok) + diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs index a91319655ab..331df53a3f0 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs @@ -1844,11 +1844,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 -- need to notify the inbound governor, as -- it's already done by -- `includeInboundConnectionImpl` - Inbound -> False Outbound -> True writeTVar connVar connState' case inboundGovernorInfoChannel of diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs index 65e0552ddbb..55d7861aa8b 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} -- | Unversioned protocol, used in tests and demo applications. -- @@ -26,8 +27,7 @@ import Network.TypedProtocol.Codec import Ouroboros.Network.CodecCBORTerm import Ouroboros.Network.ConnectionManager.Types (DataFlow (..)) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..), - combinePeerSharing) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.Protocol.Handshake.Codec import Ouroboros.Network.Protocol.Handshake.Type import Ouroboros.Network.Protocol.Handshake.Version @@ -84,7 +84,7 @@ data DataFlowProtocolData = instance Acceptable DataFlowProtocolData where acceptableVersion (DataFlowProtocolData local lps) (DataFlowProtocolData remote rps) = - Accept (DataFlowProtocolData (local `min` remote) (combinePeerSharing lps rps)) + Accept (DataFlowProtocolData (local `min` remote) (lps <> rps)) instance Queryable DataFlowProtocolData where queryVersion (DataFlowProtocolData _ _) = False @@ -104,14 +104,14 @@ dataFlowProtocolDataCodec _ = CodecCBORTerm {encodeTerm, decodeTerm} PeerSharingEnabled -> 1 in CBOR.TList [CBOR.TBool True, CBOR.TInt peerSharing] - toPeerSharing :: Int -> PeerSharing - toPeerSharing 0 = PeerSharingDisabled - toPeerSharing 1 = PeerSharingEnabled - toPeerSharing _ = error "toPeerSharing: out of bounds" + toPeerSharing :: Int -> Either Text PeerSharing + toPeerSharing 0 = Right PeerSharingDisabled + toPeerSharing 1 = Right PeerSharingEnabled + toPeerSharing _ = Left "toPeerSharing: out of bounds" decodeTerm :: CBOR.Term -> Either Text DataFlowProtocolData - decodeTerm (CBOR.TList [CBOR.TBool False, CBOR.TInt a]) = Right (DataFlowProtocolData Unidirectional (toPeerSharing a)) - decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt a]) = Right (DataFlowProtocolData Duplex (toPeerSharing a)) + decodeTerm (CBOR.TList [CBOR.TBool False, CBOR.TInt a]) = DataFlowProtocolData Unidirectional <$> (toPeerSharing a) + decodeTerm (CBOR.TList [CBOR.TBool True, CBOR.TInt a]) = DataFlowProtocolData Duplex <$> (toPeerSharing a) decodeTerm t = Left $ T.pack $ "unexpected term: " ++ show t dataFlowProtocol :: DataFlow diff --git a/ouroboros-network-protocols/CHANGELOG.md b/ouroboros-network-protocols/CHANGELOG.md index 5c0cc90ded2..0aabf13656f 100644 --- a/ouroboros-network-protocols/CHANGELOG.md +++ b/ouroboros-network-protocols/CHANGELOG.md @@ -16,9 +16,11 @@ * Add a 3673s timeout to chainsync's StIdle state. * Add a 97s timeout to keepalive's StClient state. -- Add a test to check that Peer Sharing values after handshake are symmetric +* Added a test to check that Peer Sharing values after handshake are symmetric relative to the initiator and responder side. -- Adds cddl specs and tests for `NodeToNodeV_13` and handshake +* Added cddl specs and tests for `NodeToNodeV_13` and handshake + +* Refactored cddl tests for `PeerSharing` to include versioning. ## 0.5.2.0 -- 2023-09-08 diff --git a/ouroboros-network-protocols/test-cddl/Main.hs b/ouroboros-network-protocols/test-cddl/Main.hs index f0af1bc01a9..3c29360d23f 100644 --- a/ouroboros-network-protocols/test-cddl/Main.hs +++ b/ouroboros-network-protocols/test-cddl/Main.hs @@ -112,8 +112,7 @@ import Ouroboros.Network.Protocol.TxSubmission2.Type (TxSubmission2) import qualified Ouroboros.Network.Protocol.TxSubmission2.Type as TxSubmission2 import Network.Socket (SockAddr (..)) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..), - decodeRemoteAddress, encodeRemoteAddress) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..)) import Ouroboros.Network.Protocol.PeerSharing.Codec (codecPeerSharing) import Ouroboros.Network.Protocol.PeerSharing.Test () import Ouroboros.Network.Protocol.PeerSharing.Type @@ -123,6 +122,8 @@ import qualified Ouroboros.Network.Protocol.PeerSharing.Type as PeerSharing import Test.ChainGenerators () import Test.Data.CDDL (Any (..)) +import Ouroboros.Network.PeerSelection.PeerSharing.Codec + (decodeRemoteAddress, encodeRemoteAddress) import Test.QuickCheck hiding (Result (..)) import Test.QuickCheck.Instances.ByteString () import Test.Tasty (TestTree, adjustOption, defaultMain, testGroup) @@ -153,7 +154,8 @@ tests CDDLSpecs { cddlChainSync , cddlHandshakeNodeToNodeV11ToV12 , cddlHandshakeNodeToNodeV13ToLast , cddlHandshakeNodeToClient - , cddlPeerSharing + , cddlPeerSharingNodeToNodeV11ToV12 + , cddlPeerSharingNodeToNodeV13ToLast , cddlNodeToNodeVersionDataV7To10 , cddlNodeToNodeVersionDataV11ToV12 , cddlNodeToNodeVersionDataV13ToLast @@ -194,8 +196,11 @@ tests CDDLSpecs { cddlChainSync cddlLocalTxMonitor) , testProperty "LocalStateQuery" (prop_encodeLocalStateQuery cddlLocalStateQuery) - , testProperty "PeerSharing " (prop_encodePeerSharing - cddlPeerSharing) + + , testProperty "PeerSharing V11 to V12" (prop_encodePeerSharingV11ToV12 + cddlPeerSharingNodeToNodeV11ToV12) + , testProperty "PeerSharing V13 to Last" (prop_encodePeerSharingV13ToLast + cddlPeerSharingNodeToNodeV13ToLast) , testProperty "NodeToNodeVersionData V7 to V10" (prop_encodeNodeToNodeVersionDataV7To10 cddlNodeToNodeVersionDataV7To10) @@ -232,8 +237,11 @@ tests CDDLSpecs { cddlChainSync cddlLocalTxMonitor) , testCase "LocalStateQuery" (unit_decodeLocalStateQuery cddlLocalStateQuery) - , testCase "PeerSharing" (unit_decodePeerSharing - cddlPeerSharing) + + , testCase "PeerSharing V11 to V12" (unit_decodePeerSharingV11ToV12 + cddlPeerSharingNodeToNodeV11ToV12) + , testCase "PeerSharing V13 to Last" (unit_decodePeerSharingV13ToLast + cddlPeerSharingNodeToNodeV13ToLast) , testCase "NodeToNodeVersionData V7 to V10" (unit_decodeNodeToNodeVersionData cddlNodeToNodeVersionDataV7To10) @@ -262,7 +270,9 @@ data CDDLSpecs = CDDLSpecs { LocalTxSubmission.Reject), cddlLocalTxMonitor :: CDDLSpec (LocalTxMonitor TxId Tx SlotNo), cddlLocalStateQuery :: CDDLSpec (LocalStateQuery Block BlockPoint Query), - cddlPeerSharing :: CDDLSpec (PeerSharing.PeerSharing SockAddr), + + cddlPeerSharingNodeToNodeV11ToV12 :: CDDLSpec (PeerSharing.PeerSharing SockAddr), + cddlPeerSharingNodeToNodeV13ToLast :: CDDLSpec (PeerSharing.PeerSharing SockAddr), cddlNodeToNodeVersionDataV7To10 :: CDDLSpec NodeToNodeVersionData, cddlNodeToNodeVersionDataV11ToV12 :: CDDLSpec NodeToNodeVersionData, @@ -287,7 +297,9 @@ readCDDLSpecs = do localTxSubmission <- BL.readFile (dir "local-tx-submission.cddl") localTxMonitor <- BL.readFile (dir "local-tx-monitor.cddl") localStateQuery <- BL.readFile (dir "local-state-query.cddl") - peerSharing <- BL.readFile (dir "peer-sharing.cddl") + + peerSharingNodeToNodeV11ToV12 <- BL.readFile (dir "peer-sharing-v11-12.cddl") + peerSharingNodeToNodeV13ToLast <- BL.readFile (dir "peer-sharing-v13.cddl") nodeToNodeVersionDataV7To10 <- BL.readFile (dir "node-to-node-version-data.cddl") nodeToNodeVersionDataV11ToV12 <- BL.readFile (dir "node-to-node-version-data-v11-12.cddl") @@ -312,8 +324,11 @@ readCDDLSpecs = do <> common, cddlLocalStateQuery = CDDLSpec $ localStateQuery <> common, - cddlPeerSharing = CDDLSpec $ peerSharing - <> common, + + cddlPeerSharingNodeToNodeV11ToV12 = CDDLSpec $ peerSharingNodeToNodeV11ToV12 + <> common, + cddlPeerSharingNodeToNodeV13ToLast = CDDLSpec $ peerSharingNodeToNodeV13ToLast + <> common, cddlNodeToNodeVersionDataV7To10 = CDDLSpec nodeToNodeVersionDataV7To10, cddlNodeToNodeVersionDataV11ToV12 = CDDLSpec nodeToNodeVersionDataV11ToV12, @@ -707,12 +722,21 @@ instance Arbitrary SockAddr where <*> arbitrary ] -prop_encodePeerSharing +prop_encodePeerSharingV11ToV12 + :: CDDLSpec (PeerSharing.PeerSharing SockAddr) + -> NtNVersionV11ToV12 + -> AnyMessageAndAgency (PeerSharing.PeerSharing SockAddr) + -> Property +prop_encodePeerSharingV11ToV12 spec (NtNVersionV11ToV12 ntnVersion) = + validateEncoder spec (codecPeerSharing (encodeRemoteAddress ntnVersion) (decodeRemoteAddress ntnVersion)) + +prop_encodePeerSharingV13ToLast :: CDDLSpec (PeerSharing.PeerSharing SockAddr) + -> NtNVersionV13ToLast -> AnyMessageAndAgency (PeerSharing.PeerSharing SockAddr) -> Property -prop_encodePeerSharing spec = - validateEncoder spec (codecPeerSharing encodeRemoteAddress decodeRemoteAddress) +prop_encodePeerSharingV13ToLast spec (NtNVersionV13ToLast ntnVersion) = + validateEncoder spec (codecPeerSharing (encodeRemoteAddress ntnVersion) (decodeRemoteAddress ntnVersion)) newtype NtNVersionV7To10 = NtNVersionV7To10 NodeToNodeVersion deriving Show @@ -1043,12 +1067,25 @@ unit_decodeLocalStateQuery spec = ] 100 -unit_decodePeerSharing +unit_decodePeerSharingV11ToV12 :: CDDLSpec (PeerSharing.PeerSharing SockAddr) -> Assertion -unit_decodePeerSharing spec = +unit_decodePeerSharingV11ToV12 spec = + forM_ [NodeToNodeV_11 .. NodeToNodeV_12] $ \v -> + validateDecoder Nothing + spec (codecPeerSharing (encodeRemoteAddress v) (decodeRemoteAddress v)) + [ SomeAgency $ ClientAgency TokIdle + , SomeAgency $ ServerAgency TokBusy + ] + 100 + +unit_decodePeerSharingV13ToLast + :: CDDLSpec (PeerSharing.PeerSharing SockAddr) + -> Assertion +unit_decodePeerSharingV13ToLast spec = + forM_ [NodeToNodeV_13 ..] $ \v -> validateDecoder Nothing - spec (codecPeerSharing encodeRemoteAddress decodeRemoteAddress) + spec (codecPeerSharing (encodeRemoteAddress v) (decodeRemoteAddress v)) [ SomeAgency $ ClientAgency TokIdle , SomeAgency $ ServerAgency TokBusy ] diff --git a/ouroboros-network-protocols/test-cddl/specs/peer-sharing-v11-12.cddl b/ouroboros-network-protocols/test-cddl/specs/peer-sharing-v11-12.cddl new file mode 100644 index 00000000000..b46706211be --- /dev/null +++ b/ouroboros-network-protocols/test-cddl/specs/peer-sharing-v11-12.cddl @@ -0,0 +1,22 @@ +; +; Peer Sharing MiniProtocol +; + +peerSharingMessage = msgShareRequest + / msgSharePeers + / msgDone + +msgShareRequest = [0, byte] +msgSharePeers = [1, peerAddresses] +msgDone = [2] + +peerAddresses = [* peerAddress] + +byte = 0..255 + +peerAddress = [0, word32, portNumber] ; ipv4 + portNumber + / [1, word32, word32, word32, word32, flowInfo, scopeId, portNumber] ; ipv6 + portNumber + +portNumber = word16 +flowInfo = word32 +scopeId = word32 diff --git a/ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl b/ouroboros-network-protocols/test-cddl/specs/peer-sharing-v13.cddl similarity index 100% rename from ouroboros-network-protocols/test-cddl/specs/peer-sharing.cddl rename to ouroboros-network-protocols/test-cddl/specs/peer-sharing-v13.cddl diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs index ca79691426a..48da639d024 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs @@ -1015,11 +1015,8 @@ prop_peerSharing_symmetric createChannels codec versionDataCodec clientVersions ) | v == v' , v >= NodeToNodeV_13 -> counterexample - ( "VersionNumber: " ++ show v ++ "\n" - ++ "Client Result:\n" ++ show clientResult ++ "\n" - ++ "Server Result:\n" ++ show serverResult - ) - $ clientResult == serverResult + ("VersionNumber: " ++ show v) + $ clientResult === serverResult | v == v' , v < NodeToNodeV_13 -> property True | otherwise -> counterexample "Version mismatch" False diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md index 34269b91063..9b6dee3e67d 100644 --- a/ouroboros-network/CHANGELOG.md +++ b/ouroboros-network/CHANGELOG.md @@ -8,6 +8,16 @@ * Update types to accommodate `PeerSharing` data type changes. * Fix PeerSharing IPv6 enc/decoding +* Introduce NodeToNodeVersion 13 +* Update types to accommodate `PeerSharing` data type changes: + * `PeerSharingPrivate` got removed and hence, handshake is now symmetric, + fixing issue [#4642](https://github.com/input-output-hk/ouroboros-network/issues/4642) + * This implies that newer peer sharing node versions will see older + version's `PeerSharingPrivate` as `PeerSharingEnabled`. So older version + node's should not rely on `PeerSharingPrivate` semantics from newer version + honest nodes. + +* Changed encoding of IPv6 addresses sent over `PeerSharing` mini-protocol. ## 0.9.2.0 -- 2023-10-26 diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs index 089df3c5a86..1c95ea6ee33 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs @@ -1,6 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuantifiedConstraints #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -53,6 +54,7 @@ import Data.IP (IP (..)) import Data.Map (Map) import Data.Set (Set) import qualified Data.Set as Set +import Data.Text (Text) import qualified Data.Text as Text import Data.Void (Void) import System.Random (StdGen, split) @@ -377,13 +379,13 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = PeerSharingEnabled -> 1 in CBOR.TList [CBOR.TBool True, CBOR.TInt peerSharing] - toPeerSharing :: Int -> PeerSharing - toPeerSharing 0 = PeerSharingDisabled - toPeerSharing 1 = PeerSharingEnabled - toPeerSharing _ = error "toPeerSharing: out of bounds" + toPeerSharing :: Int -> Either Text PeerSharing + toPeerSharing 0 = Right PeerSharingDisabled + toPeerSharing 1 = Right PeerSharingEnabled + toPeerSharing _ = Left "toPeerSharing: out of bounds" - decodeData _ (CBOR.TList [CBOR.TBool False, CBOR.TInt a]) = Right (NtNVersionData InitiatorOnlyDiffusionMode (toPeerSharing a)) - decodeData _ (CBOR.TList [CBOR.TBool True, CBOR.TInt a]) = Right (NtNVersionData InitiatorAndResponderDiffusionMode (toPeerSharing a)) + decodeData _ (CBOR.TList [CBOR.TBool False, CBOR.TInt a]) = NtNVersionData InitiatorOnlyDiffusionMode <$> (toPeerSharing a) + decodeData _ (CBOR.TList [CBOR.TBool True, CBOR.TInt a]) = NtNVersionData InitiatorAndResponderDiffusionMode <$> (toPeerSharing a) decodeData _ _ = Left (Text.pack "unversionedDataCodec: unexpected term") args :: Diff.Arguments (NtNFD m) NtNAddr (NtCFD m) NtCAddr diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index ee8ad9cd65e..b8fd901e5fa 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs @@ -74,8 +74,7 @@ import Test.Ouroboros.Network.PeerSelection.PeerGraph import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer, IsLedgerPeer) import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise) -import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing, - combinePeerSharing) +import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing) import Ouroboros.Network.PeerSelection.Types (PeerStatus (..)) import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount, PeerSharingResult (..)) @@ -392,7 +391,7 @@ mockPeerSelectionActions' tracer let !conns' = Map.insert peeraddr conn conns writeTVar connsVar conns' remotePeerSharing <- stepScriptSTM' peerSharingScript - return (PeerConn peeraddr (combinePeerSharing peerSharing remotePeerSharing) conn) + return (PeerConn peeraddr (peerSharing <> remotePeerSharing) conn) _ <- async $ -- monitoring loop which does asynchronous demotions. It will terminate -- as soon as either of the events: diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs index cd537c81f41..f660f3a427a 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs @@ -2099,13 +2099,14 @@ prop_diffusion_target_active_local_above defaultBearerInfo diffScript = demotionOpportunitiesIgnoredTooLong :: Signal (Set NtNAddr) demotionOpportunitiesIgnoredTooLong = Signal.keyedTimeoutTruncated - 53 -- seconds + 100 -- seconds id demotionOpportunities in counterexample - ("\nSignal key: (local peers, active peers, " ++ + ("\nSignal key: (local peers, active peers, is alive " ++ "demotion opportunities, ignored too long)") $ + counterexample (intercalate "\n" $ map show $ Signal.eventsToList events) $ signalProperty 20 show (\(_,_,_,_,toolong) -> Set.null toolong) diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs index 54b5983daf7..08aac3f982b 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs @@ -59,7 +59,7 @@ belowTarget actions } } -- Only start Peer Sharing request if PeerSharing was enabled - | peerSharing /= PeerSharingDisabled + | PeerSharingEnabled <- peerSharing -- Are we under target for number of known peers? , numKnownPeers < targetNumberOfKnownPeers diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs index aab6bdb5c5d..e8498186616 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/PeerStateActions.hs @@ -456,8 +456,8 @@ instance (Show peerAddr, Show versionData) "PeerConnectionHandle " ++ show pchConnectionId ++ " " ++ show pchVersionData pchPeerSharing :: (versionData -> PeerSharing) - -> PeerConnectionHandle muxMode responderCtx peerAddr versionData bytes m a b - -> PeerSharing + -> PeerConnectionHandle muxMode responderCtx peerAddr versionData bytes m a b + -> PeerSharing pchPeerSharing f = f . pchVersionData -- From 5d4ca6313839311d248926c31a34c812fb10fbf0 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Tue, 31 Oct 2023 15:30:28 +0000 Subject: [PATCH 4/4] Addressed review comments --- ouroboros-network-api/CHANGELOG.md | 2 +- .../PeerSelection/PeerSharing/Codec.hs | 16 ++++++++-------- ouroboros-network-protocols/CHANGELOG.md | 6 +++--- .../Network/Protocol/Handshake/Test.hs | 2 ++ ouroboros-network/CHANGELOG.md | 14 +++++++------- .../Test/Ouroboros/Network/Diffusion/Node.hs | 19 ++++++++----------- 6 files changed, 29 insertions(+), 30 deletions(-) diff --git a/ouroboros-network-api/CHANGELOG.md b/ouroboros-network-api/CHANGELOG.md index 7e944f15d23..2e6a5f6f046 100644 --- a/ouroboros-network-api/CHANGELOG.md +++ b/ouroboros-network-api/CHANGELOG.md @@ -4,7 +4,7 @@ ### Breaking changes -* Remote `PeerSharingPrivate` option from the `PeerSharing` data type. +* Remove `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 diff --git a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs index 6fcb6ca71bb..3e3b3ae5457 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing/Codec.hs @@ -48,14 +48,14 @@ encodeRemoteAddress ntnVersion sockAddr <> CBOR.encodeWord32 w <> encodePortNumber pn 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 + <> CBOR.encodeWord 1 + <> CBOR.encodeWord32 w1 + <> CBOR.encodeWord32 w2 + <> CBOR.encodeWord32 w3 + <> CBOR.encodeWord32 w4 + <> CBOR.encodeWord32 fi + <> CBOR.encodeWord32 si + <> encodePortNumber pn SockAddrUnix _ -> error "Should never be encoding a SockAddrUnix!" -- | This decoder should be faithful to the PeerSharing diff --git a/ouroboros-network-protocols/CHANGELOG.md b/ouroboros-network-protocols/CHANGELOG.md index 0aabf13656f..80d628fe35c 100644 --- a/ouroboros-network-protocols/CHANGELOG.md +++ b/ouroboros-network-protocols/CHANGELOG.md @@ -13,14 +13,14 @@ ### Non-breaking changes * Improved cdd specs by using `any` (PR #4638) -* Add a 3673s timeout to chainsync's StIdle state. -* Add a 97s timeout to keepalive's StClient state. +* Added a 3673s timeout to chainsync's StIdle state. +* Added a 97s timeout to keepalive's StClient state. * Added a test to check that Peer Sharing values after handshake are symmetric relative to the initiator and responder side. * Added cddl specs and tests for `NodeToNodeV_13` and handshake -* Refactored cddl tests for `PeerSharing` to include versioning. +* Refactored cddl tests for `PeerSharing` to take into account versioning. ## 0.5.2.0 -- 2023-09-08 diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs index 48da639d024..b4e26c7de49 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs @@ -1010,6 +1010,8 @@ prop_peerSharing_symmetric createChannels codec versionDataCodec clientVersions queryVersion serverVersions) pure $ case (clientRes, serverRes) of + -- TODO: make this return ArbitraryNodeToNodeVersionData rather than a pair + -- of NodeToNodeVersionData ( Right (HandshakeNegotiationResult _ v (ArbitraryNodeToNodeVersionData clientResult)) , Right (HandshakeNegotiationResult _ v' (ArbitraryNodeToNodeVersionData serverResult)) ) | v == v' diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md index 9b6dee3e67d..0dd4fe6924a 100644 --- a/ouroboros-network/CHANGELOG.md +++ b/ouroboros-network/CHANGELOG.md @@ -6,10 +6,10 @@ ### Non-breaking changes -* Update types to accommodate `PeerSharing` data type changes. -* Fix PeerSharing IPv6 enc/decoding +* Updated types to accommodate `PeerSharing` data type changes. +* Fixed PeerSharing IPv6 enc/decoding * Introduce NodeToNodeVersion 13 -* Update types to accommodate `PeerSharing` data type changes: +* Updated types to accommodate `PeerSharing` data type changes: * `PeerSharingPrivate` got removed and hence, handshake is now symmetric, fixing issue [#4642](https://github.com/input-output-hk/ouroboros-network/issues/4642) * This implies that newer peer sharing node versions will see older @@ -25,11 +25,11 @@ ### Non-breaking changes -* Update KeepAlive client to collect a rtt sample for the first packet. +* Updated KeepAlive client to collect a rtt sample for the first packet. * Less aggresive churning of established and known peers. -* Add peer sharing to wireshark dissector. -* Adds ledger peers to diffusion simulation -* Fix diffusion tests. +* Added peer sharing to wireshark dissector. +* Added ledger peers to diffusion simulation +* Fixed diffusion tests. * `demo-chain-sync`: added option parser, added new options. * Lifted `chainGenerator` to be `Infinite`. * Strengthened precondition in `pickPeers` to check that the peers to be picked diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs index 1c95ea6ee33..29f180ef60b 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs @@ -367,17 +367,14 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = ntnUnversionedDataCodec = VersionDataCodec { encodeData, decodeData } where encodeData _ NtNVersionData { ntnDiffusionMode, ntnPeerSharing } = - case ntnDiffusionMode of - InitiatorOnlyDiffusionMode -> - let peerSharing = case ntnPeerSharing of - PeerSharingDisabled -> 0 - PeerSharingEnabled -> 1 - in CBOR.TList [CBOR.TBool False, CBOR.TInt peerSharing] - InitiatorAndResponderDiffusionMode -> - let peerSharing = case ntnPeerSharing of - PeerSharingDisabled -> 0 - PeerSharingEnabled -> 1 - in CBOR.TList [CBOR.TBool True, CBOR.TInt peerSharing] + let peerSharing = case ntnPeerSharing of + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1 + in case ntnDiffusionMode of + InitiatorOnlyDiffusionMode -> + CBOR.TList [CBOR.TBool False, CBOR.TInt peerSharing] + InitiatorAndResponderDiffusionMode -> + CBOR.TList [CBOR.TBool True, CBOR.TInt peerSharing] toPeerSharing :: Int -> Either Text PeerSharing toPeerSharing 0 = Right PeerSharingDisabled