Implement code-review suggestions

Co-authored-by: Alexey Kuleshevich <[email protected]>
IntersectMBO · Jan 3, 2025 · 67cf19b · 67cf19b
1 parent 2001774
commit 67cf19b
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 11 deletions.
diff --git a/...consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs b/...consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/Genesis.hs
@@ -4,8 +4,8 @@
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
-{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Ouroboros.Consensus.Node.Genesis (
     -- * 'GenesisConfig'
@@ -69,10 +69,10 @@ data GenesisConfigFlags = GenesisConfigFlags
   { gcfEnableCSJ             :: Bool
   , gcfEnableLoEAndGDD       :: Bool
   , gcfEnableLoP             :: Bool
-  , gcfBlockFetchGracePeriod :: Maybe Integer
+  , gcfBlockFetchGracePeriod :: Maybe DiffTime
   , gcfBucketCapacity        :: Maybe Integer
   , gcfBucketRate            :: Maybe Integer
-  , gcfCSJJumpSize           :: Maybe Integer
+  , gcfCSJJumpSize           :: Maybe SlotNo
   , gcfGDDRateLimit          :: Maybe DiffTime
   } deriving stock (Eq, Generic, Show)
 
@@ -106,7 +106,7 @@ mkGenesisConfig Nothing = -- disable Genesis
     , gcLoEAndGDDConfig          = LoEAndGDDDisabled
     , gcHistoricityCutoff        = Nothing
     }
-mkGenesisConfig (Just GenesisConfigFlags{..}) =
+mkGenesisConfig (Just cfg) =
   GenesisConfig
     { gcBlockFetchConfig = GenesisBlockFetchConfiguration
         { gbfcGracePeriod
@@ -131,6 +131,17 @@ mkGenesisConfig (Just GenesisConfigFlags{..}) =
       gcHistoricityCutoff = Just $ HistoricityCutoff $ 3 * 2160 * 20 + 3600
     }
   where
+    GenesisConfigFlags {
+        gcfEnableLoP
+      , gcfEnableCSJ
+      , gcfEnableLoEAndGDD
+      , gcfBlockFetchGracePeriod
+      , gcfBucketCapacity
+      , gcfBucketRate
+      , gcfCSJJumpSize
+      , gcfGDDRateLimit
+      } = cfg
+
     -- The minimum amount of time during which the Genesis BlockFetch logic will
     -- download blocks from a specific peer (even if it is not performing well
     -- during that period).
@@ -153,10 +164,10 @@ mkGenesisConfig (Just GenesisConfigFlags{..}) =
     -- Limiting the performance impact of the GDD.
     defaultGDDRateLimit        = 1.0 -- seconds
 
-    gbfcGracePeriod = fromInteger $ fromMaybe defaultBlockFetchGracePeriod gcfBlockFetchGracePeriod
-    csbcCapacity    = fromInteger $ fromMaybe defaultCapacity gcfBucketCapacity
-    csbcRate        = fromInteger $ fromMaybe defaultRate gcfBucketRate
-    csjcJumpSize    = fromInteger $ fromMaybe defaultCSJJumpSize gcfCSJJumpSize
+    gbfcGracePeriod = fromMaybe defaultBlockFetchGracePeriod gcfBlockFetchGracePeriod
+    csbcCapacity    = fromMaybe defaultCapacity gcfBucketCapacity
+    csbcRate        = maybe defaultRate (fromInteger @Rational) gcfBucketRate
+    csjcJumpSize    = fromMaybe defaultCSJJumpSize gcfCSJJumpSize
     lgpGDDRateLimit = fromMaybe defaultGDDRateLimit gcfGDDRateLimit
 
 newtype LoEAndGDDParams = LoEAndGDDParams

diff --git a/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/Uniform.hs b/ouroboros-consensus-diffusion/test/consensus-test/Test/Consensus/Genesis/Tests/Uniform.hs
@@ -19,11 +19,11 @@ module Test.Consensus.Genesis.Tests.Uniform (
 import           Cardano.Slotting.Slot (SlotNo (SlotNo), WithOrigin (..))
 import           Control.Monad (replicateM)
 import           Control.Monad.Class.MonadTime.SI (Time (..), addTime)
+import qualified Data.IntSet as IntSet
 import           Data.List (intercalate, sort, uncons)
 import qualified Data.List.NonEmpty as NE
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromMaybe, mapMaybe)
-import qualified Data.Set as Set
 import           Data.Word (Word64)
 import           GHC.Stack (HasCallStack)
 import           Ouroboros.Consensus.Block.Abstract (WithOrigin (NotOrigin))
@@ -248,8 +248,8 @@ dropRandomPoints ps = do
   where
     dropElemsAt :: [a] -> [Int] -> [a]
     dropElemsAt xs is' =
-      let is = Set.fromList is'
-      in map fst $ filter (\(_, i) -> not $ i `Set.member` is) (zip xs [0..])
+      let is = IntSet.fromList is'
+      in [x | (x, i) <- zip xs [0..], i `IntSet.notMember` is]
 
 -- | Test that the leashing attacks do not delay the immutable tip after. The
 -- immutable tip needs to be advanced enough when the honest peer has offered