From c017feedad1db47164bb8252700be32967ee72c5 Mon Sep 17 00:00:00 2001 From: Marcin Szamotulski Date: Tue, 10 Dec 2024 11:40:38 +0100 Subject: [PATCH] documentation: improved genesis haddocs There's no in-line way to make subtitles in haddock :/. --- .../Network/BlockFetch/Decision/Genesis.hs | 101 ++++++++++-------- scripts/ci/check-stylish-ignore | 1 + 2 files changed, 59 insertions(+), 43 deletions(-) diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs index 9c0dd41fa2..b314b9c3d8 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs @@ -5,8 +5,56 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +module Ouroboros.Network.BlockFetch.Decision.Genesis + ( -- * Genesis decision logic + -- $genesis-decision-logic --- | Genesis decision logic + -- * About the influence of in-flight requests + -- $in-flight-requests + + -- * Interactions with ChainSync Jumping (CSJ) + -- $chain-sync-jumping + + -- * About the gross request + -- $gross-request + + fetchDecisionsGenesisM + ) where + +import Control.Exception (assert) +import Control.Monad (guard) +import Control.Monad.Class.MonadTime.SI (MonadMonotonicTime (getMonotonicTime), + addTime) +import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT)) +import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell) +import Control.Tracer (Tracer, traceWith) +import Data.Bifunctor (Bifunctor (..), first) +import Data.DList (DList) +import Data.DList qualified as DList +import Data.Foldable (find, toList) +import Data.List qualified as List +import Data.Maybe (maybeToList) +import Data.Sequence (Seq (..), (<|), (><), (|>)) +import Data.Sequence qualified as Sequence +import Data.Set qualified as Set + +import Cardano.Prelude (partitionEithers) + +import Ouroboros.Network.AnchoredFragment (AnchoredFragment) +import Ouroboros.Network.AnchoredFragment qualified as AF +import Ouroboros.Network.Block +import Ouroboros.Network.BlockFetch.ClientState (FetchRequest (..), + PeerFetchInFlight (..), PeersOrder (..)) +import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..), + FetchMode (..)) +import Ouroboros.Network.BlockFetch.DeltaQ (calculatePeerFetchInFlightLimits) + +import Cardano.Slotting.Slot (WithOrigin) +import Ouroboros.Network.BlockFetch.Decision +import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) + + +-- $genesis-decision-logic -- -- This module contains the part of the block fetch decisions process that is -- specific to the bulk sync mode. This logic reuses parts of the logic for the @@ -70,9 +118,9 @@ -- if @inflights(thePeer)@ is empty. -- -- Terminate this iteration. --- --- About the influence of in-flight requests --- ----------------------------------------- + + +-- $in-flight-requests -- -- One can note that in-flight requests are ignored when finding a new peer, but -- considered when crafting the actual request to a chosen peer. This is by @@ -94,9 +142,9 @@ -- transient. Soon enough, @theCandidate@ should be honest (if the consensus -- layer does its job correctly), and there should exist an honest peer ready to -- serve @theCandidate@ promptly. --- --- Interactions with ChainSync Jumping (CSJ) --- ----------------------------------------- + + +-- $chain-sync-jumping -- -- Because we always require our peers to be able to serve a gross request -- with an old block, peers with longer chains have a better chance to pass @@ -109,9 +157,9 @@ -- blocks, it will get multiple opportunities to do so since it will be selected -- as the current peer more often. We therefore rotate the dynamo every time it -- is the current peer and it fails to serve blocks promptly. --- --- About the gross request --- ----------------------- + + +-- $gross-request -- -- We want to select a peer that is able to serve us a batch of oldest blocks -- of @theCandidate@. However, not every peer will be able to deliver these @@ -123,39 +171,6 @@ -- If the peer cannot offer any more blocks after that, it will be rotated out -- soon. -- -module Ouroboros.Network.BlockFetch.Decision.Genesis (fetchDecisionsGenesisM) where - -import Control.Exception (assert) -import Control.Monad (guard) -import Control.Monad.Class.MonadTime.SI (MonadMonotonicTime (getMonotonicTime), - addTime) -import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT)) -import Control.Monad.Trans.Writer.CPS (Writer, runWriter, tell) -import Control.Tracer (Tracer, traceWith) -import Data.Bifunctor (Bifunctor (..), first) -import Data.DList (DList) -import Data.DList qualified as DList -import Data.Foldable (find, toList) -import Data.List qualified as List -import Data.Maybe (maybeToList) -import Data.Sequence (Seq (..), (<|), (><), (|>)) -import Data.Sequence qualified as Sequence -import Data.Set qualified as Set - -import Cardano.Prelude (partitionEithers) - -import Ouroboros.Network.AnchoredFragment (AnchoredFragment) -import Ouroboros.Network.AnchoredFragment qualified as AF -import Ouroboros.Network.Block -import Ouroboros.Network.BlockFetch.ClientState (FetchRequest (..), - PeerFetchInFlight (..), PeersOrder (..)) -import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..), - FetchMode (..)) -import Ouroboros.Network.BlockFetch.DeltaQ (calculatePeerFetchInFlightLimits) - -import Cardano.Slotting.Slot (WithOrigin) -import Ouroboros.Network.BlockFetch.Decision -import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) type WithDeclined peer = Writer (DList (FetchDecline, peer)) diff --git a/scripts/ci/check-stylish-ignore b/scripts/ci/check-stylish-ignore index d5134f69fc..7f0a204497 100644 --- a/scripts/ci/check-stylish-ignore +++ b/scripts/ci/check-stylish-ignore @@ -1,5 +1,6 @@ */Setup.hs ouroboros-network-api/src/Ouroboros/Network/Protocol/Type.hs +ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs ouroboros-network/src/Ouroboros/Network/Diffusion/P2P.hs ouroboros-network/src/Ouroboros/Network/PeerSelection/Governor/Types.hs network-mux/src/Network/Mux/TCPInfo.hs