{-# 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.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.ChainDB.Impl.LgrDB
import           Ouroboros.Consensus.Storage.ImmutableDB
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
import           Ouroboros.Consensus.Storage.LedgerDB (configLedgerDb)
import qualified Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy as LedgerDB
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 = 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))
-> m (StrictTMVar m MockFS)
-> 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
<$> STM m (StrictTMVar m MockFS) -> m (StrictTMVar m MockFS)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty)
  m (StrictTMVar m MockFS
   -> StrictTMVar m MockFS
   -> StrictTMVar m MockFS
   -> NodeDBs (StrictTMVar m MockFS))
-> m (StrictTMVar m MockFS)
-> m (StrictTMVar m MockFS
      -> StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STM m (StrictTMVar m MockFS) -> m (StrictTMVar m MockFS)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty)
  m (StrictTMVar m MockFS
   -> StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
-> m (StrictTMVar m MockFS)
-> m (StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STM m (StrictTMVar m MockFS) -> m (StrictTMVar m MockFS)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (MockFS -> STM m (StrictTMVar m MockFS)
forall (m :: * -> *) a. MonadSTM m => a -> STM m (StrictTMVar m a)
newTMVar MockFS
Mock.empty)
  m (StrictTMVar m MockFS -> NodeDBs (StrictTMVar m MockFS))
-> m (StrictTMVar m MockFS) -> m (NodeDBs (StrictTMVar m MockFS))
forall a b. m (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> STM m (StrictTMVar m MockFS) -> m (StrictTMVar m MockFS)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (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
mcdbInitLedger     :: ExtLedgerState blk
  -- ^ 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
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
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
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 :: LgrDbArgs Identity m blk
cdbLgrDbArgs = LgrDbArgs {
          lgrDiskPolicyArgs :: DiskPolicyArgs
lgrDiskPolicyArgs   = SnapshotInterval
-> NumOfDiskSnapshots
-> Flag "DoDiskSnapshotChecksum"
-> DiskPolicyArgs
LedgerDB.DiskPolicyArgs SnapshotInterval
LedgerDB.DefaultSnapshotInterval NumOfDiskSnapshots
LedgerDB.DefaultNumOfDiskSnapshots Flag "DoDiskSnapshotChecksum"
LedgerDB.DoDiskSnapshotChecksum
          -- 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))
lgrGenesis          = ExtLedgerState blk -> m (ExtLedgerState blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ExtLedgerState blk
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 (TraceSnapshotEvent blk)
lgrTracer           = Tracer m (TraceSnapshotEvent blk)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        , lgrConfig :: HKD Identity (LedgerDbCfg (ExtLedgerState blk))
lgrConfig           = TopLevelConfig blk -> LedgerDbCfg (ExtLedgerState blk)
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> LedgerDbCfg (ExtLedgerState blk)
configLedgerDb TopLevelConfig blk
mcdbTopLevelConfig
        }
    , 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 (Header blk)) -> GetLoEFragment m blk
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoE (AnchoredFragment (Header blk))
forall a. LoE a
LoEDisabled
        }
    }