{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | The 'BackingStore' is the component of the LedgerDB V1 implementation that
-- stores a key-value map with the 'LedgerTable's at a specific slot on the
-- chain.
--
-- It is used for storing 'Ouroboros.Consensus.Ledger.Basics.LedgerState' data
-- structures, and updating them with t'Data.Map.Diff.Strict.Diff's produced by
-- executing the Ledger rules.
--
-- See "Ouroboros.Consensus.Storage.LedgerDB.BackingStore" for the
-- implementations provided.
module Ouroboros.Consensus.Storage.LedgerDB.V1.BackingStore.API
  ( -- * FileSystem newtypes
    LiveLMDBFS (..)
  , SnapshotsFS (..)

    -- * Backing store
  , BackingStore (..)
  , BackingStore'
  , DiffsToFlush (..)
  , InitFrom (..)
  , InitHint
  , LedgerBackingStore
  , ReadHint
  , WriteHint

    -- * Value handle
  , BackingStoreValueHandle (..)
  , BackingStoreValueHandle'
  , LedgerBackingStoreValueHandle
  , castBackingStoreValueHandle
  , withBsValueHandle

    -- * Query
  , RangeQuery (..)

    -- * Statistics
  , Statistics (..)

    -- * Tracing
  , BackingStoreTrace (..)
  , BackingStoreValueHandleTrace (..)

    -- * 🧪 Testing
  , bsRead
  , bsReadAll
  ) where

import Cardano.Slotting.Slot (SlotNo, WithOrigin (..))
import Data.Kind
import GHC.Generics
import NoThunks.Class (OnlyCheckWhnfNamed (..))
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Storage.LedgerDB.Snapshots
import Ouroboros.Consensus.Util.IOLike
import System.FS.API
import qualified System.FS.API.Types as FS

-- | The LedgerDB file system. Typically pointing to @<db-path\/vol-db-path>/ledger@.
newtype SnapshotsFS m = SnapshotsFS {forall (m :: * -> *). SnapshotsFS m -> SomeHasFS m
snapshotsFs :: SomeHasFS m}
  deriving ((forall x. SnapshotsFS m -> Rep (SnapshotsFS m) x)
-> (forall x. Rep (SnapshotsFS m) x -> SnapshotsFS m)
-> Generic (SnapshotsFS m)
forall x. Rep (SnapshotsFS m) x -> SnapshotsFS m
forall x. SnapshotsFS m -> Rep (SnapshotsFS m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (SnapshotsFS m) x -> SnapshotsFS m
forall (m :: * -> *) x. SnapshotsFS m -> Rep (SnapshotsFS m) x
$cfrom :: forall (m :: * -> *) x. SnapshotsFS m -> Rep (SnapshotsFS m) x
from :: forall x. SnapshotsFS m -> Rep (SnapshotsFS m) x
$cto :: forall (m :: * -> *) x. Rep (SnapshotsFS m) x -> SnapshotsFS m
to :: forall x. Rep (SnapshotsFS m) x -> SnapshotsFS m
Generic, Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
Proxy (SnapshotsFS m) -> String
(Context -> SnapshotsFS m -> IO (Maybe ThunkInfo))
-> (Context -> SnapshotsFS m -> IO (Maybe ThunkInfo))
-> (Proxy (SnapshotsFS m) -> String)
-> NoThunks (SnapshotsFS m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (SnapshotsFS m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
noThunks :: Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SnapshotsFS m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (SnapshotsFS m) -> String
showTypeOf :: Proxy (SnapshotsFS m) -> String
NoThunks)

-- | The LMDB file system. Typically pointing to @<db-path\/vol-db-path>/lmdb@.
newtype LiveLMDBFS m = LiveLMDBFS {forall (m :: * -> *). LiveLMDBFS m -> SomeHasFS m
liveLMDBFs :: SomeHasFS m}
  deriving ((forall x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x)
-> (forall x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m)
-> Generic (LiveLMDBFS m)
forall x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
forall x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
forall (m :: * -> *) x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
$cfrom :: forall (m :: * -> *) x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
from :: forall x. LiveLMDBFS m -> Rep (LiveLMDBFS m) x
$cto :: forall (m :: * -> *) x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
to :: forall x. Rep (LiveLMDBFS m) x -> LiveLMDBFS m
Generic, Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
Proxy (LiveLMDBFS m) -> String
(Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo))
-> (Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo))
-> (Proxy (LiveLMDBFS m) -> String)
-> NoThunks (LiveLMDBFS m)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *).
Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
forall (m :: * -> *). Proxy (LiveLMDBFS m) -> String
$cnoThunks :: forall (m :: * -> *).
Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
noThunks :: Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *).
Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LiveLMDBFS m -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall (m :: * -> *). Proxy (LiveLMDBFS m) -> String
showTypeOf :: Proxy (LiveLMDBFS m) -> String
NoThunks)

