Skip to content

Commit 132a7f8

Browse files
authored
Merge pull request #4962 from IntersectMBO/coot/churnmode
ChurnMode refactored
2 parents ad18746 + e57cc30 commit 132a7f8

12 files changed

Lines changed: 117 additions & 39 deletions

File tree

cardano-diffusion/api/lib/Cardano/Network/FetchMode.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,6 @@ mkReadFetchMode consensusMode getLedgerStateJudgement getFetchMode =
2828
case consensusMode of
2929
GenesisMode -> getLedgerStateJudgement <&> \case
3030
YoungEnough -> PraosFetchMode FetchModeDeadline
31-
TooOld -> FetchModeGenesis
31+
TooOld -> GenesisFetchMode
3232
PraosMode -> PraosFetchMode <$> getFetchMode
3333

cardano-diffusion/cardano-diffusion.cabal

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -189,6 +189,7 @@ library
189189
network ^>=3.2.7,
190190
network-mux,
191191
ouroboros-network:{ouroboros-network, api, framework, protocols} >=1.0.0.0 && <1.2.0.0,
192+
quiet,
192193
random ^>=1.3,
193194
typed-protocols:{typed-protocols, stateful} ^>=1.2,
194195

Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
For top level release notes, leave all the headers commented out.
6+
-->
7+
8+
### Breaking
9+
10+
- `ChurnMode` is now a newtype wrapper around `FetchMode`.
11+
12+
<!--
13+
### Non-Breaking
14+
15+
- A bullet item for the Non-Breaking category.
16+
17+
-->
18+
<!--
19+
### Patch
20+
21+
- A bullet item for the Patch category.
22+
23+
-->

cardano-diffusion/lib/Cardano/Network/Diffusion/Policies.hs

Lines changed: 8 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,7 @@ module Cardano.Network.Diffusion.Policies where
55

66
import Control.Concurrent.Class.MonadSTM.Strict
77

8+
import Cardano.Network.FetchMode (FetchMode (..), PraosFetchMode (..))
89
import Cardano.Network.PeerSelection.Churn (ChurnMode (..))
910
import Data.List (sortOn)
1011
import Data.Map.Strict qualified as Map
@@ -33,13 +34,18 @@ simpleChurnModePeerSelectionPolicy rngVar getChurnMode metrics =
3334
hotDemotionPolicy _ _ _ available pickNum = do
3435
mode <- getChurnMode
3536
scores <- case mode of
36-
ChurnModeNormal -> do
37+
ChurnMode (PraosFetchMode FetchModeDeadline) -> do
3738
jpm <- joinedPeerMetricAt metrics
3839
hup <- upstreamyness metrics
3940
bup <- fetchynessBlocks metrics
4041
return $ Map.unionWith (+) hup bup `optionalMerge` jpm
4142

42-
ChurnModeBulkSync -> do
43+
ChurnMode (PraosFetchMode FetchModeBulkSync) -> do
44+
jpm <- joinedPeerMetricAt metrics
45+
bup <- fetchynessBytes metrics
46+
return $ bup `optionalMerge` jpm
47+
48+
ChurnMode GenesisFetchMode -> do
4349
jpm <- joinedPeerMetricAt metrics
4450
bup <- fetchynessBytes metrics
4551
return $ bup `optionalMerge` jpm

cardano-diffusion/lib/Cardano/Network/PeerSelection/Churn.hs

Lines changed: 30 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,8 @@
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
3033
import Control.Tracer (Tracer, traceWith)
3134
import Data.Functor (void, ($>))
3235
import Data.Monoid.Synchronisation (FirstToFinish (..))
36+
import GHC.Generics (Generic)
37+
import Quiet (Quiet (..))
3338
import System.Random
3439

3540
import Cardano.Network.ConsensusMode (ConsensusMode (..))
@@ -46,9 +51,15 @@ import Ouroboros.Network.PeerSelection.Governor.Types hiding (targets)
4651
import Ouroboros.Network.PeerSelection.LedgerPeers.Type
4752
import 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

5364
newtype 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
--
7488
data 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

cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Policies.hs

Lines changed: 21 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -23,14 +23,16 @@ import System.Random
2323

2424
import NoThunks.Class.Orphans ()
2525

26+
import Cardano.Network.Diffusion.Policies (simpleChurnModePeerSelectionPolicy)
27+
import Cardano.Network.FetchMode
28+
import Cardano.Network.PeerSelection.Churn (ChurnMode (..))
2629
import Cardano.Slotting.Slot (SlotNo (..))
30+
2731
import Ouroboros.Network.PeerSelection (PeerSource (..))
2832
import Ouroboros.Network.PeerSelection.Governor
2933
import Ouroboros.Network.PeerSelection.PeerMetric
3034
import Ouroboros.Network.SizeInBytes
3135

