{-# 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.Bifunctor
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 key values diff = BackingStore
  { forall (m :: * -> *) keys key values diff.
BackingStore m keys key 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 key values diff.
BackingStore m keys key 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 key values diff.
BackingStore m keys key values diff
-> m (BackingStoreValueHandle m keys key values)
bsValueHandle :: !(m (BackingStoreValueHandle m keys key values))
  -- ^ Open a 'BackingStoreValueHandle' capturing the current value of the
  -- entire database
  , forall (m :: * -> *) keys key values diff.
BackingStore m keys key 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 key values diff.
BackingStore m keys key 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 key values diff)
  instance
    NoThunks (BackingStore m keys key values diff)

type LedgerBackingStore m l =
  BackingStore
    m
    (LedgerTables l KeysMK)
    (TxIn l)
    (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 key values = BackingStoreValueHandle
  { forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> WithOrigin SlotNo
bsvhAtSlot :: !(WithOrigin SlotNo)
  -- ^ At which slot this handle was created
  , forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m ()
bsvhClose :: !(m ())
  -- ^ Close the handle
  --
  -- Other methods throw exceptions if called on a closed handle. 'bsvhClose'
  -- itself is idempotent.
  , forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead :: !(ReadHint values -> RangeQuery keys -> m (values, Maybe key))
  -- ^ See 'RangeQuery'
  , forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key 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 key values.
BackingStoreValueHandle m keys key 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 key values.
BackingStoreValueHandle m keys key values -> m Statistics
bsvhStat :: !(m Statistics)
  -- ^ Retrieve statistics
  }

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

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

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

castBackingStoreValueHandle ::
  (Functor m, ReadHint values ~ ReadHint values') =>
  (values -> values') ->
  (keys' -> keys) ->
  (key -> key') ->
  BackingStoreValueHandle m keys key values ->
  BackingStoreValueHandle m keys' key' values'
castBackingStoreValueHandle :: forall (m :: * -> *) values values' keys' keys key key'.
(Functor m, ReadHint values ~ ReadHint values') =>
(values -> values')
-> (keys' -> keys)
-> (key -> key')
-> BackingStoreValueHandle m keys key values
-> BackingStoreValueHandle m keys' key' values'
castBackingStoreValueHandle values -> values'
f keys' -> keys
g key -> key'
h BackingStoreValueHandle m keys key 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', Maybe key')
bsvhRangeRead = \ReadHint values'
rhint (RangeQuery Maybe keys'
prev Int
count) ->
        ((values, Maybe key) -> (values', Maybe key'))
-> m (values, Maybe key) -> m (values', Maybe key')
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe key -> Maybe key')
-> (values', Maybe key) -> (values', Maybe key')
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second ((key -> key') -> Maybe key -> Maybe key'
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap key -> key'
h) ((values', Maybe key) -> (values', Maybe key'))
-> ((values, Maybe key) -> (values', Maybe key))
-> (values, Maybe key)
-> (values', Maybe key')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (values -> values') -> (values, Maybe key) -> (values', Maybe key)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first values -> values'
f) (m (values, Maybe key) -> m (values', Maybe key'))
-> (RangeQuery keys -> m (values, Maybe key))
-> RangeQuery keys
-> m (values', Maybe key')
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead ReadHint values
ReadHint values'
rhint (RangeQuery keys -> m (values', Maybe key'))
-> RangeQuery keys -> m (values', Maybe key')
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 key values.
BackingStoreValueHandle m keys key values -> m ()
bsvhClose :: m ()
bsvhClose
    , ReadHint values -> m values
bsvhReadAll :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> m values
bsvhReadAll :: ReadHint values -> m values
bsvhReadAll
    , WithOrigin SlotNo
bsvhAtSlot :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> WithOrigin SlotNo
bsvhAtSlot :: WithOrigin SlotNo
bsvhAtSlot
    , ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead :: ReadHint values -> RangeQuery keys -> m (values, Maybe key)
bsvhRangeRead
    , ReadHint values -> keys -> m values
bsvhRead :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values
-> ReadHint values -> keys -> m values
bsvhRead :: ReadHint values -> keys -> m values
bsvhRead
    , m Statistics
bsvhStat :: forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key values -> m Statistics
bsvhStat :: m Statistics
bsvhStat
    } = BackingStoreValueHandle m keys key values
bsvh

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

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

-- | A 'IOLike.bracket'ed 'bsValueHandle'
withBsValueHandle ::
  MonadThrow m =>
  BackingStore m keys key values diff ->
  (BackingStoreValueHandle m keys key values -> m a) ->
  m a
withBsValueHandle :: forall (m :: * -> *) keys key values diff a.
MonadThrow m =>
BackingStore m keys key values diff
-> (BackingStoreValueHandle m keys key values -> m a) -> m a
withBsValueHandle BackingStore m keys key values diff
store =
  m (BackingStoreValueHandle m keys key values)
-> (BackingStoreValueHandle m keys key values -> m ())
-> (BackingStoreValueHandle m keys key 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 key values diff
-> m (BackingStoreValueHandle m keys key values)
forall (m :: * -> *) keys key values diff.
BackingStore m keys key values diff
-> m (BackingStoreValueHandle m keys key values)
bsValueHandle BackingStore m keys key values diff
store)
    BackingStoreValueHandle m keys key values -> m ()
forall (m :: * -> *) keys key values.
BackingStoreValueHandle m keys key 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)