{-------------------------------------------------------------------------------
  Backing store interface
-------------------------------------------------------------------------------}

-- | A container for differences that are inteded to be flushed to a
-- 'BackingStore'
data DiffsToFlush l = DiffsToFlush
  { forall (l :: LedgerStateKind).
DiffsToFlush l -> LedgerTables l DiffMK
toFlushDiffs :: !(LedgerTables l DiffMK)
  -- ^ The set of differences that should be flushed into the 'BackingStore'
  , forall (l :: LedgerStateKind).
DiffsToFlush l -> (l EmptyMK, l EmptyMK)
toFlushState :: !(l EmptyMK, l EmptyMK)
  -- ^ The last flushed state and the newly flushed state. This will be the
  -- immutable tip.
  , forall (l :: LedgerStateKind). DiffsToFlush l -> SlotNo
toFlushSlot :: !SlotNo
  -- ^ At which slot the diffs were split. This must be the slot of the state
  -- considered as "last flushed" in the kept 'DbChangelog'
  }

data BackingStore m keys values diff = BackingStore
  { forall (m :: * -> *) keys values diff.
BackingStore m keys values diff -> m ()
bsClose :: !(m ())
  -- ^ Close the backing store
  --
  -- Other methods throw exceptions if called on a closed store. 'bsClose'
  -- itself is idempotent.
  , forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> SerializeTablesHint values -> FsPath -> m ()
bsCopy :: !(SerializeTablesHint values -> FS.FsPath -> m ())
  -- ^ Create a persistent copy
  --
  -- Each backing store implementation will offer a way to initialize itself
  -- from such a path.
  --
  -- The destination path must not already exist. After this operation, it
  -- will be a directory.
  , forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> m (BackingStoreValueHandle m keys values)
bsValueHandle :: !(m (BackingStoreValueHandle m keys values))
  -- ^ Open a 'BackingStoreValueHandle' capturing the current value of the
  -- entire database
  , forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> SlotNo -> WriteHint diff -> diff -> m ()
bsWrite :: !(SlotNo -> WriteHint diff -> diff -> m ())
  -- ^ Apply a valid diff to the contents of the backing store
  , forall (m :: * -> *) keys values diff.
BackingStore m keys values diff -> SnapshotBackend
bsSnapshotBackend :: !SnapshotBackend
  -- ^ The name of the BackingStore backend, for loading and writing snapshots
  --   to disk
  }

deriving via
  OnlyCheckWhnfNamed "BackingStore" (BackingStore m keys values diff)
  instance
    NoThunks (BackingStore m keys values diff)

type LedgerBackingStore m l =
  BackingStore
    m
    (LedgerTables l KeysMK)
    (LedgerTables l ValuesMK)
    (LedgerTables l DiffMK)

type BackingStore' m blk = LedgerBackingStore m (ExtLedgerState blk)

type family InitHint values :: Type
type instance InitHint (LedgerTables l ValuesMK) = l EmptyMK

type family WriteHint diffs :: Type
type instance WriteHint (LedgerTables l DiffMK) = (l EmptyMK, l EmptyMK)

type family ReadHint values :: Type
type instance ReadHint (LedgerTables l ValuesMK) = l EmptyMK

-- | Choose how to initialize the backing store
data InitFrom values
  = -- | Initialize from a set of values, at the given slot.
    InitFromValues !(WithOrigin SlotNo) !(InitHint values) !values
  | -- | Use a snapshot at the given path to overwrite the set of values in the
    -- opened database.
    InitFromCopy !(InitHint values) !FS.FsPath

{-------------------------------------------------------------------------------
  Value handles
-------------------------------------------------------------------------------}