32-
import Cardano.Network.Diffusion.Policies (simpleChurnModePeerSelectionPolicy)
33-
import Cardano.Network.PeerSelection.Churn (ChurnMode (..))
3436
import Test.QuickCheck
3537
import Test.Tasty (TestTree, testGroup)
3638
import Test.Tasty.QuickCheck (testProperty)
@@ -84,8 +86,19 @@ instance Arbitrary ArbitraryDemotion where
8486
newtype ArbitraryChurnMode = ArbitraryChurnMode ChurnMode deriving Show
8587

8688
instance Arbitrary ArbitraryChurnMode where
87-
arbitrary = ArbitraryChurnMode <$>
88-
elements [ChurnModeNormal, ChurnModeBulkSync]
89+
arbitrary = ArbitraryChurnMode . ChurnMode <$>
90+
elements [ PraosFetchMode FetchModeDeadline
91+
, PraosFetchMode FetchModeBulkSync
92+
, GenesisFetchMode
93+
]
94+
shrink (ArbitraryChurnMode (ChurnMode GenesisFetchMode)) =
95+
[ ArbitraryChurnMode (ChurnMode (PraosFetchMode FetchModeDeadline))
96+
, ArbitraryChurnMode (ChurnMode (PraosFetchMode FetchModeBulkSync))
97+
]
98+
shrink (ArbitraryChurnMode (ChurnMode (PraosFetchMode FetchModeDeadline))) =
99+
[ArbitraryChurnMode (ChurnMode (PraosFetchMode FetchModeBulkSync))]
100+
shrink (ArbitraryChurnMode (ChurnMode (PraosFetchMode FetchModeBulkSync))) =
101+
[]
89102

90103
instance Arbitrary ArbitraryPolicyArguments where
91104
arbitrary = do
@@ -179,11 +192,13 @@ prop_hotToWarmM ArbitraryPolicyArguments{..} seed = do
179192
-> m Property
180193
noneWorse metrics pickedSet = do
181194
scores <- atomically $ case apaChurnMode of
182-
ChurnModeNormal -> do
195+
ChurnMode (PraosFetchMode FetchModeDeadline) -> do
183196
hup <- upstreamyness metrics
184197
bup <- fetchynessBlocks metrics
185198
return $ Map.unionWith (+) hup bup
186-
ChurnModeBulkSync ->
199+
ChurnMode (PraosFetchMode FetchModeBulkSync) ->
200+
fetchynessBytes metrics
201+
ChurnMode GenesisFetchMode ->
187202
fetchynessBytes metrics
188203
let (picked, notPicked) = Map.partitionWithKey fn scores
189204
maxPicked = maximum $ Map.elems picked

cardano-diffusion/tests/lib/Test/Cardano/Network/Diffusion/Testnet/Simulation.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1195,7 +1195,7 @@ diffusionSimulationM
11951195
ledgerPeersVar <- initScript' ledgerPeers
11961196
onlyOutboundConnectionsStateVar <- newTVarIO UntrustedState
11971197
useBootstrapPeersScriptVar <- newTVarIO bootstrapPeers
1198-
churnModeVar <- newTVarIO ChurnModeNormal
1198+
churnModeVar <- newTVarIO (ChurnMode (PraosFetchMode FetchModeDeadline))
11991199
peerMetrics <- newPeerMetric PeerMetricsConfiguration { maxEntriesToTrack = 180 }
12001200
policyStdGenVar <- newTVarIO (mkStdGen 12)
12011201
duplicateTxVar <- LazySTM.newTVarIO []

ouroboros-network/api/lib/Ouroboros/Network/BlockFetch/ConsensusInterface.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ data PraosFetchMode =
5555
deriving (Eq, Show)
5656

5757
-- | The fetch mode that the block fetch logic should use.
58-
data FetchMode = FetchModeGenesis | PraosFetchMode PraosFetchMode
58+
data FetchMode = GenesisFetchMode | PraosFetchMode PraosFetchMode
5959
deriving (Eq, Show)
6060

6161
-- | The consensus layer functionality that the block fetch logic requires.
Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
<!--
2+
A new scriv changelog fragment.
3+
4+
Uncomment the section that is right (remove the HTML comment wrapper).
5+
For top level release notes, leave all the headers commented out.
6+
-->
7+
8+
### Breaking
9+
10+
- Renamed `FetchModeGenesis` as `GenesisFetchMode`.
11+
12+
<!--
13+
### Non-Breaking
14+
15+
- A bullet item for the Non-Breaking category.
16+
17+
-->
18+
<!--
19+
### Patch
20+
21+
- A bullet item for the Patch category.
22+
23+
-->

ouroboros-network/lib/Ouroboros/Network/BlockFetch/Decision/Genesis.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -521,7 +521,7 @@ selectThePeer
521521
go grossRequest (c@(candidate, peerInfo) : xs) = do
522522
if grossRequest `requestHeadInCandidate` candidate then do
523523
tell $ DList.fromList
524-
[(FetchDeclineConcurrencyLimit FetchModeGenesis 1, pInfo)
524+
[(FetchDeclineConcurrencyLimit GenesisFetchMode 1, pInfo)
525525
| (_, pInfo) <- xs
526526
]
527527
pure (Just c)

0 commit comments

Comments
 (0)