From e241bcec40d2f68f205a152b72329593d724e23b Mon Sep 17 00:00:00 2001 From: Armando Santos Date: Thu, 12 Jan 2023 17:53:02 +0000 Subject: [PATCH] Added Light Peer Sharing Added a Control Channel between the Inbound Governor and the OutboundGovernor. Reading from this channel is abstracted as a PeerSelectionAction. When the InboundGovernor receives an Inbound NewConnection it will write the address and PeerSharing Willingness information to the Channel. --- .../demo/connection-manager.hs | 5 ++ .../src/Ouroboros/Network/InboundGovernor.hs | 20 ++++++-- .../Network/Protocol/Handshake/Unversioned.hs | 28 +++++++---- .../src/Ouroboros/Network/Server2.hs | 15 ++++++ .../test/Test/Ouroboros/Network/Server2.hs | 7 ++- .../src/Ouroboros/Network/Diffusion/P2P.hs | 23 +++++++-- .../Network/PeerSelection/Governor.hs | 9 ++-- .../Network/PeerSelection/Governor/Monitor.hs | 31 ++++++++++++ .../Network/PeerSelection/Governor/Types.hs | 3 ++ .../Ouroboros/Network/PeerSelection/Simple.hs | 4 ++ .../Test/Ouroboros/Network/PeerSelection.hs | 48 ++++++++++--------- .../Network/PeerSelection/MockEnvironment.hs | 11 +++-- .../test/Test/Ouroboros/Network/Testnet.hs | 2 + 13 files changed, 155 insertions(+), 51 deletions(-) diff --git a/ouroboros-network-framework/demo/connection-manager.hs b/ouroboros-network-framework/demo/connection-manager.hs index 53987ce4dd1..71a466b087a 100644 --- a/ouroboros-network-framework/demo/connection-manager.hs +++ b/ouroboros-network-framework/demo/connection-manager.hs @@ -63,6 +63,8 @@ import qualified Ouroboros.Network.InboundGovernor.ControlChannel as Server import Ouroboros.Network.IOManager import Ouroboros.Network.Mux import Ouroboros.Network.MuxMode +import Ouroboros.Network.PeerSelection.PeerSharing.Type + (PeerSharing (..)) import Ouroboros.Network.Protocol.Handshake import Ouroboros.Network.Protocol.Handshake.Codec (timeLimitsHandshake) @@ -207,6 +209,7 @@ withBidirectionalConnectionManager snocket socket k = do mainThreadId <- myThreadId inbgovControlChannel <- Server.newControlChannel + outgovControlChannel <- Server.newControlChannel -- as in the 'withInitiatorOnlyConnectionManager' we use a `StrictTVar` to -- pass list of requests, but since we are also interested in the results we -- need to have multable cells to pass the accumulators around. @@ -272,6 +275,8 @@ withBidirectionalConnectionManager snocket socket serverConnectionManager = connectionManager, serverInboundIdleTimeout = Just protocolIdleTimeout, serverControlChannel = inbgovControlChannel, + governorControlChannel = outgovControlChannel, + getPeerSharing = \_ -> NoPeerSharing, serverObservableStateVar = observableStateVar } ) diff --git a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs index 9fc4e70f972..7446a378786 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/InboundGovernor.hs @@ -60,11 +60,12 @@ import Ouroboros.Network.ConnectionId (ConnectionId (..)) import Ouroboros.Network.ConnectionManager.Types hiding (TrUnexpectedlyFalseAssertion) import Ouroboros.Network.InboundGovernor.ControlChannel - (ServerControlChannel) + (GovernorControlChannel, ServerControlChannel) import qualified Ouroboros.Network.InboundGovernor.ControlChannel as ControlChannel import Ouroboros.Network.InboundGovernor.Event import Ouroboros.Network.InboundGovernor.State import Ouroboros.Network.Mux +import Ouroboros.Network.PeerSelection.PeerSharing.Type (PeerSharing) import Ouroboros.Network.Server.RateLimiting @@ -99,13 +100,16 @@ inboundGovernor :: forall (muxMode :: MuxMode) socket peerAddr versionData versi => Tracer m (RemoteTransitionTrace peerAddr) -> Tracer m (InboundGovernorTrace peerAddr) -> ServerControlChannel muxMode peerAddr versionData ByteString m a b + -> GovernorControlChannel peerAddr m + -> (versionData -> PeerSharing) -> Maybe DiffTime -- protocol idle timeout -> MuxConnectionManager muxMode socket peerAddr versionData versionNumber ByteString m a b -> StrictTVar m InboundGovernorObservableState -> m Void -inboundGovernor trTracer tracer serverControlChannel inboundIdleTimeout - connectionManager observableStateVar = do +inboundGovernor trTracer tracer serverControlChannel governorControlChannel + getPeerSharing inboundIdleTimeout connectionManager + observableStateVar = do -- State needs to be a TVar, otherwise, when catching the exception inside -- the loop we do not have access to the most recent version of the state -- and might be truncating transitions. @@ -176,10 +180,18 @@ inboundGovernor trTracer tracer serverControlChannel inboundIdleTimeout provenance connId csDataFlow - (Handle csMux muxBundle _ _)) -> do + (Handle csMux muxBundle _ versionData)) -> do traceWith tracer (TrNewConnection provenance connId) + -- Comunicate this new inbound connection to the Outbound Governor + when (provenance == Inbound) $ + atomically $ + ControlChannel.writeMessage governorControlChannel + ( localAddress connId + , getPeerSharing versionData + ) + igsConnections <- Map.alterF (\case -- connection 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 4520d91c513..e1d5532bd75 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/Protocol/Handshake/Unversioned.hs @@ -26,6 +26,8 @@ import Network.TypedProtocol.Codec import Ouroboros.Network.CodecCBORTerm import Ouroboros.Network.ConnectionManager.Types (DataFlow (..)) +import Ouroboros.Network.PeerSelection.PeerSharing.Type + (PeerSharing (..)) import Ouroboros.Network.Protocol.Handshake.Codec import Ouroboros.Network.Protocol.Handshake.Type import Ouroboros.Network.Protocol.Handshake.Version @@ -70,24 +72,32 @@ unversionedProtocol = simpleSingletonVersions UnversionedProtocol UnversionedPro -- | Alternative for 'UnversionedProtocolData' which contains 'DataFlow'. -- -newtype DataFlowProtocolData = - DataFlowProtocolData { getProtocolDataFlow :: DataFlow } +data DataFlowProtocolData = + DataFlowProtocolData { getProtocolDataFlow :: DataFlow, getProtocolPeerSharing :: PeerSharing } deriving (Eq, Show) instance Acceptable DataFlowProtocolData where - acceptableVersion (DataFlowProtocolData local) (DataFlowProtocolData remote) = - Accept (DataFlowProtocolData $ local `min` remote) + acceptableVersion (DataFlowProtocolData local _) (DataFlowProtocolData remote ps) = + Accept (DataFlowProtocolData (local `min` remote) ps) dataFlowProtocolDataCodec :: UnversionedProtocol -> CodecCBORTerm Text DataFlowProtocolData dataFlowProtocolDataCodec _ = CodecCBORTerm {encodeTerm, decodeTerm} where encodeTerm :: DataFlowProtocolData -> CBOR.Term - encodeTerm (DataFlowProtocolData Unidirectional) = CBOR.TBool False - encodeTerm (DataFlowProtocolData Duplex) = CBOR.TBool True + 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] decodeTerm :: CBOR.Term -> Either Text DataFlowProtocolData - decodeTerm (CBOR.TBool False) = Right (DataFlowProtocolData Unidirectional) - decodeTerm (CBOR.TBool True) = Right (DataFlowProtocolData Duplex) + 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 t = Left $ T.pack $ "unexpected term: " ++ show t dataFlowProtocol :: DataFlow @@ -96,7 +106,7 @@ dataFlowProtocol :: DataFlow DataFlowProtocolData app dataFlowProtocol dataFlow = - simpleSingletonVersions UnversionedProtocol (DataFlowProtocolData dataFlow) + simpleSingletonVersions UnversionedProtocol (DataFlowProtocolData dataFlow NoPeerSharing) -- | 'Handshake' codec used in various tests. -- diff --git a/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs index 3f53edf1bf4..a6cd3a904f8 100644 --- a/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs +++ b/ouroboros-network-framework/src/Ouroboros/Network/Server2.hs @@ -55,6 +55,7 @@ import Ouroboros.Network.InboundGovernor import Ouroboros.Network.InboundGovernor.ControlChannel import qualified Ouroboros.Network.InboundGovernor.ControlChannel as ControlChannel import Ouroboros.Network.Mux +import Ouroboros.Network.PeerSelection.PeerSharing.Type (PeerSharing) import Ouroboros.Network.Server.RateLimiting import Ouroboros.Network.Snocket @@ -90,6 +91,16 @@ data ServerArguments (muxMode :: MuxMode) socket peerAddr versionData versionNu serverControlChannel :: ServerControlChannel muxMode peerAddr versionData bytes m a b, + -- | Governor control channel var is passed as an argument; this allows the Server + -- to communicate with the Outbound Governor telling it about new inbound + -- connections to add to the Known Peers Set. + -- + governorControlChannel :: GovernorControlChannel peerAddr m, + + -- | Extract 'PeerSharing' value from 'versionData' + -- + getPeerSharing :: versionData -> PeerSharing, + -- | Observable mutable state. -- serverObservableStateVar :: StrictTVar m InboundGovernorObservableState @@ -141,6 +152,8 @@ run ServerArguments { serverInboundIdleTimeout, serverConnectionManager, serverControlChannel, + governorControlChannel, + getPeerSharing, serverObservableStateVar } = do let sockets = NonEmpty.toList serverSockets @@ -156,6 +169,8 @@ run ServerArguments { inboundGovernor serverTrTracer inboundGovernorTracer serverControlChannel + governorControlChannel + getPeerSharing serverInboundIdleTimeout serverConnectionManager serverObservableStateVar) diff --git a/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs b/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs index 0fea5e401b4..1a749a6f96d 100644 --- a/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs +++ b/ouroboros-network-framework/test/Test/Ouroboros/Network/Server2.hs @@ -357,7 +357,7 @@ withInitiatorOnlyConnectionManager name timeouts trTracer cmTracer snocket local cmAddressType = \_ -> Just IPv4Address, cmSnocket = snocket, cmConfigureSocket = \_ _ -> return (), - connectionDataFlow = \_ (DataFlowProtocolData df) -> df, + connectionDataFlow = \_ (DataFlowProtocolData df _) -> df, cmPrunePolicy = simplePrunePolicy, cmConnectionsLimits = acceptedConnLimit, cmTimeWaitTimeout = tTimeWaitTimeout timeouts, @@ -515,6 +515,7 @@ withBidirectionalConnectionManager name timeouts acceptedConnLimit k = do mainThreadId <- myThreadId inbgovControlChannel <- Server.newControlChannel + outbgovControlChannel <- Server.newControlChannel -- we are not using the randomness observableStateVar <- Server.newObservableStateVarFromSeed 0 let muxTracer = WithName name `contramap` nullTracer -- mux tracer @@ -535,7 +536,7 @@ withBidirectionalConnectionManager name timeouts cmConfigureSocket = \sock _ -> confSock sock, cmTimeWaitTimeout = tTimeWaitTimeout timeouts, cmOutboundIdleTimeout = tOutboundIdleTimeout timeouts, - connectionDataFlow = \_ (DataFlowProtocolData df) -> df, + connectionDataFlow = \_ (DataFlowProtocolData df _) -> df, cmPrunePolicy = simplePrunePolicy, cmConnectionsLimits = acceptedConnLimit } @@ -575,6 +576,8 @@ withBidirectionalConnectionManager name timeouts serverConnectionManager = connectionManager, serverInboundIdleTimeout = Just (tProtocolIdleTimeout timeouts), serverControlChannel = inbgovControlChannel, + governorControlChannel = outbgovControlChannel, + getPeerSharing = \(DataFlowProtocolData _ ps) -> ps, serverObservableStateVar = observableStateVar } ) diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs index 34bab2db4c7..3b4e9870685 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -83,6 +83,8 @@ import Ouroboros.Network.Diffusion.Utils import Ouroboros.Network.ExitPolicy import Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..), RemoteTransitionTrace) +import Ouroboros.Network.InboundGovernor.ControlChannel + (ControlChannel (..), GovernorControlChannel) import Ouroboros.Network.IOManager import Ouroboros.Network.Mux hiding (MiniProtocol (..)) import Ouroboros.Network.MuxMode @@ -101,7 +103,8 @@ import Ouroboros.Network.PeerSelection.Governor.Types import Ouroboros.Network.PeerSelection.LedgerPeers (UseLedgerAfter (..), withLedgerPeers) import Ouroboros.Network.PeerSelection.PeerMetric (PeerMetrics) -import Ouroboros.Network.PeerSelection.PeerSharing.Type (PeerSharing) +import Ouroboros.Network.PeerSelection.PeerSharing.Type + (PeerSharing (..)) import Ouroboros.Network.PeerSelection.PeerStateActions (PeerConnectionHandle, PeerSelectionActionsTrace (..), PeerStateActionsArguments (..), pchPeerSharing, @@ -340,6 +343,7 @@ data ConnectionManagerDataInMode peerAddr versionData m a (mode :: MuxMode) wher CMDInInitiatorResponderMode :: ServerControlChannel InitiatorResponderMode peerAddr versionData ByteString m a () + -> GovernorControlChannel peerAddr m -> StrictTVar m Server.InboundGovernorObservableState -> ConnectionManagerDataInMode peerAddr versionData m a InitiatorResponderMode @@ -710,6 +714,7 @@ runM Interfaces Just $ withLocalSocket tracer diNtcGetFileDescriptor diNtcSnocket localAddr $ \localSocket -> do localControlChannel <- Server.newControlChannel + localGovControlChannel <- Server.newControlChannel localServerStateVar <- Server.newObservableStateVar ntcInbgovRng let localConnectionLimits = AcceptedConnectionsLimit maxBound maxBound 0 @@ -779,6 +784,11 @@ runM Interfaces serverConnectionLimits = localConnectionLimits, serverConnectionManager = localConnectionManager, serverControlChannel = localControlChannel, + governorControlChannel = localGovControlChannel, + -- local thread does not start a Outbound Governor + -- so it doesn't matter what we put here. + -- 'NoPeerSharing' is set for all connections. + getPeerSharing = \_ -> NoPeerSharing, serverObservableStateVar = localServerStateVar }) Async.wait @@ -805,6 +815,7 @@ runM Interfaces HasInitiatorResponder <$> (CMDInInitiatorResponderMode <$> Server.newControlChannel + <*> Server.newControlChannel <*> Server.newObservableStateVar ntnInbgovRng) -- RNGs used for picking random peers from the ledger and for @@ -921,6 +932,7 @@ runM Interfaces daPeerSharing (pchPeerSharing diNtnPeerSharing) (readTVar (getPeerSharingRegistry daPeerSharingRegistry)) + retry -- Will never receive inbound connections peerStateActions requestLedgerPeers $ \localPeerSelectionActionsThread @@ -965,7 +977,7 @@ runM Interfaces -- Run peer selection and the server. -- HasInitiatorResponder - (CMDInInitiatorResponderMode controlChannel observableStateVar) -> do + (CMDInInitiatorResponderMode serverControlChannel governorControlChannel observableStateVar) -> do let connectionManagerArguments :: NodeToNodeConnectionManagerArguments InitiatorResponderMode @@ -1024,7 +1036,7 @@ runM Interfaces connectionManagerArguments connectionHandler classifyHandleError - (InResponderMode controlChannel) + (InResponderMode serverControlChannel) $ \(connectionManager :: NodeToNodeConnectionManager InitiatorResponderMode ntnFd ntnAddr ntnVersionData ntnVersion m a () @@ -1066,6 +1078,7 @@ runM Interfaces daPeerSharing (pchPeerSharing diNtnPeerSharing) (readTVar (getPeerSharingRegistry daPeerSharingRegistry)) + (readMessage governorControlChannel) peerStateActions requestLedgerPeers $ \localPeerRootProviderThread @@ -1109,7 +1122,9 @@ runM Interfaces serverConnectionLimits = daAcceptedConnectionsLimit, serverConnectionManager = connectionManager, serverInboundIdleTimeout = Just daProtocolIdleTimeout, - serverControlChannel = controlChannel, + serverControlChannel = serverControlChannel, + governorControlChannel = governorControlChannel, + getPeerSharing = diNtnPeerSharing, serverObservableStateVar = observableStateVar }) $ \serverThread -> diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs index 2a3e65e145a..bcbdff09fb4 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor.hs @@ -552,10 +552,11 @@ peerSelectionGovernorLoop tracer -> Guarded (STM m) (TimedDecision m peeraddr peerconn) guardedDecisions blockedAt peerSharing st = -- All the alternative potentially-blocking decisions. - Monitor.connections actions st - <> Monitor.jobs jobPool st - <> Monitor.targetPeers actions st - <> Monitor.localRoots actions policy st + Monitor.connections actions st + <> Monitor.jobs jobPool st + <> Monitor.targetPeers actions st + <> Monitor.localRoots actions policy st + <> Monitor.newInboundConnections actions st -- All the alternative non-blocking internal decisions. <> RootPeers.belowTarget actions blockedAt st diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs index 5cc62e4a39a..d83e10c2717 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Monitor.hs @@ -13,6 +13,7 @@ module Ouroboros.Network.PeerSelection.Governor.Monitor , jobs , connections , localRoots + , newInboundConnections ) where import Data.Map.Strict (Map) @@ -38,6 +39,8 @@ import Ouroboros.Network.PeerSelection.Governor.Types hiding import qualified Ouroboros.Network.PeerSelection.KnownPeers as KnownPeers import Ouroboros.Network.PeerSelection.LedgerPeers (LedgerPeer (..)) import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers +import Ouroboros.Network.PeerSelection.PeerAdvertise.Type + (PeerAdvertise (..)) import Ouroboros.Network.PeerSelection.Types @@ -90,6 +93,34 @@ jobs jobPool st = Completion completion <- JobPool.waitForJob jobPool return (completion st) +-- | Monitor new inbound connections +-- +newInboundConnections :: forall m peeraddr peerconn. + (MonadSTM m, Ord peeraddr) + => PeerSelectionActions peeraddr peerconn m + -> PeerSelectionState peeraddr peerconn + -> Guarded (STM m) (TimedDecision m peeraddr peerconn) +newInboundConnections PeerSelectionActions{ + readNewInboundConnection + } + st@PeerSelectionState { + knownPeers + } = + Guarded Nothing $ do + (addr, ps) <- readNewInboundConnection + return $ \_ -> + let -- If peer happens to already be present in the Known Peer set + -- 'insert' is going to do its due diligence before adding. + newEntry = Map.singleton addr (Just ps, DoAdvertisePeer, IsNotLedgerPeer) + knownPeers' = KnownPeers.insert newEntry knownPeers + in Decision { + decisionTrace = [TraceNewInboundConnection addr ps], + decisionJobs = [], + decisionState = + st { + knownPeers = knownPeers' + } + } -- | Monitor connections. -- diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs index 0ba8750cef9..d39d3231f2a 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -199,6 +199,8 @@ data PeerSelectionActions peeraddr peerconn m = PeerSelectionActions { -- readLocalRootPeers :: STM m [(Int, Map peeraddr PeerAdvertise)], + readNewInboundConnection :: STM m (peeraddr, PeerSharing), + -- | Read the current Peer Sharing willingness value -- -- This value comes from the Node's configuration file. @@ -649,6 +651,7 @@ data TracePeerSelection peeraddr = | TracePeerShareRequests Int Int (Set peeraddr) (Set peeraddr) | TracePeerShareResults [(peeraddr, Either SomeException (PeerSharingResult peeraddr))] --TODO: classify failures | TracePeerShareResultsFiltered [peeraddr] + | TraceNewInboundConnection peeraddr PeerSharing -- | target known peers, actual known peers, selected peer | TraceForgetColdPeers Int Int (Set peeraddr) -- | target established, actual established, selected peers diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Simple.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Simple.hs index 79fbb857539..d9ea1ea92ef 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Simple.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Simple.hs @@ -66,6 +66,8 @@ withPeerSelectionActions -- ^ Extract peer sharing information from peerconn -> STM m (Map peeraddr (PeerSharingController peeraddr m)) -- ^ peer sharing registry + -> STM m (peeraddr, PeerSharing) + -- ^ Read New Inbound Connections -> PeerStateActions peeraddr peerconn m -> (NumberOfPeers -> m (Maybe (Set peeraddr, DiffTime))) -> ( Async m Void @@ -85,6 +87,7 @@ withPeerSelectionActions peerSharing peerConnToPeerSharing readPeerSharingController + readNewInboundConnections peerStateActions getLedgerPeers k = do @@ -92,6 +95,7 @@ withPeerSelectionActions let peerSelectionActions = PeerSelectionActions { readPeerSelectionTargets = readTargets, readLocalRootPeers = toList <$> readTVar localRootsVar, + readNewInboundConnection = readNewInboundConnections, peerSharing, peerConnToPeerSharing, requestPublicRootPeers = requestPublicRootPeers, diff --git a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs index d6d1189d350..8054911f10c 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection.hs @@ -42,7 +42,7 @@ import qualified Data.OrdPSQ as PSQ import System.Random (mkStdGen) import Control.Exception (AssertionFailed (..), catch, evaluate) -import Control.Monad.Class.MonadSTM (STM) +import Control.Monad.Class.MonadSTM (STM, retry) import Control.Monad.Class.MonadTime import Control.Monad.IOSim.Types hiding (STM) import Control.Tracer (Tracer (..)) @@ -571,28 +571,29 @@ traceNum TracePublicRootsFailure{} = 04 traceNum TracePeerShareRequests{} = 05 traceNum TracePeerShareResults{} = 06 traceNum TracePeerShareResultsFiltered{} = 07 -traceNum TraceForgetColdPeers{} = 08 -traceNum TracePromoteColdPeers{} = 09 -traceNum TracePromoteColdLocalPeers{} = 10 -traceNum TracePromoteColdFailed{} = 11 -traceNum TracePromoteColdDone{} = 12 -traceNum TracePromoteWarmPeers{} = 13 -traceNum TracePromoteWarmLocalPeers{} = 14 -traceNum TracePromoteWarmFailed{} = 15 -traceNum TracePromoteWarmDone{} = 16 -traceNum TraceDemoteWarmPeers{} = 17 -traceNum TraceDemoteWarmFailed{} = 18 -traceNum TraceDemoteWarmDone{} = 19 -traceNum TraceDemoteHotPeers{} = 20 -traceNum TraceDemoteLocalHotPeers{} = 21 -traceNum TraceDemoteHotFailed{} = 22 -traceNum TraceDemoteHotDone{} = 23 -traceNum TraceDemoteAsynchronous{} = 24 -traceNum TraceGovernorWakeup{} = 25 -traceNum TraceChurnWait{} = 26 -traceNum TraceChurnMode{} = 27 -traceNum TracePromoteWarmAborted{} = 28 -traceNum TraceDemoteLocalAsynchronous{} = 29 +traceNum TraceNewInboundConnection{} = 08 +traceNum TraceForgetColdPeers{} = 09 +traceNum TracePromoteColdPeers{} = 10 +traceNum TracePromoteColdLocalPeers{} = 11 +traceNum TracePromoteColdFailed{} = 12 +traceNum TracePromoteColdDone{} = 13 +traceNum TracePromoteWarmPeers{} = 14 +traceNum TracePromoteWarmLocalPeers{} = 15 +traceNum TracePromoteWarmFailed{} = 16 +traceNum TracePromoteWarmDone{} = 17 +traceNum TraceDemoteWarmPeers{} = 18 +traceNum TraceDemoteWarmFailed{} = 19 +traceNum TraceDemoteWarmDone{} = 20 +traceNum TraceDemoteHotPeers{} = 21 +traceNum TraceDemoteLocalHotPeers{} = 22 +traceNum TraceDemoteHotFailed{} = 23 +traceNum TraceDemoteHotDone{} = 24 +traceNum TraceDemoteAsynchronous{} = 25 +traceNum TraceGovernorWakeup{} = 26 +traceNum TraceChurnWait{} = 27 +traceNum TraceChurnMode{} = 28 +traceNum TracePromoteWarmAborted{} = 29 +traceNum TraceDemoteLocalAsynchronous{} = 30 allTraceNames :: Map Int String allTraceNames = @@ -2283,6 +2284,7 @@ _governorFindingPublicRoots targetNumberOfRootPeers readDomains peerSharing = requestPeerShare = \_ _ -> return (PeerSharingResult []), peerConnToPeerSharing = \ps -> ps, requestPublicRootPeers = \_ -> return (Map.empty, 0), + readNewInboundConnection = retry, peerStateActions = PeerStateActions { establishPeerConnection = error "establishPeerConnection", monitorPeerConnection = error "monitorPeerConnection", diff --git a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs index a04f1740a1b..c17e28d400e 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/PeerSelection/MockEnvironment.hs @@ -57,11 +57,11 @@ import Ouroboros.Network.PeerSelection.Governor hiding (PeerSelectionState (..)) import qualified Ouroboros.Network.PeerSelection.LocalRootPeers as LocalRootPeers -import Ouroboros.Network.Testing.Data.Script (PickScript, - ScriptDelay (..), TimedScript, arbitraryPickScript, - initScript', interpretPickScript, playTimedScript, - prop_shrink_Script, singletonScript, stepScript, - stepScriptSTM) +import Ouroboros.Network.Testing.Data.Script (NonEmpty (..), + PickScript, Script (..), ScriptDelay (..), TimedScript, + arbitraryPickScript, arbitraryScriptOf, initScript', + interpretPickScript, playTimedScript, prop_shrink_Script, + singletonScript, stepScript) import Ouroboros.Network.Testing.Utils (arbitrarySubset, prop_shrink_nonequal, prop_shrink_valid) @@ -312,6 +312,7 @@ mockPeerSelectionActions' tracer peerConnToPeerSharing = \(PeerConn _ ps _) -> ps, requestPublicRootPeers, readPeerSelectionTargets = readTVar targetsVar, + readNewInboundConnection = retry, requestPeerShare, peerStateActions = PeerStateActions { establishPeerConnection, diff --git a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs index 98454a1c66c..9663bcf11ca 100644 --- a/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs +++ b/ouroboros-network/test/Test/Ouroboros/Network/Testnet.hs @@ -592,6 +592,8 @@ prop_peer_selection_trace_coverage defaultBearerInfo diffScript = "TracePeerShareResults" peerSelectionTraceMap (TracePeerShareResultsFiltered _) = "TracePeerShareResultsFiltered" + peerSelectionTraceMap (TraceNewInboundConnection addr ps) = + "TraceNewInboundConnection " ++ show addr ++ " " ++ show ps peerSelectionTraceMap (TraceForgetColdPeers _ _ _) = "TraceForgetColdPeers" peerSelectionTraceMap (TracePromoteColdPeers _ _ _) =