diff --git a/ouroboros-network-api/src/Ouroboros/Network/BlockFetch/ConsensusInterface.hs b/ouroboros-network-api/src/Ouroboros/Network/BlockFetch/ConsensusInterface.hs index cdb1cf22728..111b99229f4 100644 --- a/ouroboros-network-api/src/Ouroboros/Network/BlockFetch/ConsensusInterface.hs +++ b/ouroboros-network-api/src/Ouroboros/Network/BlockFetch/ConsensusInterface.hs @@ -1,7 +1,7 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE RankNTypes #-} {-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE RankNTypes #-} module Ouroboros.Network.BlockFetch.ConsensusInterface ( FetchMode (..) @@ -17,8 +17,8 @@ import Control.Monad.Class.MonadTime (UTCTime) import Control.Monad.Class.MonadTime.SI (Time) import Data.Map.Strict (Map) -import GHC.Stack (HasCallStack) import GHC.Generics (Generic) +import GHC.Stack (HasCallStack) import NoThunks.Class (NoThunks) import Ouroboros.Network.AnchoredFragment (AnchoredFragment) diff --git a/ouroboros-network/demo/chain-sync.hs b/ouroboros-network/demo/chain-sync.hs index 5fb3d0c2497..525c64e7683 100644 --- a/ouroboros-network/demo/chain-sync.hs +++ b/ouroboros-network/demo/chain-sync.hs @@ -76,8 +76,8 @@ import Ouroboros.Network.Protocol.BlockFetch.Type qualified as BlockFetch import Ouroboros.Network.BlockFetch import Ouroboros.Network.BlockFetch.Client import Ouroboros.Network.BlockFetch.ClientRegistry (FetchClientRegistry (..)) -import Ouroboros.Network.BlockFetch.ConsensusInterface - (ChainSelStarvation(..), GenesisFetchMode(..)) +import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..), + GenesisFetchMode (..)) import Ouroboros.Network.DeltaQ (defaultGSV) diff --git a/ouroboros-network/sim-tests-lib/Ouroboros/Network/BlockFetch/Examples.hs b/ouroboros-network/sim-tests-lib/Ouroboros/Network/BlockFetch/Examples.hs index f0d2cffe505..a7ab21fe381 100644 --- a/ouroboros-network/sim-tests-lib/Ouroboros/Network/BlockFetch/Examples.hs +++ b/ouroboros-network/sim-tests-lib/Ouroboros/Network/BlockFetch/Examples.hs @@ -40,13 +40,13 @@ import Ouroboros.Network.Block import Network.TypedProtocol.Core import Network.TypedProtocol.Pipelined -import qualified Ouroboros.Network.AnchoredFragment as AF +import Ouroboros.Network.AnchoredFragment qualified as AF import Ouroboros.Network.ControlMessage (ControlMessageSTM) import Ouroboros.Network.BlockFetch import Ouroboros.Network.BlockFetch.Client -import Ouroboros.Network.BlockFetch.ConsensusInterface - (ChainSelStarvation(..), GenesisFetchMode(..)) +import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..), + GenesisFetchMode (..)) import Ouroboros.Network.Channel import Ouroboros.Network.DeltaQ import Ouroboros.Network.Driver @@ -57,8 +57,8 @@ import Ouroboros.Network.Protocol.BlockFetch.Server import Ouroboros.Network.Protocol.BlockFetch.Type import Ouroboros.Network.Util.ShowProxy -import Ouroboros.Network.Mock.ConcreteBlock import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent) +import Ouroboros.Network.Mock.ConcreteBlock -- | Run a single block fetch protocol until the chain is downloaded. diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/BlockFetch.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/BlockFetch.hs index 3c7eec8baaa..bee421cdcc4 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/BlockFetch.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/BlockFetch.hs @@ -52,8 +52,8 @@ import Ouroboros.Network.Mock.ConcreteBlock import Ouroboros.Network.NodeToNode.Version (isPipeliningEnabled) import Ouroboros.Network.Protocol.BlockFetch.Type (BlockFetch) -import Ouroboros.Network.Testing.Utils import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent) +import Ouroboros.Network.Testing.Utils -- diff --git a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs index 5643514be9f..74c15f1e80e 100644 --- a/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs +++ b/ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Node.hs @@ -66,8 +66,8 @@ import Ouroboros.Network.AnchoredFragment qualified as AF import Ouroboros.Network.Block (MaxSlotNo (..), maxSlotNoFromWithOrigin, pointSlot) import Ouroboros.Network.BlockFetch -import Ouroboros.Network.BlockFetch.ConsensusInterface - (ChainSelStarvation(..), GenesisFetchMode (..)) +import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..), + GenesisFetchMode (..)) import Ouroboros.Network.ConnectionManager.Types (DataFlow (..)) import Ouroboros.Network.Diffusion qualified as Diff import Ouroboros.Network.Diffusion.P2P qualified as Diff.P2P diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs index db03b57b84b..0dd6ac8d3da 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs @@ -124,8 +124,8 @@ import Ouroboros.Network.BlockFetch.ClientRegistry (FetchClientPolicy (..), import Ouroboros.Network.BlockFetch.ConsensusInterface (BlockFetchConsensusInterface (..), FromConsensus (..), WhetherReceivingTentativeBlocks (..)) -import Ouroboros.Network.BlockFetch.State import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent) +import Ouroboros.Network.BlockFetch.State -- | Configuration for FetchDecisionPolicy. @@ -133,13 +133,13 @@ import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent) data BlockFetchConfiguration = BlockFetchConfiguration { -- | Maximum concurrent downloads during bulk syncing. - bfcMaxConcurrencyBulkSync :: !Word, + bfcMaxConcurrencyBulkSync :: !Word, -- | Maximum concurrent downloads during deadline syncing. - bfcMaxConcurrencyDeadline :: !Word, + bfcMaxConcurrencyDeadline :: !Word, -- | Maximum requests in flight per each peer. - bfcMaxRequestsInflight :: !Word, + bfcMaxRequestsInflight :: !Word, -- | Desired interval between calls to fetchLogicIteration -- in Genesis fetch mode @@ -147,13 +147,13 @@ data BlockFetchConfiguration = -- | Desired interval between calls to fetchLogicIteration -- in Praos fetch modes - bfcDecisionLoopIntervalPraos :: !DiffTime, + bfcDecisionLoopIntervalPraos :: !DiffTime, -- | Salt used when comparing peers - bfcSalt :: !Int, + bfcSalt :: !Int, -- | Genesis-specific parameters - bfcGenesisBFConfig :: !GenesisBlockFetchConfiguration + bfcGenesisBFConfig :: !GenesisBlockFetchConfiguration } deriving (Show) diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch/ClientState.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch/ClientState.hs index bb2816abc4c..56ac8af4bb5 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch/ClientState.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch/ClientState.hs @@ -32,7 +32,7 @@ module Ouroboros.Network.BlockFetch.ClientState -- * Ancillary , FromConsensus (..) , WhetherReceivingTentativeBlocks (..) - , PeersOrder(..) + , PeersOrder (..) ) where import Data.List (foldl') @@ -793,10 +793,10 @@ tryReadTMergeVar (TMergeVar v) = tryReadTMVar v data PeersOrder peer = PeersOrder { peersOrderCurrent :: Maybe peer -- ^ The current peer we are fetching from, if there is one. - , peersOrderAll :: Seq peer + , peersOrderAll :: Seq peer -- ^ All the peers, from most preferred to least preferred. -- -- INVARIANT: If there is a current peer, it is always the head of this list. - , peersOrderStart :: Time + , peersOrderStart :: Time -- ^ The time at which we started talking to the current peer. } diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs index d8025611ac3..e53078052e9 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Genesis.hs @@ -1,10 +1,10 @@ -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeOperators #-} -{-# LANGUAGE TupleSections #-} -{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE TypeOperators #-} -- | Genesis decision logic -- @@ -122,35 +122,34 @@ -- If the peer cannot offer any more blocks after that, it will be rotated out -- soon. -- -module Ouroboros.Network.BlockFetch.Decision.Genesis ( - fetchDecisionsGenesisM -) where +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.Class.MonadTime.SI (MonadMonotonicTime (getMonotonicTime), + addTime) import Control.Monad.Trans.Maybe (MaybeT (MaybeT, runMaybeT)) -import Control.Monad.Writer.Strict (Writer, runWriter, MonadWriter (tell)) +import Control.Monad.Writer.Strict (MonadWriter (tell), Writer, runWriter) import Control.Tracer (Tracer, traceWith) -import Data.Bifunctor (first, Bifunctor (..)) -import Data.Foldable (toList) +import Data.Bifunctor (Bifunctor (..), first) import Data.DList (DList) -import qualified Data.DList as DList -import qualified Data.List as List -import Data.Sequence (Seq (..), (><), (<|), (|>)) -import qualified Data.Sequence as Sequence -import qualified Data.Set as Set +import Data.DList qualified as DList +import Data.Foldable (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 qualified Ouroboros.Network.AnchoredFragment as AF +import Ouroboros.Network.AnchoredFragment qualified as AF import Ouroboros.Network.Block -import Ouroboros.Network.BlockFetch.ClientState - (FetchRequest (..), PeersOrder (..), PeerFetchInFlight(..)) +import Ouroboros.Network.BlockFetch.ClientState (FetchRequest (..), + PeerFetchInFlight (..), PeersOrder (..)) +import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation (..)) import Ouroboros.Network.BlockFetch.DeltaQ (calculatePeerFetchInFlightLimits) -import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation(..)) import Ouroboros.Network.BlockFetch.Decision import Ouroboros.Network.BlockFetch.Decision.Trace (TraceDecisionEvent (..)) @@ -242,7 +241,7 @@ fetchDecisionsGenesisM let peersOrderAll' = ( do p <- peersOrderAll case List.find ((p ==) . peerOf) actualPeers of - Just d -> pure d + Just d -> pure d Nothing -> Empty ) >< Sequence.filter ((`notElem` peersOrderAll) . peerOf) actualPeers -- Set the current peer to Nothing if it is not at the front of @@ -269,7 +268,7 @@ fetchDecisionsGenesisM peersOrder@PeersOrder {peersOrderStart, peersOrderCurrent, peersOrderAll} = do lastStarvationTime <- case chainSelStarvation of ChainSelStarvationEndedAt time -> pure time - ChainSelStarvationOngoing -> getMonotonicTime + ChainSelStarvationOngoing -> getMonotonicTime case peersOrderCurrent of Just peer | lastStarvationTime >= addTime bulkSyncGracePeriod peersOrderStart -> do @@ -443,7 +442,7 @@ selectTheCandidate _ : _ -> do let maxChainOn f c0 c1 = case compareCandidateChains (f c0) (f c1) of LT -> c1 - _ -> c0 + _ -> c0 -- maximumBy yields the last element in case of a tie while we -- prefer the first one chainSfx = fst $ diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Trace.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Trace.hs index c1a1b049095..b897282227b 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Trace.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch/Decision/Trace.hs @@ -1,7 +1,7 @@ module Ouroboros.Network.BlockFetch.Decision.Trace where -import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer) import Ouroboros.Network.Block (Point) +import Ouroboros.Network.BlockFetch.ClientState (TraceLabelPeer) import Ouroboros.Network.BlockFetch.Decision (FetchDecision) data TraceDecisionEvent peer header diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs index 38b4aa245e4..75c235a91d6 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs @@ -25,11 +25,11 @@ import Data.Sequence (Seq (Empty)) import Data.Set qualified as Set import Data.Void -import qualified Control.Monad.Class.MonadSTM.Internal as Internal.TVar -import Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked - (newTVarIO, StrictTVar, readTVarIO, writeTVar) +import Control.Concurrent.Class.MonadSTM.Strict.TVar.Checked (StrictTVar, + newTVarIO, readTVarIO, writeTVar) import Control.Exception (assert) import Control.Monad.Class.MonadSTM +import Control.Monad.Class.MonadSTM.Internal qualified as Internal.TVar import Control.Monad.Class.MonadTime.SI import Control.Monad.Class.MonadTimer.SI import Control.Tracer (Tracer, traceWith) @@ -40,16 +40,16 @@ import Ouroboros.Network.Block import Ouroboros.Network.BlockFetch.ClientState (FetchClientStateVars (..), FetchRequest (..), PeerFetchInFlight (..), PeerFetchStatus (..), - TraceFetchClientState (..), TraceLabelPeer (..), addNewFetchRequest, - readFetchClientState, PeersOrder (..)) + PeersOrder (..), TraceFetchClientState (..), TraceLabelPeer (..), + addNewFetchRequest, readFetchClientState) +import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation, + GenesisFetchMode (..)) import Ouroboros.Network.BlockFetch.Decision (FetchDecision, FetchDecisionPolicy (..), FetchDecline (..), FetchMode (..), PeerInfo, fetchDecisions) import Ouroboros.Network.BlockFetch.Decision.Genesis (fetchDecisionsGenesisM) -import Ouroboros.Network.BlockFetch.DeltaQ (PeerGSV (..)) -import Ouroboros.Network.BlockFetch.ConsensusInterface (ChainSelStarvation, - GenesisFetchMode (..)) import Ouroboros.Network.BlockFetch.Decision.Trace +import Ouroboros.Network.BlockFetch.DeltaQ (PeerGSV (..)) fetchLogicIterations :: ( HasHeader header diff --git a/ouroboros-network/src/Ouroboros/Network/Diffusion/Configuration.hs b/ouroboros-network/src/Ouroboros/Network/Diffusion/Configuration.hs index 8787d7e3b04..f733ef52c1b 100644 --- a/ouroboros-network/src/Ouroboros/Network/Diffusion/Configuration.hs +++ b/ouroboros-network/src/Ouroboros/Network/Diffusion/Configuration.hs @@ -31,8 +31,8 @@ module Ouroboros.Network.Diffusion.Configuration import System.Random (randomRIO) -import Ouroboros.Network.BlockFetch - (BlockFetchConfiguration (..), GenesisBlockFetchConfiguration (..)) +import Ouroboros.Network.BlockFetch (BlockFetchConfiguration (..), + GenesisBlockFetchConfiguration (..)) import Ouroboros.Network.ConnectionManager.Core (defaultProtocolIdleTimeout, defaultResetTimeout, defaultTimeWaitTimeout) import Ouroboros.Network.Diffusion (P2P (..))