From a2c183d2c2351557512337c5a54bb33fdbead841 Mon Sep 17 00:00:00 2001 From: Javier Sagredo Date: Mon, 13 Sep 2021 15:15:47 +0200 Subject: [PATCH] Fix some imports here and there --- .../src/Ouroboros/Consensus/Cardano/Node.hs | 1 - .../MiniProtocol/ChainSync/Client.hs | 1 + .../MiniProtocol/ChainSync/Client.hs | 3 +- .../Ouroboros/Consensus/Network/NodeToNode.hs | 4 +- .../src/Ouroboros/Consensus/NodeKernel.hs | 3 +- .../Ouroboros/Consensus/NodeKernel/Genesis.hs | 4 ++ ouroboros-network/demo/chain-sync.hs | 1 + ouroboros-network/ouroboros-network.cabal | 1 + .../src/Ouroboros/Network/AnchoredFragment.hs | 44 +---------------- .../Network/AnchoredFragment/Completeness.hs | 48 +++++++++++++++++++ .../src/Ouroboros/Network/BlockFetch.hs | 4 +- .../src/Ouroboros/Network/BlockFetch/State.hs | 1 + .../Ouroboros/Network/BlockFetch/Examples.hs | 3 +- 13 files changed, 67 insertions(+), 51 deletions(-) create mode 100644 ouroboros-network/src/Ouroboros/Network/AnchoredFragment/Completeness.hs diff --git a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs index c15e05a0fb1..3ea88ff1710 100644 --- a/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs +++ b/ouroboros-consensus-cardano/src/Ouroboros/Consensus/Cardano/Node.hs @@ -94,7 +94,6 @@ import Ouroboros.Consensus.Shelley.ShelleyBased import Ouroboros.Consensus.Cardano.Block import Ouroboros.Consensus.Cardano.CanHardFork import Ouroboros.Consensus.Cardano.ShelleyBased -import qualified Ouroboros.Consensus.HardFork.Combinator as HardForkConsensusConfig {------------------------------------------------------------------------------- SerialiseHFC diff --git a/ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs index 6bb6a906df3..5db7c995888 100644 --- a/ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs +++ b/ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/ChainSync/Client.hs @@ -27,6 +27,7 @@ import Cardano.Crypto.DSIGN.Mock import Ouroboros.Network.AnchoredFragment (AnchoredFragment) import qualified Ouroboros.Network.AnchoredFragment as AF +import qualified Ouroboros.Network.AnchoredFragment.Completeness as AF import Ouroboros.Network.Block (getTipPoint) import Ouroboros.Network.Channel import Ouroboros.Network.Driver diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs b/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs index 5a13dc82e20..dd5f8a240ad 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/MiniProtocol/ChainSync/Client.hs @@ -51,8 +51,9 @@ import NoThunks.Class (unsafeNoThunks) import Network.TypedProtocol.Pipelined import Ouroboros.Network.AnchoredFragment (AnchoredFragment, - AnchoredSeq (..), FragmentCompleteness) + AnchoredSeq (..)) import qualified Ouroboros.Network.AnchoredFragment as AF +import Ouroboros.Network.AnchoredFragment.Completeness as AF import qualified Ouroboros.Network.AnchoredSeq as AS import Ouroboros.Network.Block (Tip (..), castTip, getTipBlockNo) import Ouroboros.Network.Mux (ControlMessage (..), ControlMessageSTM) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs b/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs index 0135e774601..2e5c6eb7d35 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/Network/NodeToNode.hs @@ -42,8 +42,8 @@ import Data.ByteString.Lazy (ByteString) import Data.Map.Strict (Map) import Data.Void (Void) -import Ouroboros.Network.AnchoredFragment (AnchoredFragment, - FragmentCompleteness) +import Ouroboros.Network.AnchoredFragment (AnchoredFragment) +import Ouroboros.Network.AnchoredFragment.Completeness import Ouroboros.Network.Block (Serialised (..), decodePoint, decodeTip, encodePoint, encodeTip) import Ouroboros.Network.BlockFetch diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs index f6571577e94..3bb50b8036e 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel.hs @@ -40,8 +40,9 @@ import System.Random (StdGen) import Control.Tracer import Ouroboros.Network.AnchoredFragment (AnchoredFragment, - AnchoredSeq (..), FragmentCompleteness) + AnchoredSeq (..)) import qualified Ouroboros.Network.AnchoredFragment as AF +import Ouroboros.Network.AnchoredFragment.Completeness import Ouroboros.Network.Block (MaxSlotNo) import Ouroboros.Network.BlockFetch import Ouroboros.Network.NodeToNode (MiniProtocolParameters (..)) diff --git a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel/Genesis.hs b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel/Genesis.hs index 81374e75426..64192c43d70 100644 --- a/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel/Genesis.hs +++ b/ouroboros-consensus/src/Ouroboros/Consensus/NodeKernel/Genesis.hs @@ -20,12 +20,16 @@ import Ouroboros.Consensus.Block.SupportsProtocol import Ouroboros.Consensus.Config.GenesisWindowLength import qualified Ouroboros.Network.AnchoredFragment as AF +import qualified Ouroboros.Network.AnchoredFragment.Completeness as AF import qualified Ouroboros.Network.AnchoredSeq as AS {------------------------------------------------------------------------------- The prefix selection algorithm -------------------------------------------------------------------------------} +-- If we cannot validate the first out-of-window header, still the candidate +-- must be complete. + -- | Process a map of candidates as stated in the prefixSelection chapter of the -- report. processWithPrefixSelection :: diff --git a/ouroboros-network/demo/chain-sync.hs b/ouroboros-network/demo/chain-sync.hs index 1cbe73d70fb..7ea7bfbb5f8 100644 --- a/ouroboros-network/demo/chain-sync.hs +++ b/ouroboros-network/demo/chain-sync.hs @@ -39,6 +39,7 @@ import System.Random import qualified Codec.Serialise as CBOR import qualified Ouroboros.Network.AnchoredFragment as AF +import qualified Ouroboros.Network.AnchoredFragment.Completeness as AF import Ouroboros.Network.Block import qualified Ouroboros.Network.MockChain.Chain as Chain import Ouroboros.Network.Mux diff --git a/ouroboros-network/ouroboros-network.cabal b/ouroboros-network/ouroboros-network.cabal index 3f48f0586b8..04a8794030c 100644 --- a/ouroboros-network/ouroboros-network.cabal +++ b/ouroboros-network/ouroboros-network.cabal @@ -52,6 +52,7 @@ library -- At this experiment/prototype stage everything is exposed. -- This has to be tidied up once the design becomes clear. exposed-modules: Ouroboros.Network.AnchoredFragment + Ouroboros.Network.AnchoredFragment.Completeness Ouroboros.Network.AnchoredSeq Ouroboros.Network.Block Ouroboros.Network.BlockFetch diff --git a/ouroboros-network/src/Ouroboros/Network/AnchoredFragment.hs b/ouroboros-network/src/Ouroboros/Network/AnchoredFragment.hs index ee3e1143c3b..bdf309a93ed 100644 --- a/ouroboros-network/src/Ouroboros/Network/AnchoredFragment.hs +++ b/ouroboros-network/src/Ouroboros/Network/AnchoredFragment.hs @@ -93,10 +93,6 @@ module Ouroboros.Network.AnchoredFragment ( pointOnFragmentSpec, selectPointsSpec, filterWithStopSpec, - - -- * Genesis support - FragmentCompleteness (..), - isFragmentComplete ) where import Prelude hiding (filter, head, last, length, map, null, splitAt) @@ -722,42 +718,4 @@ isPrefixOfByPoints :: -> AnchoredFragment a -> Bool s1 `isPrefixOfByPoints` s2 = - AS.isPrefixOfByPoints anchorPoint blockPoint s1 s2 - -{------------------------------------------------------------------------------- - Fragment completeness --------------------------------------------------------------------------------} --- | BlockFetch and ChainSync operate with 'AnchoredFragment's when dealing with --- candidate chains. For Ouroboros Genesis, we need to know whether or not the --- fragment represents the end of the remote chain, to make judgments about --- whether or not our perceived density is indeed the real density. --- --- Every fragment returned by ChainSync will be coupled with one of these tags, --- specifying if the ChainSync client thinks that the fragment is indeed --- complete. This flag will be used by the prefix selection algorithm to filter --- appropriate candidates to be provided to BlockFetch. -data FragmentCompleteness = FragmentComplete | FragmentIncomplete - deriving (Show, Generic, Eq, NoThunks) - --- | Return a 'AF.FragmentCompleteness' for the given fragment assuming the --- provided tip is the one announced by the remote peer. --- --- This function will return 'Nothing' when the tip is at Genesis but the --- fragment isn't. This should be interpreted in the ChainSync protocol as a --- misbehaving of the server. -isFragmentComplete :: - ( StandardHash blk - , HasHeader blk) - => Tip blk - -> AnchoredFragment blk - -> Maybe FragmentCompleteness -isFragmentComplete TipGenesis theirFrag = - if pointHash (anchorPoint theirFrag) == GenesisHash - then Just FragmentComplete - else Nothing -isFragmentComplete (Tip _ tipHash _) theirFrag = - Just $ case headHash theirFrag of - GenesisHash -> FragmentIncomplete - BlockHash theHeadHash - | theHeadHash == tipHash -> FragmentComplete - | otherwise -> FragmentIncomplete + AS.isPrefixOfByPoints anchorToPoint blockPoint s1 s2 diff --git a/ouroboros-network/src/Ouroboros/Network/AnchoredFragment/Completeness.hs b/ouroboros-network/src/Ouroboros/Network/AnchoredFragment/Completeness.hs new file mode 100644 index 00000000000..e49e8c402b0 --- /dev/null +++ b/ouroboros-network/src/Ouroboros/Network/AnchoredFragment/Completeness.hs @@ -0,0 +1,48 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +-- | + +module Ouroboros.Network.AnchoredFragment.Completeness where + +import Prelude hiding (filter, head, last, length, map, null, splitAt) + +import GHC.Generics (Generic) +import NoThunks.Class (NoThunks) + +import Ouroboros.Network.AnchoredFragment +import Ouroboros.Network.Block + +-- | BlockFetch and ChainSync operate with 'AnchoredFragment's when dealing with +-- candidate chains. For Ouroboros Genesis, we need to know whether or not the +-- fragment represents the end of the remote chain, to make judgments about +-- whether or not our perceived density is indeed the real density. +-- +-- Every fragment returned by ChainSync will be coupled with one of these tags, +-- specifying if the ChainSync client thinks that the fragment is indeed +-- complete. This flag will be used by the prefix selection algorithm to filter +-- appropriate candidates to be provided to BlockFetch. +data FragmentCompleteness = FragmentComplete | FragmentIncomplete + deriving (Show, Generic, Eq, NoThunks) + +-- | Return a 'AF.FragmentCompleteness' for the given fragment assuming the +-- provided tip is the one announced by the remote peer. +-- +-- This function will return 'Nothing' when the tip is at Genesis but the +-- fragment isn't. This should be interpreted in the ChainSync protocol as a +-- misbehaving of the server. +isFragmentComplete :: + ( StandardHash blk + , HasHeader blk) + => Tip blk + -> AnchoredFragment blk + -> Maybe FragmentCompleteness +isFragmentComplete TipGenesis theirFrag = + if pointHash (anchorPoint theirFrag) == GenesisHash + then Just FragmentComplete + else Nothing +isFragmentComplete (Tip _ tipHash _) theirFrag = + Just $ case headHash theirFrag of + GenesisHash -> FragmentIncomplete + BlockHash theHeadHash + | theHeadHash == tipHash -> FragmentComplete + | otherwise -> FragmentIncomplete diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs index 9ed6295dc88..30c75b27811 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch.hs @@ -113,8 +113,8 @@ import Control.Monad.Class.MonadTime import Control.Monad.Class.MonadTimer import Control.Tracer (Tracer) -import Ouroboros.Network.AnchoredFragment (AnchoredFragment, - FragmentCompleteness (..)) +import Ouroboros.Network.AnchoredFragment (AnchoredFragment) +import Ouroboros.Network.AnchoredFragment.Completeness import Ouroboros.Network.Block import Ouroboros.Network.DeltaQ ( SizeInBytes ) diff --git a/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs b/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs index 282d7c53da6..a77fc3cc0fb 100644 --- a/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs +++ b/ouroboros-network/src/Ouroboros/Network/BlockFetch/State.hs @@ -33,6 +33,7 @@ import Control.Tracer (Tracer, traceWith) import Ouroboros.Network.Block import Ouroboros.Network.AnchoredFragment (AnchoredFragment) import qualified Ouroboros.Network.AnchoredFragment as AF +import Ouroboros.Network.AnchoredFragment.Completeness as AF import Ouroboros.Network.BlockFetch.ClientState ( FetchRequest(..) diff --git a/ouroboros-network/test/Ouroboros/Network/BlockFetch/Examples.hs b/ouroboros-network/test/Ouroboros/Network/BlockFetch/Examples.hs index 279fe10f0e5..55a89e6dcb0 100644 --- a/ouroboros-network/test/Ouroboros/Network/BlockFetch/Examples.hs +++ b/ouroboros-network/test/Ouroboros/Network/BlockFetch/Examples.hs @@ -38,6 +38,7 @@ import Control.Tracer (Tracer, contramap, nullTracer) import Ouroboros.Network.AnchoredFragment (AnchoredFragment, anchorPoint) import qualified Ouroboros.Network.AnchoredFragment as AnchoredFragment +import Ouroboros.Network.AnchoredFragment.Completeness import Ouroboros.Network.Block import Network.TypedProtocol.Core @@ -275,7 +276,7 @@ sampleBlockFetchPolicy1 headerFieldsForgeUTCTime blockHeap currentChain candidat readCandidateChains = return $ -- TODO @js: is this okay? - Map.map (, AnchoredFragment.FragmentComplete) candidateChains, + Map.map (, FragmentComplete) candidateChains, readCurrentChain = return currentChain, readFetchMode =