diff --git a/ouroboros-network/ouroboros-network.cabal b/ouroboros-network/ouroboros-network.cabal index 21a100f95ac..2dffe81ef7b 100644 --- a/ouroboros-network/ouroboros-network.cabal +++ b/ouroboros-network/ouroboros-network.cabal @@ -127,6 +127,7 @@ library nothunks, psqueues >=0.2.3 && <0.3, random, + quiet, cardano-prelude, cardano-slotting, diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Policies.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Policies.hs index 21f92a1dfb7..11913bf317f 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Policies.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Policies.hs @@ -24,6 +24,7 @@ import System.Random import NoThunks.Class.Orphans () import Cardano.Slotting.Slot (SlotNo (..)) +import Ouroboros.Network.BlockFetch.ConsensusInterface (FetchMode (..)) import Ouroboros.Network.Diffusion.Policies import Ouroboros.Network.ExitPolicy (RepromoteDelay (..)) import Ouroboros.Network.PeerSelection.Governor @@ -84,8 +85,12 @@ instance Arbitrary ArbitraryDemotion where newtype ArbitraryChurnMode = ArbitraryChurnMode ChurnMode deriving Show instance Arbitrary ArbitraryChurnMode where - arbitrary = ArbitraryChurnMode <$> - elements [ChurnModeNormal, ChurnModeBulkSync] + arbitrary = ArbitraryChurnMode . ChurnMode <$> + elements [FetchModeDeadline, FetchModeBulkSync] + shrink (ArbitraryChurnMode (ChurnMode FetchModeDeadline)) = + [ArbitraryChurnMode (ChurnMode FetchModeBulkSync)] + shrink (ArbitraryChurnMode (ChurnMode FetchModeBulkSync)) = + [] instance Arbitrary ArbitraryPolicyArguments where arbitrary = do @@ -182,11 +187,11 @@ prop_hotToWarmM ArbitraryPolicyArguments{..} seed = do -> m Property noneWorse metrics pickedSet = do scores <- atomically $ case apaChurnMode of - ChurnModeNormal -> do + ChurnMode FetchModeDeadline -> do hup <- upstreamyness metrics bup <- fetchynessBlocks metrics return $ Map.unionWith (+) hup bup - ChurnModeBulkSync -> + ChurnMode FetchModeBulkSync -> fetchynessBytes metrics let (picked, notPicked) = Map.partitionWithKey fn scores maxPicked = maximum $ Map.elems picked diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs index 9eb7a5960a4..7d11db840e0 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs @@ -103,9 +103,9 @@ import Ouroboros.Network.NodeToNode qualified as NodeToNode import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers) import Ouroboros.Network.PeerSelection.Churn (PeerChurnArgs (..)) import Ouroboros.Network.PeerSelection.Governor qualified as Governor -import Ouroboros.Network.PeerSelection.Governor.Types - (ChurnMode (ChurnModeNormal), ConsensusModePeerTargets (..), - DebugPeerSelection (..), PeerSelectionActions, PeerSelectionCounters, +import Ouroboros.Network.PeerSelection.Governor.Types (ChurnMode (..), + ConsensusModePeerTargets (..), DebugPeerSelection (..), + PeerSelectionActions, PeerSelectionCounters, PeerSelectionInterfaces (..), PeerSelectionPolicy (..), PeerSelectionState, TracePeerSelection (..), emptyPeerSelectionCounters, emptyPeerSelectionState) @@ -828,7 +828,7 @@ runM Interfaces -- demoting/promoting peers. policyRngVar <- newTVarIO policyRng - churnModeVar <- newTVarIO ChurnModeNormal + churnModeVar <- newTVarIO (ChurnMode FetchModeDeadline) localRootsVar <- newTVarIO mempty diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs index d4f6c0a65db..fc3ca0065e7 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/Policies.hs @@ -150,13 +150,13 @@ simplePeerSelectionPolicy rngVar getChurnMode metrics errorDelay = PeerSelection hotDemotionPolicy _ _ _ available pickNum = do mode <- getChurnMode scores <- case mode of - ChurnModeNormal -> do + ChurnMode FetchModeDeadline -> do jpm <- joinedPeerMetricAt metrics hup <- upstreamyness metrics bup <- fetchynessBlocks metrics return $ Map.unionWith (+) hup bup `optionalMerge` jpm - ChurnModeBulkSync -> do + ChurnMode FetchModeBulkSync -> do jpm <- joinedPeerMetricAt metrics bup <- fetchynessBytes metrics return $ bup `optionalMerge` jpm diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs index 2e52cb1f47a..9c2ec2d4112 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Churn.hs @@ -30,7 +30,6 @@ import System.Random import Control.Applicative (Alternative) import Data.Functor (($>)) import Data.Monoid.Synchronisation (FirstToFinish (..)) -import Ouroboros.Network.BlockFetch (FetchMode (..)) import Ouroboros.Network.ConsensusMode (ConsensusMode (..)) import Ouroboros.Network.Diffusion.Policies (churnEstablishConnectionTimeout, closeConnectionTimeout, deactivateTimeout) @@ -40,11 +39,13 @@ import Ouroboros.Network.PeerSelection.LedgerPeers.Type import Ouroboros.Network.PeerSelection.PeerMetric import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (..)) --- | Tag indicating churning approach --- There are three syncing methods that networking layer supports, the legacy --- method with or without bootstrap peers, and the Genesis method that relies --- on chain skipping optimization courtesy of consensus, which also provides - +-- | Tag indicating churning approach. +-- +-- There are three syncing methods supported by ouroboros-network: +-- +-- * the legacy method (praos mode) without bootstrap peers, +-- * bootstrap peers, and +-- * the Genesis method which is using it's own targets for syncing. -- data ChurnRegime = ChurnDefault -- ^ tag to use Praos targets when caught up, or Genesis @@ -64,12 +65,12 @@ getPeerSelectionTargets consensus lsj ConsensusModePeerTargets { _otherwise -> deadlineTargets pickChurnRegime :: ConsensusMode -> ChurnMode -> UseBootstrapPeers -> ChurnRegime -pickChurnRegime consensus churn ubp = - case (churn, ubp, consensus) of - (ChurnModeNormal, _, _) -> ChurnDefault - (_, _, GenesisMode) -> ChurnDefault - (ChurnModeBulkSync, UseBootstrapPeers _, _) -> ChurnBootstrapPraosSync - (ChurnModeBulkSync, _, _) -> ChurnPraosSync +pickChurnRegime consensus churn bootstrap = + case (consensus, churn, bootstrap) of + (GenesisMode, _, _) -> ChurnDefault + (_, ChurnMode FetchModeDeadline, _) -> ChurnDefault + (_, ChurnMode FetchModeBulkSync, DontUseBootstrapPeers) -> ChurnPraosSync + (_, ChurnMode FetchModeBulkSync, UseBootstrapPeers{}) -> ChurnBootstrapPraosSync -- | Facilitates composing updates to various targets via back-to-back pipeline type ModifyPeerSelectionTargets = PeerSelectionTargets -> PeerSelectionTargets @@ -154,10 +155,7 @@ peerChurnGovernor PeerChurnArgs { where updateChurnMode :: STM m ChurnMode updateChurnMode = do - fm <- getFetchMode - let mode = case fm of - FetchModeDeadline -> ChurnModeNormal - FetchModeBulkSync -> ChurnModeBulkSync + mode <- ChurnMode <$> getFetchMode writeTVar churnModeVar mode return mode diff --git a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs index d03d4c710db..e414dde5ddd 100644 --- a/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs +++ b/ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs @@ -1,6 +1,9 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE DerivingVia #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} @@ -33,6 +36,7 @@ module Ouroboros.Network.PeerSelection.Governor.Types , PeerSelectionActions (..) , PeerSelectionInterfaces (..) , ChurnMode (..) + , FetchMode (..) -- * P2P governor internals , PeerSelectionState (..) , emptyPeerSelectionState @@ -133,15 +137,17 @@ import Data.Semigroup (Min (..)) import Data.Set (Set) import Data.Set qualified as Set import GHC.Stack (HasCallStack) +import GHC.Generics (Generic (..)) +import Quiet (Quiet (..)) import Control.Applicative (Alternative) +import Control.Concurrent.Class.MonadSTM.Strict import Control.Concurrent.JobPool (Job) import Control.Exception (Exception (..), SomeException, assert) -import Control.Monad.Class.MonadSTM import Control.Monad.Class.MonadTime.SI import System.Random (StdGen) -import Control.Concurrent.Class.MonadSTM.Strict +import Ouroboros.Network.BlockFetch.ConsensusInterface (FetchMode (..)) import Ouroboros.Network.ConsensusMode import Ouroboros.Network.ExitPolicy import Ouroboros.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..)) @@ -1768,6 +1774,13 @@ data DebugPeerSelection peeraddr where deriving instance (Ord peeraddr, Show peeraddr) => Show (DebugPeerSelection peeraddr) -data ChurnMode = ChurnModeBulkSync - | ChurnModeNormal deriving Show +-- | Churn mode is set by `churn` and available in peer selection policy. It +-- follows `FetchMode`, thus it's a newtype wrapper. +-- +-- It is shared using its own `TVar` to make sure the value available in peer +-- selection policy is consistent with the value available in churn actions. +-- +newtype ChurnMode = ChurnMode { getFetchMode :: FetchMode } + deriving stock Generic + deriving Show via Quiet ChurnMode