11{-# LANGUAGE BangPatterns #-}
22{-# LANGUAGE CPP #-}
3+ {-# LANGUAGE DeriveGeneric #-}
4+ {-# LANGUAGE DerivingStrategies #-}
5+ {-# LANGUAGE DerivingVia #-}
36{-# LANGUAGE FlexibleContexts #-}
47{-# LANGUAGE LambdaCase #-}
58{-# LANGUAGE NamedFieldPuns #-}
@@ -30,6 +33,8 @@ import Control.Monad.Class.MonadTimer.SI
3033import Control.Tracer (Tracer , traceWith )
3134import Data.Functor (void , ($>) )
3235import Data.Monoid.Synchronisation (FirstToFinish (.. ))
36+ import GHC.Generics (Generic )
37+ import Quiet (Quiet (.. ))
3338import System.Random
3439
3540import Cardano.Network.ConsensusMode (ConsensusMode (.. ))
@@ -46,9 +51,15 @@ import Ouroboros.Network.PeerSelection.Governor.Types hiding (targets)
4651import Ouroboros.Network.PeerSelection.LedgerPeers.Type
4752import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency (.. ))
4853
49- data ChurnMode = ChurnModeBulkSync
50- | ChurnModeNormal
51- deriving Show
54+ -- | Churn mode is set by `churn` and available in peer selection policy. It
55+ -- follows `FetchMode`, thus it's a newtype wrapper.
56+ --
57+ -- It is shared using its own `TVar` to make sure the value available in peer
58+ -- selection policy is consistent with the value available in churn actions.
59+ --
60+ newtype ChurnMode = ChurnMode { getFetchMode :: FetchMode }
61+ deriving stock Generic
62+ deriving Show via Quiet ChurnMode
5263
5364newtype TraceChurnMode = TraceChurnMode ChurnMode
5465 deriving Show
@@ -65,11 +76,14 @@ data ExtraArguments m =
6576 , tracerChurnMode :: Tracer m TraceChurnMode
6677 }
6778
68- -- | Tag indicating churning approach
69- -- There are three syncing methods that networking layer supports, the legacy
70- -- method with or without bootstrap peers, and the Genesis method that relies
71- -- on chain skipping optimization courtesy of consensus, which also provides
7279
80+ -- | Tag indicating churning approach.
81+ --
82+ -- There are three syncing methods supported by ouroboros-network:
83+ --
84+ -- * the legacy method (praos mode) without bootstrap peers,
85+ -- * bootstrap peers, and
86+ -- * the Genesis method which is using it's own targets for syncing.
7387--
7488data ChurnRegime = ChurnDefault
7589 -- ^ tag to use Praos targets when caught up, or Genesis
@@ -91,13 +105,13 @@ getPeerSelectionTargets consensus lsj deadlineTargets syncTargets =
91105 (GenesisMode , TooOld ) -> syncTargets
92106 _otherwise -> deadlineTargets
93107
94- pickChurnRegime :: ConsensusMode -> ChurnMode -> UseBootstrapPeers -> ChurnRegime
95- pickChurnRegime consensus churn ubp =
96- case (churn, ubp, consensus ) of
97- (ChurnModeNormal , _, _) -> ChurnDefault
98- (_, _, GenesisMode ) -> ChurnDefault
99- (ChurnModeBulkSync , UseBootstrapPeers _, _ ) -> ChurnBootstrapPraosSync
100- (ChurnModeBulkSync , _, _ ) -> ChurnPraosSync
108+ pickChurnRegime :: ChurnMode -> UseBootstrapPeers -> ChurnRegime
109+ pickChurnRegime churn bootstrap =
110+ case (churn, bootstrap ) of
111+ (ChurnMode GenesisFetchMode , _) -> ChurnDefault
112+ (ChurnMode ( PraosFetchMode FetchModeDeadline ), _) -> ChurnDefault
113+ (ChurnMode ( PraosFetchMode FetchModeBulkSync ), DontUseBootstrapPeers ) -> ChurnPraosSync
114+ (ChurnMode ( PraosFetchMode FetchModeBulkSync ), UseBootstrapPeers {} ) -> ChurnBootstrapPraosSync
101115
102116-- | Churn governor.
103117--
@@ -183,11 +197,7 @@ peerChurnGovernor PeerChurnArgs {
183197 where
184198 updateChurnMode :: STM m ChurnMode
185199 updateChurnMode = do
186- fm <- readFetchMode
187- let mode = case fm of
188- PraosFetchMode FetchModeDeadline -> ChurnModeNormal
189- PraosFetchMode FetchModeBulkSync -> ChurnModeBulkSync
190- FetchModeGenesis -> ChurnModeBulkSync
200+ mode <- ChurnMode <$> readFetchMode
191201 writeTVar churnModeVar mode
192202 return mode
193203
@@ -213,7 +223,7 @@ peerChurnGovernor PeerChurnArgs {
213223 churnMode <- updateChurnMode
214224 ltt <- getLocalRootHotTarget
215225 lsj <- getLedgerStateJudgement
216- regime <- pickChurnRegime consensusMode churnMode <$> getUseBootstrapPeers
226+ regime <- pickChurnRegime churnMode <$> getUseBootstrapPeers
217227 let targets = getPeerSelectionTargets consensusMode lsj
218228 peerSelectionTargets
219229 genesisPeerSelectionTargets
0 commit comments