From 84317e90cf83d4f5ec86e17052c7715d9d1363c9 Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Tue, 26 Sep 2023 15:20:15 +0100 Subject: [PATCH] Address review comments --- ouroboros-network-api/CHANGELOG.md | 8 +- .../Ouroboros/Network/NodeToNode/Version.hs | 102 +++++++++++++++++- .../Network/PeerSelection/PeerSharing.hs | 93 +++++----------- .../Network/ConnectionManager/Core.hs | 2 +- .../Network/Protocol/Handshake/Unversioned.hs | 20 ++-- ouroboros-network-protocols/CHANGELOG.md | 6 +- ouroboros-network-protocols/test-cddl/Main.hs | 70 +++++++++--- .../test-cddl/specs/peer-sharing-v11-12.cddl | 22 ++++ ...eer-sharing.cddl => peer-sharing-v13.cddl} | 0 .../Network/Protocol/Handshake/Test.hs | 18 +--- .../Test/Ouroboros/Network/Diffusion/Node.hs | 14 +-- .../Network/PeerSelection/MockEnvironment.hs | 5 +- .../src/Ouroboros/Network/Diffusion/P2P.hs | 2 +- .../Network/PeerSelection/PeerStateActions.hs | 4 +- 14 files changed, 238 insertions(+), 128 deletions(-) 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/ouroboros-network-api/CHANGELOG.md b/ouroboros-network-api/CHANGELOG.md index 4e646b84bfe..fdedc65d323 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/src/Ouroboros/Network/NodeToNode/Version.hs b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs index 1e712eb05f7..3ea2ec4083e 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/NodeToNode/Version.hs @@ -7,6 +7,10 @@ module Ouroboros.Network.NodeToNode.Version , ConnectionMode (..) , nodeToNodeVersionCodec , nodeToNodeCodecCBORTerm + , encodePortNumber + , decodePortNumber + , encodeRemoteAddress + , decodeRemoteAddress , isPipeliningEnabled ) where @@ -14,6 +18,8 @@ import Data.Text (Text) import qualified Data.Text as T import Data.Typeable (Typeable) +import qualified Codec.CBOR.Decoding as CBOR +import qualified Codec.CBOR.Encoding as CBOR import qualified Codec.CBOR.Term as CBOR import Ouroboros.Network.BlockFetch.ConsensusInterface @@ -23,9 +29,9 @@ 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 (..)) +import Network.Socket (PortNumber, SockAddr (..)) -- | Enumeration of node to node protocol versions. -- @@ -62,7 +68,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 +140,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 @@ -268,6 +273,93 @@ nodeToNodeCodecCBORTerm version data ConnectionMode = UnidirectionalMode | DuplexMode +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 +-- +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 fi (w1, w2, w3, w4) si) + _ -> fail ("Serialise.decode.SockAddr unexpected tok " ++ show tok) + -- | 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..643b85e90a8 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerSharing.hs @@ -1,23 +1,14 @@ {-# 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 @@ -32,69 +23,41 @@ 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 +-- 'PeerSharingEnabled' is the unit 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 + (<>) = combinePeerSharing --- | 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 + +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 + diff --git a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs index 718f123b562..14d8a42b1ff 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/ConnectionManager/Core.hs @@ -1817,11 +1817,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 4b77fc1c810..83975ff6095 100644 --- a/ouroboros-network-protocols/CHANGELOG.md +++ b/ouroboros-network-protocols/CHANGELOG.md @@ -10,9 +10,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 +* 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 +* Adds 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 271ffc18167..abbcc00ee08 100644 --- a/ouroboros-network-protocols/test-cddl/Main.hs +++ b/ouroboros-network-protocols/test-cddl/Main.hs @@ -64,6 +64,7 @@ import Ouroboros.Network.NodeToClient.Version (NodeToClientVersion, NodeToClientVersionData (..), nodeToClientCodecCBORTerm) import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..), NodeToNodeVersion (..), NodeToNodeVersionData (..), + decodeRemoteAddress, encodeRemoteAddress, nodeToNodeCodecCBORTerm) import qualified Ouroboros.Network.NodeToClient.Version as NtCVersion @@ -112,8 +113,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 @@ -153,7 +153,8 @@ tests CDDLSpecs { cddlChainSync , cddlHandshakeNodeToNodeV11ToV12 , cddlHandshakeNodeToNodeV13ToLast , cddlHandshakeNodeToClient - , cddlPeerSharing + , cddlPeerSharingNodeToNodeV11ToV12 + , cddlPeerSharingNodeToNodeV13ToLast , cddlNodeToNodeVersionDataV7To10 , cddlNodeToNodeVersionDataV11ToV12 , cddlNodeToNodeVersionDataV13ToLast @@ -194,8 +195,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 +236,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 +269,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 +296,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 +323,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 +721,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 +1066,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 8141e4b7e99..d91a1cccea7 100644 --- a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs +++ b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/Handshake/Test.hs @@ -1018,25 +1018,17 @@ 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_11 , v <= NodeToNodeV_12 -> let (ArbitraryNodeToNodeVersionData clientData) = versionData $ getVersions clientVersions Map.! v (ArbitraryNodeToNodeVersionData serverData) = versionData $ getVersions serverVersions Map.! v in counterexample - ( "VersionNumber: " ++ show v ++ "\n" - ++ "Client data:\n" ++ show clientData ++ "\n" - ++ "Server data:\n" ++ show serverData ++ "\n" - ++ "Client Result:\n" ++ show clientResult ++ "\n" - ++ "Server Result:\n" ++ show serverResult - ) - $ peerSharing clientData == peerSharing clientResult - && peerSharing serverData == peerSharing serverResult + ("VersionNumber: " ++ show v ++ "\n") + $ peerSharing clientData === peerSharing clientResult + .&&. peerSharing serverData === peerSharing serverResult | v < NodeToNodeV_11 -> property True | otherwise -> counterexample "Version mismatch" False (Right _, Left _) -> counterexample "Acceptance mismatch" False 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 089df3c5a86..1c95ea6ee33 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests/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/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index 603148a16a6..7a13b828be9 100644 --- a/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/sim-tests/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs @@ -74,8 +74,7 @@ import Test.Ouroboros.Network.ShrinkCarefully 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 (..)) @@ -391,7 +390,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/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs index 2f019461583..3a26c35b20b 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -6,7 +6,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TypeOperators #-} +{-# LANGUAGE TypeOperators #-} #if !defined(mingw32_HOST_OS) #define POSIX 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 --