Incorporate simple review comments

IntersectMBO · Aug 8, 2022 · 0f2f098 · 0f2f098
1 parent a265f26
commit 0f2f098
Show file tree

Hide file tree

Showing 4 changed files with 16 additions and 31 deletions.
diff --git a/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs b/ouroboros-consensus-test/src/Test/ThreadNet/Network.hs
@@ -706,11 +706,11 @@ runThreadNetwork systemTime ThreadNetworkArgs
                                      initLedger
                                      registry
                                      nodeDBs
-                                     (instrumentationTracer <> nullDebugTracer)
-                                     nullDebugTracer
         in args { cdbCheckIntegrity = nodeCheckIntegrity (configStorage cfg)
                 , cdbCheckInFuture = InFuture.reference (configLedger cfg) InFuture.defaultClockSkew
                                       (OracularClock.finiteSystemTime clock)
+                , cdbTracer = instrumentationTracer <> nullDebugTracer
+                , cdbTraceLedger = nullDebugTracer
                 }
       where
         prj af = case AF.headBlockNo af of

diff --git a/ouroboros-consensus-test/src/Test/Util/ChainDB.hs b/ouroboros-consensus-test/src/Test/Util/ChainDB.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE DeriveFunctor    #-}
 {-# LANGUAGE FlexibleContexts #-}
 module Test.Util.ChainDB (
     NodeDBs (..)
@@ -10,7 +11,7 @@ import           Data.Functor.Identity (Identity)
 
 -- import           Control.Monad.Class (MonadThrow)
 import           Control.Monad.Class.MonadThrow (MonadThrow)
-import           Control.Tracer (Tracer)
+import           Control.Tracer (nullTracer)
 
 import           Ouroboros.Consensus.Config (TopLevelConfig,
                      configSecurityParam)
@@ -19,9 +20,6 @@ import qualified Ouroboros.Consensus.Fragment.Validated as VF
 import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
 import           Ouroboros.Consensus.Protocol.Abstract
 import           Ouroboros.Consensus.Storage.ChainDB.Impl.Args
-import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB (LedgerDB')
-import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
-                     (TraceEvent (..))
 import           Ouroboros.Consensus.Storage.FS.API (SomeHasFS (..))
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
 import qualified Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy as LedgerDB
@@ -44,7 +42,7 @@ data NodeDBs db = NodeDBs
   { nodeDBsImm :: db
   , nodeDBsVol :: db
   , nodeDBsLgr :: db
-  } deriving (Functor, Applicative, Monad)
+  } deriving (Functor)
 
 
 emptyNodeDBs :: MonadSTM m => m (NodeDBs (StrictTVar m MockFS))
@@ -66,10 +64,8 @@ mkTestChainDbArgs :: (MonadThrow m, MonadSTM m, ConsensusProtocol (BlockProtocol
                   -> NodeDBs (StrictTVar m MockFS)
                   -- ^ File systems underlying the immutable, volatile and ledger databases.
                   -- Would be useful to default this to StrictTVar's containing empty MockFS's.
-                  -> Tracer m (TraceEvent blk)
-                  -> Tracer m (LedgerDB' blk)
                   -> ChainDbArgs Identity m blk
-mkTestChainDbArgs cfg chunkInfo initLedger registry nodeDBs tracer traceLedger = ChainDbArgs {
+mkTestChainDbArgs cfg chunkInfo initLedger registry nodeDBs = ChainDbArgs {
     cdbHasFSImmutableDB = SomeHasFS $ simHasFS (nodeDBsImm nodeDBs)
   , cdbHasFSVolatileDB = SomeHasFS $ simHasFS (nodeDBsVol nodeDBs)
   , cdbHasFSLgrDB = SomeHasFS $ simHasFS (nodeDBsLgr nodeDBs)
@@ -91,8 +87,8 @@ mkTestChainDbArgs cfg chunkInfo initLedger registry nodeDBs tracer traceLedger =
   -- ^ Blocks are never in the future.
   , cdbImmutableDbCacheConfig = ImmutableDB.CacheConfig 2 60 -- ImmutableDB
   -- ^ Cache at most 2 chunks and expire each chunk after 60 seconds of being unused.
-  , cdbTracer = tracer
-  , cdbTraceLedger = traceLedger
+  , cdbTracer = nullTracer
+  , cdbTraceLedger = nullTracer
   , cdbRegistry = registry
   , cdbGcDelay = 1
   , cdbGcInterval = 1

diff --git a/ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/BlockFetch/Client.hs b/ouroboros-consensus-test/test-consensus/Test/Consensus/MiniProtocol/BlockFetch/Client.hs
@@ -63,32 +63,21 @@ import           Ouroboros.Network.Protocol.BlockFetch.Type (ChainRange (..),
 
 import           Ouroboros.Consensus.Block
 import           Ouroboros.Consensus.Config
-import           Ouroboros.Consensus.Fragment.InFuture
-                     (CheckInFuture (CheckInFuture))
-import           Ouroboros.Consensus.Fragment.Validated
-                     (ValidatedFragment (validatedFragment))
 import           Ouroboros.Consensus.HardFork.History.EraParams
                      (EraParams (eraEpochSize))
 import qualified Ouroboros.Consensus.MiniProtocol.BlockFetch.ClientInterface as BlockFetchClientInterface
 import           Ouroboros.Consensus.Node.ProtocolInfo (NumCoreNodes (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
 import           Ouroboros.Consensus.Storage.ChainDB.Impl (ChainDbArgs (..))
 import qualified Ouroboros.Consensus.Storage.ChainDB.Impl as ChainDBImpl
-import           Ouroboros.Consensus.Storage.FS.API (SomeHasFS (SomeHasFS))
 import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
-import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
-                     (SnapshotInterval (DefaultSnapshotInterval),
-                     defaultDiskPolicy)
-import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
 import           Ouroboros.Consensus.Util.Condense (Condense (..))
 import           Ouroboros.Consensus.Util.IOLike
 import           Ouroboros.Consensus.Util.ResourceRegistry
 import           Ouroboros.Consensus.Util.STM (blockUntilJust,
                      forkLinkedWatcher)
 
 import           Test.Util.ChainUpdates
-import qualified Test.Util.FS.Sim.MockFS as MockFS
-import           Test.Util.FS.Sim.STM (simHasFS)
 import           Test.Util.LogicalClock (Tick (..))
 import qualified Test.Util.LogicalClock as LogicalClock
 import           Test.Util.Orphans.IOLike ()
@@ -254,13 +243,12 @@ runBlockFetchTest BlockFetchClientTestSetup{..} = withRegistry \registry -> do
         chainDbArgs <- do
           nodeDBs <- emptyNodeDBs
           let cdbChunkInfo = ImmutableDB.simpleChunkInfo epochSize
-          pure $ mkTestChainDbArgs topLevelConfig
-                                   cdbChunkInfo
-                                   testInitExtLedger
-                                   registry
-                                   nodeDBs
-                                   cdbTracer
-                                   nullTracer
+          let args = mkTestChainDbArgs topLevelConfig
+                                       cdbChunkInfo
+                                       testInitExtLedger
+                                       registry
+                                       nodeDBs
+          pure $ args { cdbTracer = cdbTracer }
         (_, (chainDB, ChainDBImpl.Internal{intAddBlockRunner})) <-
           allocate
             registry

diff --git a/ouroboros-consensus-test/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs b/ouroboros-consensus-test/test-storage/Test/Ouroboros/Storage/ChainDB/StateMachine.hs
@@ -1620,10 +1620,11 @@ mkArgs :: IOLike m
        -> StrictTVar m SlotNo
        -> ChainDbArgs Identity m Blk
 mkArgs cfg chunkInfo initLedger registry nodeDBs tracer (MaxClockSkew maxClockSkew) varCurSlot =
-  let args = mkTestChainDbArgs cfg chunkInfo initLedger registry nodeDBs tracer nullTracer
+  let args = mkTestChainDbArgs cfg chunkInfo initLedger registry nodeDBs
   in args { cdbCheckInFuture = InFuture.miracle (readTVar varCurSlot) maxClockSkew
           , cdbCheckIntegrity = testBlockIsValid
           , cdbBlocksToAddSize = 2
+          , cdbTracer = tracer
           }
 
 tests :: TestTree