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 0a518160db8..a07706eb2e0 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 diff --git a/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs index 920a407f065..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,49 @@ nodeToNodeCodecCBORTerm version InitiatorOnlyDiffusionMode -> True InitiatorAndResponderDiffusionMode -> False) , CBOR.TInt (case peerSharing of - NoPeerSharing -> 0 - PeerSharingPrivate -> 1 - PeerSharingPublic -> 2) + PeerSharingDisabled -> 0 + PeerSharingEnabled -> 1) + , CBOR.TBool query + ] + + decodeTerm :: NodeToNodeVersion -> CBOR.Term -> Either Text NodeToNodeVersionData + decodeTerm _ (CBOR.TList [CBOR.TInt x, CBOR.TBool diffusionMode, CBOR.TInt peerSharing, CBOR.TBool query]) + | x >= 0 + , x <= 0xffffffff + , 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 ] @@ -161,23 +209,27 @@ nodeToNodeCodecCBORTerm version , 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 = case peerSharing of - 0 -> NoPeerSharing - 1 -> PeerSharingPrivate - 2 -> PeerSharingPublic - _ -> error "decodeTerm: impossible happened!", + 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 $ "peerSharing out of bound: " <> show peerSharing + = Left $ T.pack $ "Either peerSharing is out of bound: " <> show peerSharing decodeTerm _ t = Left $ T.pack $ "unknown encoding: " ++ show t in CodecCBORTerm {encodeTerm, decodeTerm = decodeTerm version } @@ -203,7 +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 a0af5ffbd79..abdef8e2bbc 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 39fe073fc86..ecf48e9a587 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 221a7e64315..81ac7af2fa5 100644 --- a/ouroboros-network-protocols/CHANGELOG.md +++ b/ouroboros-network-protocols/CHANGELOG.md @@ -14,6 +14,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 911b3c1f0a6..0444b161be2 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/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/Diffusion/Node.hs index 98d892567bb..089df3c5a86 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs index 354480df28f..4a4cf74279f 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/NodeToNode/Version.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/NodeToNode/Version.hs index ae81c9f1d61..ac0143271ef 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/NodeToNode/Version.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection.hs index 1ede66baaf6..24e404b714f 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/PeerSelection/Instances.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/Instances.hs index 4cbe9c9bd7f..25f4ee5ce4e 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/Instances.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index de5dea6b709..ee8ad9cd65e 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs index e610e4adb58..73a09e218d8 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/PeerGraph.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/Testnet.hs index a482bba6e7f..cd537c81f41 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/Testnet/Simulation/Node.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/Testnet/Simulation/Node.hs index 8ce3e62e52c..fbee2324f3c 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/Testnet/Simulation/Node.hs +++ b/ouroboros-network/sim-tests/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 1f01c36803c..3a26c35b20b 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -447,8 +447,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, @@ -717,7 +717,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 @@ -893,7 +893,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 e20d9a58644..74118c8717e 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