-- | An ephemeral handle to an immutable value of the entire database
--
-- The performance cost is usually minimal unless this handle is held open too
-- long. We expect clients of the 'BackingStore' to not retain handles for a
-- long time.
data BackingStoreValueHandle m keys values = BackingStoreValueHandle
  { forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> WithOrigin SlotNo
bsvhAtSlot :: !(WithOrigin SlotNo)
  -- ^ At which slot this handle was created
  , forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m ()
bsvhClose :: !(m ())
  -- ^ Close the handle
  --
  -- Other methods throw exceptions if called on a closed handle. 'bsvhClose'
  -- itself is idempotent.
  , forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> RangeQuery keys -> m values
bsvhRangeRead :: !(ReadHint values -> RangeQuery keys -> m values)
  -- ^ See 'RangeQuery'
  , forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> m values
bsvhReadAll :: !(ReadHint values -> m values)
  -- ^ Costly read all operation, not to be used in Consensus but only in
  -- snapshot-converter executable.
  , forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> keys -> m values
bsvhRead :: !(ReadHint values -> keys -> m values)
  -- ^ Read the given keys from the handle
  --
  -- Absent keys will merely not be present in the result instead of causing a
  -- failure or an exception.
  , forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m Statistics
bsvhStat :: !(m Statistics)
  -- ^ Retrieve statistics
  }

deriving via
  OnlyCheckWhnfNamed "BackingStoreValueHandle" (BackingStoreValueHandle m keys values)
  instance
    NoThunks (BackingStoreValueHandle m keys values)

type LedgerBackingStoreValueHandle m l =
  BackingStoreValueHandle
    m
    (LedgerTables l KeysMK)
    (LedgerTables l ValuesMK)

type BackingStoreValueHandle' m blk = LedgerBackingStoreValueHandle m (ExtLedgerState blk)

