Fix some imports here and there

IntersectMBO · Sep 13, 2021 · cb7772f · cb7772f
1 parent 79b628c
commit cb7772f
Show file tree

Hide file tree

Showing 13 changed files with 67 additions and 51 deletions.
diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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 =