{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Util.ChainDB (
    MinimalChainDbArgs (..)
  , NodeDBs (..)
  , emptyNodeDBs
  , fromMinimalChainDbArgs
  , mkTestChunkInfo
  ) where


import           Control.Concurrent.Class.MonadSTM.Strict
import           Control.ResourceRegistry (ResourceRegistry)
import           Control.Tracer (nullTracer)
import           Ouroboros.Consensus.Block.Abstract
import           Ouroboros.Consensus.Config
                     (TopLevelConfig (topLevelConfigLedger), configCodec)
import           Ouroboros.Consensus.HardFork.History.EraParams (eraEpochSize)
import           Ouroboros.Consensus.Ledger.Basics
import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Storage.ChainDB hiding
                     (TraceFollowerEvent (..))
import           Ouroboros.Consensus.Storage.ChainDB.Impl.Args
import           Ouroboros.Consensus.Storage.ImmutableDB
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
import           Ouroboros.Consensus.Storage.LedgerDB
import qualified Ouroboros.Consensus.Storage.LedgerDB.Snapshots as LedgerDB
import           Ouroboros.Consensus.Storage.LedgerDB.V2.Args
import           Ouroboros.Consensus.Storage.VolatileDB
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB
import           Ouroboros.Consensus.Util.Args
import           Ouroboros.Consensus.Util.IOLike hiding (invariant)
import           System.FS.API (SomeHasFS (..))
import qualified System.FS.Sim.MockFS as Mock
import           System.FS.Sim.MockFS
import           System.FS.Sim.STM (simHasFS)
import           Test.Util.Orphans.NoThunks ()
import           Test.Util.TestBlock (TestBlock, TestBlockLedgerConfig (..))

-- | A vector with an element for each database of a node
--
-- The @db@ type parameter is instantiated by this module at types for mock
-- filesystems; either the 'MockFS' type or reference cells thereof.
data NodeDBs db = NodeDBs {
    forall db. NodeDBs db -> db
nodeDBsImm :: db
  , forall db. NodeDBs db -> db
nodeDBsVol :: db
  , forall db. NodeDBs db -> db
nodeDBsLgr :: db
  , forall db. NodeDBs db -> db
nodeDBsGsm :: db
  }
  deriving ((forall a b. (a -> b) -> NodeDBs a -> NodeDBs b)
-> (forall a b. a -> NodeDBs b -> NodeDBs a) -> Functor NodeDBs
forall a b. a -> NodeDBs b -> NodeDBs a
forall a b. (a -> b) -> NodeDBs a -> NodeDBs b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> NodeDBs a -> NodeDBs b
fmap :: forall a b. (a -> b) -> NodeDBs a -> NodeDBs b
$c<$ :: forall a b. a -> NodeDBs b -> NodeDBs a
<$ :: forall a b. a -> NodeDBs b -> NodeDBs a
Functor, (forall m. Monoid m => NodeDBs m -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeDBs a -> m)
-> (forall m a. Monoid m => (a -> m) -> NodeDBs a -> m)
-> (forall a b. (a -> b -> b) -> b -> NodeDBs a -> b)
-> (forall a b. (a -> b -> b) -> b -> NodeDBs a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeDBs a -> b)
-> (forall b a. (b -> a -> b) -> b -> NodeDBs a -> b)
-> (forall a. (a -> a -> a) -> NodeDBs a -> a)
-> (forall a. (a -> a -> a) -> NodeDBs a -> a)
-> (forall a. NodeDBs a -> [a])
-> (forall a. NodeDBs a -> Bool)
-> (forall a. NodeDBs a -> Int)
-> (forall a. Eq a => a -> NodeDBs a -> Bool)
-> (forall a. Ord a => NodeDBs a -> a)
-> (forall a. Ord a => NodeDBs a -> a)
-> (forall a. Num a => NodeDBs a -> a)
-> (forall a. Num a => NodeDBs a -> a)
-> Foldable NodeDBs
forall a. Eq a => a -> NodeDBs a -> Bool
forall a. Num a => NodeDBs a -> a
forall a. Ord a => NodeDBs a -> a
forall m. Monoid m => NodeDBs m -> m
forall a. NodeDBs a -> Bool
forall a. NodeDBs a -> Int
forall a. NodeDBs a -> [a]
forall a. (a -> a -> a) -> NodeDBs a -> a
forall m a. Monoid m => (a -> m) -> NodeDBs a -> m
forall b a. (b -> a -> b) -> b -> NodeDBs a -> b
forall a b. (a -> b -> b) -> b -> NodeDBs a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => NodeDBs m -> m
fold :: forall m. Monoid m => NodeDBs m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> NodeDBs a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NodeDBs a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> NodeDBs a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NodeDBs a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> NodeDBs a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NodeDBs a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> NodeDBs a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NodeDBs a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> NodeDBs a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NodeDBs a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> NodeDBs a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NodeDBs a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> NodeDBs a -> a
foldr1 :: forall a. (a -> a -> a) -> NodeDBs a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> NodeDBs a -> a
foldl1 :: forall a. (a -> a -> a) -> NodeDBs a -> a
$ctoList :: forall a. NodeDBs a -> [a]
toList :: forall a. NodeDBs a -> [a]
$cnull :: forall a. NodeDBs a -> Bool
null :: forall a. NodeDBs a -> Bool
$clength :: forall a. NodeDBs a -> Int
length :: forall a. NodeDBs a -> Int
$celem :: forall a. Eq a => a -> NodeDBs a -> Bool
elem :: forall a. Eq a => a -> NodeDBs a -> Bool
$cmaximum :: forall a. Ord a => NodeDBs a -> a
maximum :: forall a. Ord a => NodeDBs a -> a
$cminimum :: forall a. Ord a => NodeDBs a -> a
minimum :: forall a. Ord a => NodeDBs a -> a
$csum :: forall a. Num a => NodeDBs a -> a
sum :: forall a. Num a => NodeDBs a -> a
$cproduct :: forall a. Num a => NodeDBs a -> a
product :: forall a. Num a => NodeDBs a -> a
Foldable, Functor NodeDBs
Foldable NodeDBs
(Functor NodeDBs, Foldable NodeDBs) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> NodeDBs a -> f (NodeDBs b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    NodeDBs (f a) -> f (NodeDBs a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> NodeDBs a -> m (NodeDBs b))
-> (forall (m :: * -> *) a.
    Monad m =>
    NodeDBs (m a) -> m (NodeDBs a))
-> Traversable NodeDBs
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => NodeDBs (m a) -> m (NodeDBs a)
forall (f :: * -> *) a.
Applicative f =>
NodeDBs (f a) -> f (NodeDBs a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeDBs a -> m (NodeDBs b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeDBs a -> f (NodeDBs b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeDBs a -> f (NodeDBs b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> NodeDBs a -> f (NodeDBs b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeDBs (f a) -> f (NodeDBs a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
NodeDBs (f a) -> f (NodeDBs a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeDBs a -> m (NodeDBs b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> NodeDBs a -> m (NodeDBs b)
$csequence :: forall (m :: * -> *) a. Monad m => NodeDBs (m a) -> m (NodeDBs a)
sequence :: forall (m :: * -> *) a. Monad m => NodeDBs (m a) -> m (NodeDBs a)
Traversable)

emptyNodeDBs :: MonadSTM m => m (NodeDBs (StrictTMVar m MockFS))
emptyNodeDBs :: forall (m :: * -> *).
MonadSTM m =>
m (NodeDBs (StrictTMVar m MockFS))
emptyNodeDBs = STM m (NodeDBs (StrictTMVar m MockFS))
-> m (NodeDBs (StrictTMVar m MockFS))
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (NodeDBs (StrictTMVar m MockFS))
 -> m (NodeDBs (StrictTMVar m MockFS)))
-> STM m (NodeDBs (StrictTMVar m MockFS))
-> m (NodeDBs (StrictTMVar m MockFS))
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS
-> StrictTMVar m MockFS
-> StrictTMVar m MockFS
-> StrictTMVar m MockFS
-> NodeDBs (StrictTMVar m MockFS)
forall db. db -> db -> db -> db -> NodeDBs db
NodeDBs
  (StrictTMVar m MockFS
 -> StrictTMVar m MockFS
 -> StrictTMVar m MockFS
 -> StrictTMVar m MockFS
 -> NodeDBs (StrictTMVar m MockFS))
-> STM m (StrictTMVar m MockFS)
-> STM
     m
     (StrictTMVar m MockFS
      -> StrictTMVar m MockFS
      -> StrictTMVar m MockFS
      -> NodeDBs (StrictTMVar m MockFS))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty
  STM
  m
  (StrictTMVar m MockFS
   -> StrictTMVar m MockFS
   -> StrictTMVar m MockFS
   -> NodeDBs (StrictTMVar m MockFS))
-> STM m (StrictTMVar m MockFS)
-> STM
     m
     (StrictTMVar m MockFS
      -> StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
forall a b. STM m (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty
  STM
  m
  (StrictTMVar m MockFS
   -> StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
-> STM m (StrictTMVar m MockFS)
-> STM m (StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
forall a b. STM m (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty
  STM m (StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
-> STM m (StrictTMVar m MockFS)
-> STM m (NodeDBs (StrictTMVar m MockFS))
forall a b. STM m (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty

-- | Minimal set of arguments for creating a ChainDB instance for testing purposes.
data MinimalChainDbArgs m blk = MinimalChainDbArgs {
    forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> TopLevelConfig blk
mcdbTopLevelConfig :: TopLevelConfig blk
  , forall (m :: * -> *) blk. MinimalChainDbArgs m blk -> ChunkInfo
mcdbChunkInfo      :: ImmutableDB.ChunkInfo
  -- ^ Specifies the layout of the ImmutableDB on disk.
  , forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> ExtLedgerState blk ValuesMK
mcdbInitLedger     :: ExtLedgerState blk ValuesMK
  -- ^ The initial ledger state.
  , forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> ResourceRegistry m
mcdbRegistry       :: ResourceRegistry m
  -- ^ Keeps track of non-lexically scoped resources.
  , forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs        :: NodeDBs (StrictTMVar m MockFS)
  -- ^ File systems underlying the immutable, volatile and ledger databases.
  -- Would be useful to default this to StrictTMVar's containing empty MockFS's.
  }

-- | Utility function to get a default chunk info in case we have EraParams available.
mkTestChunkInfo :: TopLevelConfig TestBlock -> ImmutableDB.ChunkInfo
mkTestChunkInfo :: TopLevelConfig TestBlock -> ChunkInfo
mkTestChunkInfo = EpochSize -> ChunkInfo
simpleChunkInfo (EpochSize -> ChunkInfo)
-> (TopLevelConfig TestBlock -> EpochSize)
-> TopLevelConfig TestBlock
-> ChunkInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EraParams -> EpochSize
eraEpochSize (EraParams -> EpochSize)
-> (TopLevelConfig TestBlock -> EraParams)
-> TopLevelConfig TestBlock
-> EpochSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestBlockLedgerConfig -> EraParams
tblcHardForkParams (TestBlockLedgerConfig -> EraParams)
-> (TopLevelConfig TestBlock -> TestBlockLedgerConfig)
-> TopLevelConfig TestBlock
-> EraParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TopLevelConfig TestBlock -> LedgerConfig TestBlock
TopLevelConfig TestBlock -> TestBlockLedgerConfig
forall blk. TopLevelConfig blk -> LedgerConfig blk
topLevelConfigLedger

-- | Creates a default set of of arguments for ChainDB tests.
fromMinimalChainDbArgs ::
     ( MonadThrow m
     , MonadSTM m
     , ConsensusProtocol (BlockProtocol blk)
     , PrimMonad m
     )
  => MinimalChainDbArgs m blk -> Complete ChainDbArgs m blk
fromMinimalChainDbArgs :: forall (m :: * -> *) blk.
(MonadThrow m, MonadSTM m, ConsensusProtocol (BlockProtocol blk),
 PrimMonad m) =>
MinimalChainDbArgs m blk -> Complete ChainDbArgs m blk
fromMinimalChainDbArgs MinimalChainDbArgs {TopLevelConfig blk
ChunkInfo
ExtLedgerState blk ValuesMK
ResourceRegistry m
NodeDBs (StrictTMVar m MockFS)
mcdbTopLevelConfig :: forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> TopLevelConfig blk
mcdbChunkInfo :: forall (m :: * -> *) blk. MinimalChainDbArgs m blk -> ChunkInfo
mcdbInitLedger :: forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> ExtLedgerState blk ValuesMK
mcdbRegistry :: forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> ResourceRegistry m
mcdbNodeDBs :: forall (m :: * -> *) blk.
MinimalChainDbArgs m blk -> NodeDBs (StrictTMVar m MockFS)
mcdbTopLevelConfig :: TopLevelConfig blk
mcdbChunkInfo :: ChunkInfo
mcdbInitLedger :: ExtLedgerState blk ValuesMK
mcdbRegistry :: ResourceRegistry m
mcdbNodeDBs :: NodeDBs (StrictTMVar m MockFS)
..} = ChainDbArgs {
      cdbImmDbArgs :: ImmutableDbArgs Identity m blk
cdbImmDbArgs = ImmutableDbArgs {
            immCacheConfig :: CacheConfig
immCacheConfig      = Word32 -> DiffTime -> CacheConfig
ImmutableDB.CacheConfig Word32
2 DiffTime
60
            -- Cache at most 2 chunks and expire each chunk after 60 seconds of
            -- being unused.
          , immCheckIntegrity :: HKD Identity (blk -> Bool)
immCheckIntegrity   = Bool -> blk -> Bool
forall a b. a -> b -> a
const Bool
True
            -- Getting a verified block component does not do any integrity
            -- checking, both for the ImmutableDB, as the VolatileDB. This is
            -- done in @extractBlockComponent@ in the iterator for the
            -- ImmutableDB, and in @getBlockComponent@ for the VolatileDB.
          , immChunkInfo :: HKD Identity ChunkInfo
immChunkInfo        = HKD Identity ChunkInfo
ChunkInfo
mcdbChunkInfo
          , immHasFS :: HKD Identity (SomeHasFS m)
immHasFS            = HasFS m HandleMock -> SomeHasFS m
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (HasFS m HandleMock -> SomeHasFS m)
-> HasFS m HandleMock -> SomeHasFS m
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> HasFS m HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS (NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsImm NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs)
          , immRegistry :: HKD Identity (ResourceRegistry m)
immRegistry         = HKD Identity (ResourceRegistry m)
ResourceRegistry m
mcdbRegistry
          , immTracer :: Tracer m (TraceEvent blk)
immTracer           = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
          , immCodecConfig :: HKD Identity (CodecConfig blk)
immCodecConfig      = TopLevelConfig blk -> CodecConfig blk
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec TopLevelConfig blk
mcdbTopLevelConfig
          , immValidationPolicy :: ValidationPolicy
immValidationPolicy = ValidationPolicy
ImmutableDB.ValidateAllChunks
          }
    , cdbVolDbArgs :: VolatileDbArgs Identity m blk
cdbVolDbArgs = VolatileDbArgs {
          volCheckIntegrity :: HKD Identity (blk -> Bool)
volCheckIntegrity   = Bool -> blk -> Bool
forall a b. a -> b -> a
const Bool
True
        , volCodecConfig :: HKD Identity (CodecConfig blk)
volCodecConfig      = TopLevelConfig blk -> CodecConfig blk
forall blk. TopLevelConfig blk -> CodecConfig blk
configCodec TopLevelConfig blk
mcdbTopLevelConfig
        , volHasFS :: HKD Identity (SomeHasFS m)
volHasFS            = HasFS m HandleMock -> SomeHasFS m
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (HasFS m HandleMock -> SomeHasFS m)
-> HasFS m HandleMock -> SomeHasFS m
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> HasFS m HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS (NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsVol NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs)
        , volMaxBlocksPerFile :: BlocksPerFile
volMaxBlocksPerFile = Word32 -> BlocksPerFile
VolatileDB.mkBlocksPerFile Word32
4
        , volTracer :: Tracer m (TraceEvent blk)
volTracer           = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        , volValidationPolicy :: BlockValidationPolicy
volValidationPolicy = BlockValidationPolicy
VolatileDB.ValidateAll
        }
    , cdbLgrDbArgs :: LedgerDbArgs Identity m blk
cdbLgrDbArgs = LedgerDbArgs {
          lgrSnapshotPolicyArgs :: SnapshotPolicyArgs
lgrSnapshotPolicyArgs =
            SnapshotInterval -> NumOfDiskSnapshots -> SnapshotPolicyArgs
LedgerDB.SnapshotPolicyArgs
              SnapshotInterval
LedgerDB.DefaultSnapshotInterval
              NumOfDiskSnapshots
LedgerDB.DefaultNumOfDiskSnapshots
          -- Keep 2 ledger snapshots, and take a new snapshot at least every 2 *
          -- k seconds, where k is the security parameter.
        , lgrGenesis :: HKD Identity (m (ExtLedgerState blk ValuesMK))
lgrGenesis            = ExtLedgerState blk ValuesMK -> m (ExtLedgerState blk ValuesMK)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ExtLedgerState blk ValuesMK
mcdbInitLedger
        , lgrHasFS :: HKD Identity (SomeHasFS m)
lgrHasFS              = HasFS m HandleMock -> SomeHasFS m
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (HasFS m HandleMock -> SomeHasFS m)
-> HasFS m HandleMock -> SomeHasFS m
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> HasFS m HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS (NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsLgr NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs)
        , lgrTracer :: Tracer m (TraceEvent blk)
lgrTracer             = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        , lgrRegistry :: HKD Identity (ResourceRegistry m)
lgrRegistry           = HKD Identity (ResourceRegistry m)
ResourceRegistry m
mcdbRegistry
        , lgrConfig :: LedgerDbCfgF Identity (ExtLedgerState blk)
lgrConfig             = TopLevelConfig blk
-> ComputeLedgerEvents
-> LedgerDbCfgF Identity (ExtLedgerState blk)
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk
-> ComputeLedgerEvents -> LedgerDbCfg (ExtLedgerState blk)
configLedgerDb TopLevelConfig blk
mcdbTopLevelConfig ComputeLedgerEvents
OmitLedgerEvents
        , lgrFlavorArgs :: LedgerDbFlavorArgs Identity m
lgrFlavorArgs         = LedgerDbFlavorArgs Identity m -> LedgerDbFlavorArgs Identity m
forall (f :: * -> *) (m :: * -> *).
LedgerDbFlavorArgs f m -> LedgerDbFlavorArgs f m
LedgerDbFlavorArgsV2 (HandleArgs -> LedgerDbFlavorArgs Identity m
forall {k} {k1} (f :: k) (m :: k1).
HandleArgs -> LedgerDbFlavorArgs f m
V2Args HandleArgs
InMemoryHandleArgs)
        , lgrQueryBatchSize :: QueryBatchSize
lgrQueryBatchSize     = QueryBatchSize
DefaultQueryBatchSize
        , lgrStartSnapshot :: Maybe DiskSnapshot
lgrStartSnapshot      = Maybe DiskSnapshot
forall a. Maybe a
Nothing
        }
    , cdbsArgs :: ChainDbSpecificArgs Identity m blk
cdbsArgs = ChainDbSpecificArgs {
          cdbsBlocksToAddSize :: Word
cdbsBlocksToAddSize = Word
1
        , cdbsGcDelay :: DiffTime
cdbsGcDelay         = DiffTime
1
        , cdbsHasFSGsmDB :: HKD Identity (SomeHasFS m)
cdbsHasFSGsmDB      = HasFS m HandleMock -> SomeHasFS m
forall h (m :: * -> *). Eq h => HasFS m h -> SomeHasFS m
SomeHasFS (HasFS m HandleMock -> SomeHasFS m)
-> HasFS m HandleMock -> SomeHasFS m
forall a b. (a -> b) -> a -> b
$ StrictTMVar m MockFS -> HasFS m HandleMock
forall (m :: * -> *).
(MonadSTM m, MonadThrow m, PrimMonad m) =>
StrictTMVar m MockFS -> HasFS m HandleMock
simHasFS (NodeDBs (StrictTMVar m MockFS) -> StrictTMVar m MockFS
forall db. NodeDBs db -> db
nodeDBsGsm NodeDBs (StrictTMVar m MockFS)
mcdbNodeDBs)
        , cdbsGcInterval :: DiffTime
cdbsGcInterval      = DiffTime
1
        , cdbsRegistry :: HKD Identity (ResourceRegistry m)
cdbsRegistry        = HKD Identity (ResourceRegistry m)
ResourceRegistry m
mcdbRegistry
        , cdbsTracer :: Tracer m (TraceEvent blk)
cdbsTracer          = Tracer m (TraceEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        , cdbsTopLevelConfig :: HKD Identity (TopLevelConfig blk)
cdbsTopLevelConfig  = HKD Identity (TopLevelConfig blk)
TopLevelConfig blk
mcdbTopLevelConfig
        , cdbsLoE :: GetLoEFragment m blk
cdbsLoE             = LoE (AnchoredFragment (HeaderWithTime blk)) -> GetLoEFragment m blk
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoE (AnchoredFragment (HeaderWithTime blk))
forall a. LoE a
LoEDisabled
        }
    }