castBackingStoreValueHandle ::
  (Functor m, ReadHint values ~ ReadHint values') =>
  (values -> values') ->
  (keys' -> keys) ->
  BackingStoreValueHandle m keys values ->
  BackingStoreValueHandle m keys' values'
castBackingStoreValueHandle :: forall (m :: * -> *) values values' keys' keys.
(Functor m, ReadHint values ~ ReadHint values') =>
(values -> values')
-> (keys' -> keys)
-> BackingStoreValueHandle m keys values
-> BackingStoreValueHandle m keys' values'
castBackingStoreValueHandle values -> values'
f keys' -> keys
g BackingStoreValueHandle m keys values
bsvh =
  BackingStoreValueHandle
    { WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot
    , m ()
bsvhClose :: m ()
bsvhClose :: m ()
bsvhClose
    , bsvhReadAll :: ReadHint values' -> m values'
bsvhReadAll = \ReadHint values'
rhint -> values -> values'
f (values -> values') -> m values -> m values'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadHint values -> m values
bsvhReadAll ReadHint values
ReadHint values'
rhint
    , bsvhRangeRead :: ReadHint values' -> RangeQuery keys' -> m values'
bsvhRangeRead = \ReadHint values'
rhint (RangeQuery Maybe keys'
prev Int
count) ->
        (values -> values') -> m values -> m values'
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap values -> values'
f (m values -> m values')
-> (RangeQuery keys -> m values) -> RangeQuery keys -> m values'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadHint values -> RangeQuery keys -> m values
bsvhRangeRead ReadHint values
ReadHint values'
rhint (RangeQuery keys -> m values') -> RangeQuery keys -> m values'
forall a b. (a -> b) -> a -> b
$ Maybe keys -> Int -> RangeQuery keys
forall keys. Maybe keys -> Int -> RangeQuery keys
RangeQuery ((keys' -> keys) -> Maybe keys' -> Maybe keys
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap keys' -> keys
g Maybe keys'
prev) Int
count
    , bsvhRead :: ReadHint values' -> keys' -> m values'
bsvhRead = \ReadHint values'
rhint -> (values -> values') -> m values -> m values'
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap values -> values'
f (m values -> m values')
-> (keys' -> m values) -> keys' -> m values'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadHint values -> keys -> m values
bsvhRead ReadHint values
ReadHint values'
rhint (keys -> m values) -> (keys' -> keys) -> keys' -> m values
forall b c a. (b -> c) -> (a -> b) -> a -> c
. keys' -> keys
g
    , m Statistics
bsvhStat :: m Statistics
bsvhStat :: m Statistics
bsvhStat
    }
 where
  BackingStoreValueHandle
    { m ()
bsvhClose :: forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m ()
bsvhClose :: m ()
bsvhClose
    , ReadHint values -> m values
bsvhReadAll :: forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> m values
bsvhReadAll :: ReadHint values -> m values
bsvhReadAll
    , WithOrigin SlotNo
bsvhAtSlot :: forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot
    , ReadHint values -> RangeQuery keys -> m values
bsvhRangeRead :: forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> RangeQuery keys -> m values
bsvhRangeRead :: ReadHint values -> RangeQuery keys -> m values
bsvhRangeRead
    , ReadHint values -> keys -> m values
bsvhRead :: forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> keys -> m values
bsvhRead :: ReadHint values -> keys -> m values
bsvhRead
    , m Statistics
bsvhStat :: forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m Statistics
bsvhStat :: m Statistics
bsvhStat
    } = BackingStoreValueHandle m keys values
bsvh

-- | A combination of 'bsValueHandle' and 'bsvhRead'
bsRead ::
  MonadThrow m =>
  BackingStore m keys values diff ->
  ReadHint values ->
  keys ->
  m (WithOrigin SlotNo, values)
bsRead :: forall (m :: * -> *) keys values diff.
MonadThrow m =>
BackingStore m keys values diff
-> ReadHint values -> keys -> m (WithOrigin SlotNo, values)
bsRead BackingStore m keys values diff
store ReadHint values
rhint keys
keys = BackingStore m keys values diff
-> (BackingStoreValueHandle m keys values
    -> m (WithOrigin SlotNo, values))
-> m (WithOrigin SlotNo, values)
forall (m :: * -> *) keys values diff a.
MonadThrow m =>
BackingStore m keys values diff
-> (BackingStoreValueHandle m keys values -> m a) -> m a
withBsValueHandle BackingStore m keys values diff
store ((BackingStoreValueHandle m keys values
  -> m (WithOrigin SlotNo, values))
 -> m (WithOrigin SlotNo, values))
-> (BackingStoreValueHandle m keys values
    -> m (WithOrigin SlotNo, values))
-> m (WithOrigin SlotNo, values)
forall a b. (a -> b) -> a -> b
$ \BackingStoreValueHandle m keys values
vh -> do
  values <- BackingStoreValueHandle m keys values
-> ReadHint values -> keys -> m values
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> keys -> m values
bsvhRead BackingStoreValueHandle m keys values
vh ReadHint values
rhint keys
keys
  pure (bsvhAtSlot vh, values)

bsReadAll ::
  MonadThrow m =>
  BackingStore m keys values diff ->
  ReadHint values ->
  m values
bsReadAll :: forall (m :: * -> *) keys values diff.
MonadThrow m =>
BackingStore m keys values diff -> ReadHint values -> m values
bsReadAll BackingStore m keys values diff
store ReadHint values
rhint = BackingStore m keys values diff
-> (BackingStoreValueHandle m keys values -> m values) -> m values
forall (m :: * -> *) keys values diff a.
MonadThrow m =>
BackingStore m keys values diff
-> (BackingStoreValueHandle m keys values -> m a) -> m a
withBsValueHandle BackingStore m keys values diff
store ((BackingStoreValueHandle m keys values -> m values) -> m values)
-> (BackingStoreValueHandle m keys values -> m values) -> m values
forall a b. (a -> b) -> a -> b
$ \BackingStoreValueHandle m keys values
vh -> BackingStoreValueHandle m keys values
-> ReadHint values -> m values
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values
-> ReadHint values -> m values
bsvhReadAll BackingStoreValueHandle m keys values
vh ReadHint values
rhint

-- | A 'IOLike.bracket'ed 'bsValueHandle'
withBsValueHandle ::
  MonadThrow m =>
  BackingStore m keys values diff ->
  (BackingStoreValueHandle m keys values -> m a) ->
  m a
withBsValueHandle :: forall (m :: * -> *) keys values diff a.
MonadThrow m =>
BackingStore m keys values diff
-> (BackingStoreValueHandle m keys values -> m a) -> m a
withBsValueHandle BackingStore m keys values diff
store =
  m (BackingStoreValueHandle m keys values)
-> (BackingStoreValueHandle m keys values -> m ())
-> (BackingStoreValueHandle m keys values -> m a)
-> m a
forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c
forall (m :: * -> *) a b c.
MonadThrow m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (BackingStore m keys values diff
-> m (BackingStoreValueHandle m keys values)
forall (m :: * -> *) keys values diff.
BackingStore m keys values diff
-> m (BackingStoreValueHandle m keys values)
bsValueHandle BackingStore m keys values diff
store)
    BackingStoreValueHandle m keys values -> m ()
forall (m :: * -> *) keys values.
BackingStoreValueHandle m keys values -> m ()
bsvhClose

{-------------------------------------------------------------------------------
  Query
-------------------------------------------------------------------------------}

-- | The arguments for a query to the backing store, it is up to the particular
-- function that is performing the query to construct a value of this type, run
-- the query and, if appropriate, repeat this process to do a subsequent query.
data RangeQuery keys = RangeQuery
  { forall keys. RangeQuery keys -> Maybe keys
rqPrev :: !(Maybe keys)
  -- ^ The result of this range query begin at first key that is strictly
  -- greater than the greatest key in 'rqPrev'.
  --
  -- If the given set of keys is 'Just' but contains no keys, then the query
  -- will return no results. (This is the steady-state once a looping range
  -- query reaches the end of the table.)
  , forall keys. RangeQuery keys -> Int
rqCount :: !Int
  -- ^ Roughly how many values to read.
  --
  -- The query may return a different number of values than this even if it
  -- has not reached the last key. The only crucial invariant is that the
  -- query only returns an empty map if there are no more keys to read on
  -- disk, or if 'QueryBatchSize' consecutive values have been deleted in
  -- the changelog, which is extremely unlikely due to the random access
  -- pattern of the UTxO set.
  }
  deriving stock (Int -> RangeQuery keys -> ShowS
[RangeQuery keys] -> ShowS
RangeQuery keys -> String
(Int -> RangeQuery keys -> ShowS)
-> (RangeQuery keys -> String)
-> ([RangeQuery keys] -> ShowS)
-> Show (RangeQuery keys)
forall keys. Show keys => Int -> RangeQuery keys -> ShowS
forall keys. Show keys => [RangeQuery keys] -> ShowS
forall keys. Show keys => RangeQuery keys -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall keys. Show keys => Int -> RangeQuery keys -> ShowS
showsPrec :: Int -> RangeQuery keys -> ShowS
$cshow :: forall keys. Show keys => RangeQuery keys -> String
show :: RangeQuery keys -> String
$cshowList :: forall keys. Show keys => [RangeQuery keys] -> ShowS
showList :: [RangeQuery keys] -> ShowS
Show, RangeQuery keys -> RangeQuery keys -> Bool
(RangeQuery keys -> RangeQuery keys -> Bool)
-> (RangeQuery keys -> RangeQuery keys -> Bool)
-> Eq (RangeQuery keys)
forall keys. Eq keys => RangeQuery keys -> RangeQuery keys -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall keys. Eq keys => RangeQuery keys -> RangeQuery keys -> Bool
== :: RangeQuery keys -> RangeQuery keys -> Bool
$c/= :: forall keys. Eq keys => RangeQuery keys -> RangeQuery keys -> Bool
/= :: RangeQuery keys -> RangeQuery keys -> Bool
Eq)

{-------------------------------------------------------------------------------
  Statistics
-------------------------------------------------------------------------------}

-- | Statistics for a key-value store.
--
-- Using 'bsvhStat' on a value handle only provides statistics for the on-disk
-- state of a key-value store. Combine this with information from a
-- 'DbChangelog' to obtain statistics about a "logical" state of the key-value
-- store. See 'getStatistics'.
data Statistics = Statistics
  { Statistics -> WithOrigin SlotNo
sequenceNumber :: !(WithOrigin SlotNo)
  -- ^ The last slot number for which key-value pairs were stored.
  --
  -- INVARIANT: the 'sequenceNumber' returned by using 'bsvhStat' on a value
  -- handle should match 'bsvhAtSlot' for that same value handle.
  , Statistics -> Int
numEntries :: !Int
  -- ^ The total number of key-value pair entries that are stored.
  }
  deriving stock (Int -> Statistics -> ShowS
[Statistics] -> ShowS
Statistics -> String
(Int -> Statistics -> ShowS)
-> (Statistics -> String)
-> ([Statistics] -> ShowS)
-> Show Statistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Statistics -> ShowS
showsPrec :: Int -> Statistics -> ShowS
$cshow :: Statistics -> String
show :: Statistics -> String
$cshowList :: [Statistics] -> ShowS
showList :: [Statistics] -> ShowS
Show, Statistics -> Statistics -> Bool
(Statistics -> Statistics -> Bool)
-> (Statistics -> Statistics -> Bool) -> Eq Statistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Statistics -> Statistics -> Bool
== :: Statistics -> Statistics -> Bool
$c/= :: Statistics -> Statistics -> Bool
/= :: Statistics -> Statistics -> Bool
Eq)

{-------------------------------------------------------------------------------
  Tracing
-------------------------------------------------------------------------------}

data BackingStoreTrace
  = BSOpening
  | BSOpened !(Maybe FS.FsPath)
  | BSInitialisingFromCopy !FS.FsPath
  | BSInitialisedFromCopy !FS.FsPath
  | BSInitialisingFromValues !(WithOrigin SlotNo)
  | BSInitialisedFromValues !(WithOrigin SlotNo)
  | BSClosing
  | BSAlreadyClosed
  | BSClosed
  | BSCopying !FS.FsPath
  | BSCopied !FS.FsPath
  | BSCreatingValueHandle
  | BSValueHandleTrace
      -- | The index of the value handle
      !(Maybe Int)
      !BackingStoreValueHandleTrace
  | BSCreatedValueHandle
  | BSWriting !SlotNo
  | BSWritten !(WithOrigin SlotNo) !SlotNo
  deriving (BackingStoreTrace -> BackingStoreTrace -> Bool
(BackingStoreTrace -> BackingStoreTrace -> Bool)
-> (BackingStoreTrace -> BackingStoreTrace -> Bool)
-> Eq BackingStoreTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackingStoreTrace -> BackingStoreTrace -> Bool
== :: BackingStoreTrace -> BackingStoreTrace -> Bool
$c/= :: BackingStoreTrace -> BackingStoreTrace -> Bool
/= :: BackingStoreTrace -> BackingStoreTrace -> Bool
Eq, Int -> BackingStoreTrace -> ShowS
[BackingStoreTrace] -> ShowS
BackingStoreTrace -> String
(Int -> BackingStoreTrace -> ShowS)
-> (BackingStoreTrace -> String)
-> ([BackingStoreTrace] -> ShowS)
-> Show BackingStoreTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackingStoreTrace -> ShowS
showsPrec :: Int -> BackingStoreTrace -> ShowS
$cshow :: BackingStoreTrace -> String
show :: BackingStoreTrace -> String
$cshowList :: [BackingStoreTrace] -> ShowS
showList :: [BackingStoreTrace] -> ShowS
Show)

data BackingStoreValueHandleTrace
  = BSVHClosing
  | BSVHAlreadyClosed
  | BSVHClosed
  | BSVHRangeReading
  | BSVHRangeRead
  | BSVHReading
  | BSVHRead
  | BSVHStatting
  | BSVHStatted
  deriving (BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
(BackingStoreValueHandleTrace
 -> BackingStoreValueHandleTrace -> Bool)
-> (BackingStoreValueHandleTrace
    -> BackingStoreValueHandleTrace -> Bool)
-> Eq BackingStoreValueHandleTrace
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
== :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
$c/= :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
/= :: BackingStoreValueHandleTrace
-> BackingStoreValueHandleTrace -> Bool
Eq, Int -> BackingStoreValueHandleTrace -> ShowS
[BackingStoreValueHandleTrace] -> ShowS
BackingStoreValueHandleTrace -> String
(Int -> BackingStoreValueHandleTrace -> ShowS)
-> (BackingStoreValueHandleTrace -> String)
-> ([BackingStoreValueHandleTrace] -> ShowS)
-> Show BackingStoreValueHandleTrace
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BackingStoreValueHandleTrace -> ShowS
showsPrec :: Int -> BackingStoreValueHandleTrace -> ShowS
$cshow :: BackingStoreValueHandleTrace -> String
show :: BackingStoreValueHandleTrace -> String
$cshowList :: [BackingStoreValueHandleTrace] -> ShowS
showList :: [BackingStoreValueHandleTrace] -> ShowS
Show)