diff --git a/ouroboros-network/CHANGELOG.md b/ouroboros-network/CHANGELOG.md index 370ac929d50..3bf76abaf1b 100644 --- a/ouroboros-network/CHANGELOG.md +++ b/ouroboros-network/CHANGELOG.md @@ -2,6 +2,14 @@ ## next version +### Breaking changes + +* `newPeerSharingAPI` requires `PublicPeerSelectionState` variable to be passed to it. +* `Diffusion.Arguments` requires `PublicPeerSelectionState`; the integration + code should make sure both `newPeerSharingAPI` and diffusion receives the + same mutable variable. +* `TracePeerShareRequest` also includes the number of requests peers. + ## 0.13.1.0 -- 2023-03-20 ### Breaking changes diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs index d5f51d1f387..34f6e3ea9f3 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs @@ -71,7 +71,8 @@ import Ouroboros.Network.Diffusion qualified as Diff import Ouroboros.Network.Diffusion.P2P qualified as Diff.P2P import Ouroboros.Network.ExitPolicy (RepromoteDelay (..)) import Ouroboros.Network.NodeToNode.Version (DiffusionMode (..)) -import Ouroboros.Network.PeerSelection.Governor (PeerSelectionTargets (..)) +import Ouroboros.Network.PeerSelection.Governor (PeerSelectionTargets (..), + PublicPeerSelectionState (..)) import Ouroboros.Network.PeerSelection.PeerMetric (PeerMetricsConfiguration (..), newPeerMetric) import Ouroboros.Network.Protocol.Handshake (HandshakeArguments (..)) @@ -101,7 +102,6 @@ import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint, import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSLookupType) import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency, WarmValency) -import Ouroboros.Network.PeerSharing (PeerSharingRegistry (PeerSharingRegistry)) import Test.Ouroboros.Network.Diffusion.Node.ChainDB (addBlock, getBlockPointSet) import Test.Ouroboros.Network.Diffusion.Node.MiniProtocols qualified as Node @@ -198,8 +198,6 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = useBootstrapPeersScriptVar <- newTVarIO (aReadUseBootstrapPeers na) peerMetrics <- newPeerMetric PeerMetricsConfiguration { maxEntriesToTrack = 180 } - peerSharingRegistry <- PeerSharingRegistry <$> newTVarIO mempty - let -- diffusion interfaces interfaces :: Diff.P2P.Interfaces (NtNFD m) NtNAddr NtNVersion NtNVersionData (NtCFD m) NtCAddr NtCVersion NtCVersionData @@ -263,7 +261,7 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = -- fetch mode is not used (no block-fetch mini-protocol) , Diff.P2P.daBlockFetchMode = pure FetchModeDeadline , Diff.P2P.daReturnPolicy = \_ -> config_REPROMOTE_DELAY - , Diff.P2P.daPeerSharingRegistry = peerSharingRegistry + , Diff.P2P.daPeerSharingRegistry = nkPeerSharingRegistry nodeKernel } let apps = Node.applications (aDebugTracer na) nodeKernel Node.cborCodecs limits appArgs blockHeader @@ -272,7 +270,8 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = (Diff.P2P.runM interfaces Diff.nullTracers tracersExtra - args (argsExtra useBootstrapPeersScriptVar) apps appsExtra) + (mkArgs (nkPublicPeerSelectionVar nodeKernel)) + (mkArgsExtra useBootstrapPeersScriptVar) apps appsExtra) $ \ diffusionThread -> withAsync (blockFetch nodeKernel) $ \blockFetchLogicThread -> wait diffusionThread @@ -373,18 +372,21 @@ run blockGeneratorArgs limits ni na tracersExtra tracerBlockFetch = 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 - args = Diff.Arguments + mkArgs :: StrictTVar m (PublicPeerSelectionState NtNAddr) + -> Diff.Arguments m (NtNFD m) NtNAddr (NtCFD m) NtCAddr + mkArgs daPublicPeerSelectionVar = Diff.Arguments { Diff.daIPv4Address = Right <$> (ntnToIPv4 . aIPAddress) na , Diff.daIPv6Address = Right <$> (ntnToIPv6 . aIPAddress) na , Diff.daLocalAddress = Nothing , Diff.daAcceptedConnectionsLimit = aAcceptedLimits na , Diff.daMode = aDiffusionMode na + , Diff.daPublicPeerSelectionVar } - argsExtra :: StrictTVar m (Script UseBootstrapPeers) -> Diff.P2P.ArgumentsExtra m - argsExtra ubpVar = Diff.P2P.ArgumentsExtra + mkArgsExtra :: StrictTVar m (Script UseBootstrapPeers) + -> Diff.P2P.ArgumentsExtra m + mkArgsExtra ubpVar = Diff.P2P.ArgumentsExtra { Diff.P2P.daPeerSelectionTargets = aPeerSelectionTargets na , Diff.P2P.daReadLocalRootPeers = aReadLocalRootPeers na , Diff.P2P.daReadPublicRootPeers = aReadPublicRootPeers na diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs index 0d970becbd9..b3ec1c025bb 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/MiniProtocols.hs @@ -564,7 +564,7 @@ applications debugTracer nodeKernel peerSharingInitiator = MiniProtocolCb $ \ ExpandedInitiatorContext { - eicConnectionId = ConnectionId { remoteAddress = them }, + eicConnectionId = connId@ConnectionId { remoteAddress = them }, eicControlMessage = controlMessageSTM } channel @@ -573,7 +573,7 @@ applications debugTracer nodeKernel $ \controller -> do psClient <- peerSharingClient controlMessageSTM controller runPeerWithLimits - nullTracer + ((show . (connId,)) `contramap` debugTracer) peerSharingCodec (peerSharingSizeLimits limits) (peerSharingTimeLimits limits) @@ -583,10 +583,10 @@ applications debugTracer nodeKernel peerSharingResponder :: PeerSharingAPI NtNAddr s m -> MiniProtocolCb (ResponderContext NtNAddr) ByteString m () - peerSharingResponder psAPI = MiniProtocolCb $ \_ctx channel -> do + peerSharingResponder psAPI = MiniProtocolCb $ \ResponderContext { rcConnectionId = connId } channel -> do labelThisThread "PeerSharingServer" runPeerWithLimits - nullTracer + ((show . (connId,)) `contramap` debugTracer) peerSharingCodec (peerSharingSizeLimits limits) (peerSharingTimeLimits limits) diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/NodeKernel.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/NodeKernel.hs index e0b74034a6b..c0781481a0d 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/NodeKernel.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node/NodeKernel.hs @@ -78,6 +78,8 @@ import Codec.CBOR.Decoding qualified as CBOR import Codec.CBOR.Encoding qualified as CBOR import Ouroboros.Network.Mock.Chain (Chain (..)) import Ouroboros.Network.NodeToNode () +import Ouroboros.Network.PeerSelection.Governor (PublicPeerSelectionState, + makePublicPeerSelectionStateVar) import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing) import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint (..)) import Ouroboros.Network.PeerSharing (PeerSharingAPI, PeerSharingRegistry (..), @@ -264,21 +266,27 @@ data NodeKernel header block s m = NodeKernel { nkChainDB :: ChainDB block m, - nkPeerSharingAPI :: PeerSharingAPI NtNAddr s m + nkPeerSharingAPI :: PeerSharingAPI NtNAddr s m, + + nkPublicPeerSelectionVar :: StrictTVar m (PublicPeerSelectionState NtNAddr) } newNodeKernel :: ( MonadSTM m , RandomGen s ) => s -> m (NodeKernel header block s m) -newNodeKernel rng = NodeKernel - <$> newTVarIO Map.empty - <*> newTVarIO (ChainProducerState Chain.Genesis Map.empty 0) - <*> newFetchClientRegistry - <*> newPeerSharingRegistry - <*> ChainDB.newChainDB - <*> newPeerSharingAPI rng ps_POLICY_PEER_SHARE_STICKY_TIME - ps_POLICY_PEER_SHARE_MAX_PEERS +newNodeKernel rng = do + publicStateVar <- makePublicPeerSelectionStateVar + NodeKernel + <$> newTVarIO Map.empty + <*> newTVarIO (ChainProducerState Chain.Genesis Map.empty 0) + <*> newFetchClientRegistry + <*> newPeerSharingRegistry + <*> ChainDB.newChainDB + <*> newPeerSharingAPI publicStateVar rng + ps_POLICY_PEER_SHARE_STICKY_TIME + ps_POLICY_PEER_SHARE_MAX_PEERS + <*> pure publicStateVar -- | Register a new upstream chain-sync client. -- diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs index 494626ce6ce..a052252c66a 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection.hs @@ -1527,7 +1527,7 @@ recentPeerShareActivity d = -- schedule it to be removed again at time d+t. We arrange for the change in -- the recent set to happen after the peer sharing event. go !recentSet !recentPSQ - (E (TS t i) (GovernorEvent (TracePeerShareRequests _ _ _ addrs)) : txs) = + (E (TS t i) (GovernorEvent (TracePeerShareRequests _ _ _ _ addrs)) : txs) = let recentSet' = recentSet <> addrs recentPSQ' = foldl' (\q a -> PSQ.insert a t' () q) recentPSQ addrs t' = d `addTime` t @@ -3331,7 +3331,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains readUseBootstrap DNS.defaultResolvConf readDomains (ioDNSActions LookupReqAAndAAAA) $ \requestPublicRootPeers -> do - publicStateVar <- newTVarIO (emptyPublicPeerSelectionState @SockAddr) + publicStateVar <- makePublicPeerSelectionStateVar debugVar <- newTVarIO $ emptyPeerSelectionState (mkStdGen 42) [] peerSelectionGovernor tracer tracer tracer diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index 487eb7b97c9..623b15860be 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs @@ -205,7 +205,7 @@ runGovernorInMockEnvironment mockEnv = governorAction :: GovernorMockEnvironment -> IOSim s Void governorAction mockEnv = do - publicStateVar <- StrictTVar.newTVarIO emptyPublicPeerSelectionState + publicStateVar <- makePublicPeerSelectionStateVar lsjVar <- playTimedScript (contramap TraceEnvSetLedgerStateJudgement tracerMockEnv) (ledgerStateJudgement mockEnv) usbVar <- playTimedScript (contramap TraceEnvSetUseBootstrapPeers tracerMockEnv) @@ -610,7 +610,7 @@ tracerTracePeerSelection = contramap f tracerTestTraceEvent f a@(TraceBigLedgerPeersResults !_ !_ !_) = GovernorEvent a f a@(TraceBigLedgerPeersFailure !_ !_ !_) = GovernorEvent a f a@(TraceForgetBigLedgerPeers !_ !_ !_) = GovernorEvent a - f a@(TracePeerShareRequests !_ !_ !_ !_) = GovernorEvent a + f a@(TracePeerShareRequests !_ !_ !_ !_ !_) = GovernorEvent a f a@(TracePeerShareResults !_) = GovernorEvent a f a@(TracePeerShareResultsFiltered !_) = GovernorEvent a f a@(TraceKnownInboundConnection !_ !_) = GovernorEvent a diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs index 67e9f418795..30e5b292566 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet.hs @@ -21,6 +21,8 @@ import Control.Monad.Class.MonadTime.SI (DiffTime, Time (Time), addTime, import Control.Monad.IOSim import Data.Bifoldable (bifoldMap) +import Data.Foldable (fold) +import Data.IP qualified as IP import Data.List (find, foldl', intercalate, tails) import Data.List.Trace qualified as Trace import Data.Map (Map) @@ -91,6 +93,7 @@ import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers (TraceLocalRootPeers (..)) import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..), WarmValency (..)) +import Ouroboros.Network.PeerSharing (PeerSharingResult (..)) import Test.Ouroboros.Network.LedgerPeers (LedgerPools (..)) import Ouroboros.Network.PeerSelection.Bootstrap (requiresBootstrapPeers) @@ -105,7 +108,6 @@ tests = , testProperty "diffusionScript command script valid" prop_diffusionScript_commandScript_valid ] -#if !defined(mingw32_HOST_OS) , testProperty "no failure" prop_diffusion_nofail , testProperty "no livelock" @@ -159,8 +161,10 @@ tests = prop_only_bootstrap_peers_in_fallback_state , testProperty "no non trustable peers before caught up state" prop_no_non_trustable_peers_before_caught_up_state -#endif -#if !defined(mingw32_HOST_OS) + , testGroup "Peer Sharing" + [ testProperty "share a peer" + unit_peer_sharing + ] , testGroup "coverage" [ testProperty "server trace coverage" prop_server_trace_coverage @@ -187,7 +191,6 @@ tests = , testProperty "target active root" prop_hot_diffusion_target_active_root ] -#endif ] traceFromList :: [a] -> Trace (SimResult ()) a @@ -2624,10 +2627,10 @@ prop_diffusion_target_active_local_above defaultBearerInfo diffScript = signalProperty 20 show (\(_,_,_,_,toolong) -> Set.null toolong) ((,,,,) <$> (LocalRootPeers.toGroupSets <$> govLocalRootPeersSig) - <*> govActivePeersSig - <*> trIsNodeAlive - <*> demotionOpportunities - <*> demotionOpportunitiesIgnoredTooLong) + <*> govActivePeersSig + <*> trIsNodeAlive + <*> demotionOpportunities + <*> demotionOpportunitiesIgnoredTooLong) -- | A variant of ouroboros-network-framework @@ -3284,6 +3287,145 @@ prop_diffusion_peer_selection_actions_no_dodgy_traces defaultBearerInfo (HotDiff getConnId _ = Nothing +unit_peer_sharing :: Property +unit_peer_sharing = + let sim :: forall s. IOSim s Void + sim = diffusionSimulation (toBearerInfo absNoAttenuation) + script + iosimTracer + trace = take 125000 + . traceEvents + $ runSimTrace sim + + events :: Map NtNAddr [TracePeerSelection NtNAddr] + events = Map.fromList + . map (\as -> case as of + [] -> -- this should be a test failure! + error "invariant violation: no traces for one of the nodes" + WithName { wnName } : _ -> (wnName, mapMaybe (\a -> case a of + DiffusionPeerSelectionTrace b -> Just b + _ -> Nothing) + . map (wtEvent . wnEvent) + $ as)) + $ events' + + events' = + Trace.toList + . splitWithNameTrace + . Trace.fromList () + . fmap snd + . Trace.toList + . fmap (\(WithTime t (WithName name b)) + -> (t, WithName name (WithTime t b))) + . withTimeNameTraceEvents + @DiffusionTestTrace + @NtNAddr + . traceFromList + . fmap (\(t, tid, tl, te) -> SimEvent t tid tl te) + $ trace + + verify :: NtNAddr + -> [TracePeerSelection NtNAddr] + -> AllProperty + verify addr as | addr == ip_2 = + let receivedPeers :: Set NtNAddr + receivedPeers = + fold + . mapMaybe (\case + TracePeerShareResults as' -> Just $ fold [ Set.fromList addrs + | (_, Right (PeerSharingResult addrs)) <- as' + ] + _ -> Nothing) + $ as + in AllProperty $ + counterexample (concat [ show ip_0 + , " is not a member of received peers " + , show receivedPeers + ]) $ + ip_0 `Set.member` receivedPeers + verify _ _ = AllProperty (property True) + + in + -- counterexample (ppEvents trace) $ + counterexample (Map.foldrWithKey (\addr evs s -> concat [ "\n\n===== " + , show addr + , " =====\n\n" + ] + ++ intercalate "\n" (map show evs) + ++ s) "" events) $ + getAllProperty $ Map.foldMapWithKey verify events + where + -- initial topology + -- ip_0 -> ip_1 <- ip_2 + -- target topology + -- ip_0 <-> ip_1 <- ip_2 -> ip_0 + -- e.g. + -- * ip_1 should learn about ip_0 by noticing an inbound connection (light + -- peer sharing), and thus it should be marked as `DoAdvertisePeer` + -- * ip_2 should learn about ip_0 from ip_1 by peer sharing + + ip_0 = TestAddress $ IPAddr (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3000 + -- ra_0 = RelayAccessAddress (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3000 + + ip_1 = TestAddress $ IPAddr (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3001 + ra_1 = RelayAccessAddress (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3001 + + ip_2 = TestAddress $ IPAddr (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3002 + -- ra_2 = RelayAccessAddress (IP.IPv4 (IP.toIPv4 [0,0,0,0])) 3002 + + targets x = PeerSelectionTargets { + targetNumberOfRootPeers = x, + targetNumberOfKnownPeers = x, + targetNumberOfEstablishedPeers = x, + targetNumberOfActivePeers = x, + targetNumberOfKnownBigLedgerPeers = 0, + targetNumberOfEstablishedBigLedgerPeers = 0, + targetNumberOfActiveBigLedgerPeers = 0 + } + + defaultNodeArgs = NodeArgs { + naSeed = 0, + naDiffusionMode = InitiatorAndResponderDiffusionMode, + naMbTime = Nothing, + naPublicRoots = mempty, + naBootstrapPeers = singletonScript DontUseBootstrapPeers, + naAddr = undefined, + naPeerSharing = PeerSharingEnabled, + naLocalRootPeers = undefined, + naLedgerPeers = singletonScript (LedgerPools []), + naLocalSelectionTargets = undefined, + naDNSTimeoutScript = singletonScript (DNSTimeout 300), + naDNSLookupDelayScript = singletonScript (DNSLookupDelay 0.01), + naChainSyncEarlyExit = False, + naChainSyncExitOnBlockNo = Nothing, + naFetchModeScript = singletonScript FetchModeDeadline + } + + script = DiffusionScript + (mainnetSimArgs 3) + (singletonScript (mempty, ShortDelay)) + [ ( defaultNodeArgs { naAddr = ip_0, + naLocalRootPeers = [(1, 1, Map.fromList [(ra_1, (DoNotAdvertisePeer, IsNotTrustable))])], + naLocalSelectionTargets = targets 1 + } + , [JoinNetwork 0] + ) + , ( defaultNodeArgs { naAddr = ip_1, + naLocalRootPeers = [], + naLocalSelectionTargets = targets 2 + } + , [JoinNetwork 0] + ) + , ( defaultNodeArgs { naAddr = ip_2, + naLocalRootPeers = [(1, 1, Map.fromList [(ra_1, (DoNotAdvertisePeer, IsNotTrustable))])], + naLocalSelectionTargets = targets 2 + } + , [JoinNetwork 0] + ) + ] + + + -- | Like `(takeWhile f as, dropWhile f as)` -- splitWhile :: (a -> Bool) -> [a] -> ([a], [a]) diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs index 37ecd8d6efb..a8747cd45fc 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Testnet/Simulation/Node.hs @@ -6,12 +6,12 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} -{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} module Test.Ouroboros.Network.Testnet.Simulation.Node ( SimArgs (..) + , mainnetSimArgs , NodeArgs (..) , ServiceDomainName (..) , DiffusionScript (..) @@ -1184,7 +1184,8 @@ diffusionSimulation , NodeKernel.aTimeWaitTimeout = 30 , NodeKernel.aDNSTimeoutScript = dnsTimeout , NodeKernel.aDNSLookupDelayScript = dnsLookupDelay - , NodeKernel.aDebugTracer = nullTracer + , NodeKernel.aDebugTracer = (\s -> WithTime (Time (-1)) (WithName addr (DiffusionDebugTrace s))) + `contramap` nodeTracer } NodeKernel.run blockGeneratorArgs diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion.hs index 55c858f0f25..8df27acc6e5 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion.hs @@ -19,6 +19,8 @@ module Ouroboros.Network.Diffusion , run -- * Re-exports , P2P.AbstractTransitionTrace + , PublicPeerSelectionState + , makePublicPeerSelectionStateVar ) where import Control.Exception (IOException) @@ -30,6 +32,7 @@ import Ouroboros.Network.NodeToClient (LocalAddress, LocalSocket, NodeToClientVersion, NodeToClientVersionData) import Ouroboros.Network.NodeToNode (NodeToNodeVersion, NodeToNodeVersionData, RemoteAddress) +import Ouroboros.Network.PeerSelection.Governor.Types import Ouroboros.Network.Diffusion.Common as Common import Ouroboros.Network.Diffusion.NonP2P qualified as NonP2P @@ -39,7 +42,6 @@ import Ouroboros.Network.Diffusion.P2P qualified as P2P -- data P2P = P2P | NonP2P - -- | Tracers which depend on p2p mode. -- data ExtraTracers (p2p :: P2P) where @@ -88,6 +90,7 @@ run :: forall (p2p :: P2P) a. IO -> ExtraTracers p2p -> Arguments + IO Socket RemoteAddress LocalSocket LocalAddress -> ExtraArguments p2p IO diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs index 14596be03f1..b69bd29ed85 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/Common.hs @@ -18,6 +18,7 @@ import Data.List.NonEmpty (NonEmpty) import Data.Typeable (Typeable) import Data.Void (Void) +import Control.Concurrent.Class.MonadSTM.Strict import Control.Exception (Exception, SomeException) import Control.Tracer (Tracer, nullTracer) @@ -30,6 +31,7 @@ import Ouroboros.Network.NodeToClient qualified as NodeToClient import Ouroboros.Network.NodeToNode (AcceptedConnectionsLimit, ConnectionId, DiffusionMode) import Ouroboros.Network.NodeToNode qualified as NodeToNode +import Ouroboros.Network.PeerSelection.Governor.Types (PublicPeerSelectionState) import Ouroboros.Network.PeerSelection.LedgerPeers.Type (LedgerPeersConsensusInterface) import Ouroboros.Network.Snocket (FileDescriptor) @@ -117,7 +119,7 @@ nullTracers = Tracers { -- | Common DiffusionArguments interface between P2P and NonP2P -- -data Arguments ntnFd ntnAddr ntcFd ntcAddr = Arguments { +data Arguments m ntnFd ntnAddr ntcFd ntcAddr = Arguments { -- | an @IPv4@ socket ready to accept connections or an @IPv4@ addresses -- daIPv4Address :: Maybe (Either ntnFd ntnAddr) @@ -137,6 +139,13 @@ data Arguments ntnFd ntnAddr ntcFd ntcAddr = Arguments { -- | run in initiator only mode -- , daMode :: DiffusionMode + + -- | public peer selection state + -- + -- It is created outside of diffusion, since it is needed to create some + -- apps (e.g. peer sharing). + -- + , daPublicPeerSelectionVar :: StrictTVar m (PublicPeerSelectionState ntnAddr) } diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/NonP2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/NonP2P.hs index 87d74dece13..77aff40ff8c 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/NonP2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/NonP2P.hs @@ -149,6 +149,7 @@ run IO -> TracersExtra -> Arguments + IO Socket RemoteAddress LocalSocket LocalAddress -> ArgumentsExtra diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs index db600acde20..0733da0940b 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -5,7 +5,6 @@ {-# LANGUAGE KindSignatures #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} @@ -26,6 +25,7 @@ module Ouroboros.Network.Diffusion.P2P , Interfaces (..) , runM , NodeToNodePeerConnectionHandle + -- * Re-exports , AbstractTransitionTrace , RemoteTransitionTrace ) where @@ -104,8 +104,7 @@ import Ouroboros.Network.PeerSelection.Governor.Types (ChurnMode (ChurnModeNormal), DebugPeerSelection (..), PeerSelectionActions, PeerSelectionCounters (..), PeerSelectionPolicy (..), PeerSelectionState, - TracePeerSelection (..), emptyPeerSelectionState, - emptyPublicPeerSelectionState) + TracePeerSelection (..), emptyPeerSelectionState) #ifdef POSIX import Ouroboros.Network.PeerSelection.Governor.Types (makeDebugPeerSelectionState) @@ -561,8 +560,8 @@ runM ntcAddr ntcVersion ntcVersionData resolverError m -> -- | configuration - Arguments ntnFd ntnAddr - ntcFd ntcAddr + Arguments m ntnFd ntnAddr + ntcFd ntcAddr -> -- | p2p configuration ArgumentsExtra m @@ -620,6 +619,7 @@ runM Interfaces , daLocalAddress , daAcceptedConnectionsLimit , daMode = diffusionMode + , daPublicPeerSelectionVar } ArgumentsExtra { daPeerSelectionTargets @@ -807,8 +807,6 @@ runM Interfaces min 2 (targetNumberOfActivePeers daPeerSelectionTargets) } - publicStateVar <- newTVarIO emptyPublicPeerSelectionState - -- Design notes: -- - We split the following code into two parts: -- - Part (a): plumb data flow (in particular arguments and tracersr) @@ -993,15 +991,15 @@ runM Interfaces -> NodeToNodePeerSelectionActions muxMode ntnAddr ntnVersionData m a b -> m Void peerSelectionGovernor' peerSelectionTracer dbgVar peerSelectionActions = - (Governor.peerSelectionGovernor - dtTracePeerSelectionTracer - peerSelectionTracer - dtTracePeerSelectionCounters - fuzzRng - publicStateVar - dbgVar - peerSelectionActions - peerSelectionPolicy) + Governor.peerSelectionGovernor + dtTracePeerSelectionTracer + peerSelectionTracer + dtTracePeerSelectionCounters + fuzzRng + daPublicPeerSelectionVar + dbgVar + peerSelectionActions + peerSelectionPolicy -- -- The peer churn governor: @@ -1123,7 +1121,8 @@ run -> TracersExtra RemoteAddress NodeToNodeVersion NodeToNodeVersionData LocalAddress NodeToClientVersion NodeToClientVersionData IOException IO - -> Arguments Socket RemoteAddress + -> Arguments IO + Socket RemoteAddress LocalSocket LocalAddress -> ArgumentsExtra IO -> Applications diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs index 4ac69602786..dd7dac8ece5 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs @@ -27,10 +27,10 @@ module Ouroboros.Network.PeerSelection.Governor , establishedPeersStatus , PeerSelectionState (..) , PublicPeerSelectionState (..) + , makePublicPeerSelectionStateVar , PeerSelectionCounters (..) , nullPeerSelectionTargets , emptyPeerSelectionState - , emptyPublicPeerSelectionState , ChurnMode (..) ) where @@ -452,7 +452,7 @@ peerSelectionGovernor :: ( Alternative (STM m) -> PeerSelectionActions peeraddr peerconn m -> PeerSelectionPolicy peeraddr m -> m Void -peerSelectionGovernor tracer debugTracer countersTracer fuzzRng stateVar debugStateVar actions policy = +peerSelectionGovernor tracer debugTracer countersTracer fuzzRng publicStateVar debugStateVar actions policy = JobPool.withJobPool $ \jobPool -> do localPeers <- map (\(w, h, _) -> (w, h)) <$> atomically (readLocalRootPeers actions) @@ -460,7 +460,7 @@ peerSelectionGovernor tracer debugTracer countersTracer fuzzRng stateVar debugSt tracer debugTracer countersTracer - stateVar + publicStateVar debugStateVar actions policy @@ -505,7 +505,7 @@ peerSelectionGovernorLoop :: forall m peeraddr peerconn. peerSelectionGovernorLoop tracer debugTracer countersTracer - stateVar + publicStateVar debugStateVar actions policy @@ -519,7 +519,7 @@ peerSelectionGovernorLoop tracer loop !st !dbgUpdateAt = assertPeerSelectionState st $ do -- Update public state using 'toPublicState' to compute available peers -- to share for peer sharing - atomically $ writeTVar stateVar (toPublicState st) + atomically $ writeTVar publicStateVar (toPublicState st) blockedAt <- getMonotonicTime diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs index eb94fa07a67..d84c77b4506 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/KnownPeers.hs @@ -105,6 +105,7 @@ belowTarget actions decisionTrace = [TracePeerShareRequests targetNumberOfKnownPeers numKnownPeers + numPeersToReq availableForPeerShare selectedForPeerShare], decisionState = st { diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs index d46cc13cbd7..b7f75c6fe4e 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -24,13 +24,13 @@ module Ouroboros.Network.PeerSelection.Governor.Types , ChurnMode (..) -- * P2P governor internals , PeerSelectionState (..) + , emptyPeerSelectionState , DebugPeerSelectionState (..) , makeDebugPeerSelectionState - , emptyPeerSelectionState , assertPeerSelectionState , establishedPeersStatus , PublicPeerSelectionState (..) - , emptyPublicPeerSelectionState + , makePublicPeerSelectionStateVar , toPublicState , Guarded (GuardedSkip, Guarded) , Decision (..) @@ -65,6 +65,7 @@ import Control.Monad.Class.MonadSTM import Control.Monad.Class.MonadTime.SI import System.Random (StdGen) +import Control.Concurrent.Class.MonadSTM.Strict import Ouroboros.Network.ExitPolicy import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) import Ouroboros.Network.PeerSelection.LedgerPeers (IsBigLedgerPeer, @@ -542,6 +543,12 @@ emptyPublicPeerSelectionState = availableToShare = mempty } +makePublicPeerSelectionStateVar + :: (MonadSTM m, Ord peeraddr) + => m (StrictTVar m (PublicPeerSelectionState peeraddr)) +makePublicPeerSelectionStateVar = newTVarIO emptyPublicPeerSelectionState + + -- | Convert a 'PeerSelectionState' into a public record accessible by the -- Peer Sharing mechanisms so we can know about which peers are available and -- possibly other needed context. @@ -937,9 +944,9 @@ data TracePeerSelection peeraddr = -- Peer Sharing -- - -- | target known peers, actual known peers, peers available for - -- peer sharing, peers selected for peer sharing - | TracePeerShareRequests Int Int (Set peeraddr) (Set peeraddr) + -- | target known peers, actual known peers, number of peers to request, + -- peers available for peer sharing, peers selected for peer sharing + | TracePeerShareRequests Int Int PeerSharingAmount (Set peeraddr) (Set peeraddr) | TracePeerShareResults [(peeraddr, Either SomeException (PeerSharingResult peeraddr))] --TODO: classify failures | TracePeerShareResultsFiltered [peeraddr] | TraceKnownInboundConnection peeraddr PeerSharing diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSharing.hs b/ouroboros-network/src/Ouroboros/Network/PeerSharing.hs index 14df9e91c6a..088c27401ba 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSharing.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSharing.hs @@ -14,6 +14,8 @@ module Ouroboros.Network.PeerSharing -- * Constants , ps_POLICY_PEER_SHARE_STICKY_TIME , ps_POLICY_PEER_SHARE_MAX_PEERS + -- * Re-exports + , PeerSharingResult (..) ) where import Control.Applicative (Alternative) @@ -30,10 +32,11 @@ import Data.Monoid.Synchronisation (FirstToFinish (..), runFirstToFinish) import Data.Set qualified as Set import Ouroboros.Network.ControlMessage (ControlMessage (..), ControlMessageSTM) import Ouroboros.Network.PeerSelection.Governor.Types (PublicPeerSelectionState, - availableToShare, emptyPublicPeerSelectionState) + availableToShare) import Ouroboros.Network.Protocol.PeerSharing.Client (PeerSharingClient (..)) import Ouroboros.Network.Protocol.PeerSharing.Server (PeerSharingServer (..)) -import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount) +import Ouroboros.Network.Protocol.PeerSharing.Type (PeerSharingAmount, + PeerSharingResult (..)) import System.Random -- | Request and Result queue for the peer sharing client implementation. @@ -157,15 +160,16 @@ ps_POLICY_PEER_SHARE_MAX_PEERS = 10 -- | Create a new PeerSharingAPI -- -newPeerSharingAPI :: ( MonadSTM m - , Ord addr - ) - => s +newPeerSharingAPI :: MonadSTM m + => StrictTVar m (PublicPeerSelectionState addr) + -> s -> DiffTime -> PeerSharingAmount -> m (PeerSharingAPI addr s m) -newPeerSharingAPI rng policyPeerShareStickyTime policyPeerShareMaxPeers = do - publicPeerSelectionStateVar <- newTVarIO emptyPublicPeerSelectionState +newPeerSharingAPI publicPeerSelectionStateVar + rng + policyPeerShareStickyTime + policyPeerShareMaxPeers = do genVar <- newTVarIO rng reSaltAtVar <- newTVarIO (Time 0) return $