{-# LANGUAGE BangPatterns               #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}
{-# LANGUAGE UndecidableInstances       #-}

-- | Types used throughout the implementation: handle, state, environment,
-- types, trace types, etc.
module Ouroboros.Consensus.Storage.ChainDB.Impl.Types (
    SerialiseDiskConstraints
  , ChainDbHandle (..)
  , getEnv
  , getEnv1
  , getEnv2
  , getEnvSTM
  , getEnvSTM1
  , ChainDbState (..)
  , ChainDbEnv (..)
    -- * Exposed internals for testing purposes
  , Internal (..)
    -- * Iterator-related
  , IteratorKey (..)
    -- * Reader-related
  , ReaderKey (..)
  , ReaderHandle (..)
  , ReaderState (..)
  , ReaderRollState (..)
  , readerRollStatePoint
    -- * Invalid blocks
  , InvalidBlocks
  , InvalidBlockInfo (..)
    -- * Future blocks
  , FutureBlocks
    -- * Blocks to add
  , BlocksToAdd
  , BlockToAdd (..)
  , newBlocksToAdd
  , addBlockToAdd
  , getBlockToAdd
    -- * Trace types
  , TraceEvent (..)
  , NewTipInfo (..)
  , TraceAddBlockEvent (..)
  , TraceReaderEvent (..)
  , TraceCopyToImmutableDBEvent (..)
  , TraceGCEvent (..)
  , TraceValidationEvent (..)
  , TraceInitChainSelEvent (..)
  , TraceOpenEvent (..)
  , TraceIteratorEvent (..)
  ) where

import           Control.Tracer
import           Data.Map.Strict (Map)
import           Data.Typeable
import           Data.Void (Void)
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (OnlyCheckWhnfNamed (..))

import           Control.Monad.Class.MonadSTM.Strict (newEmptyTMVarIO)

import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Fragment.Diff (ChainDiff)
import           Ouroboros.Consensus.Fragment.InFuture (CheckInFuture)
import           Ouroboros.Consensus.Ledger.Extended (ExtValidationError)
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Util.CallStack
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.ResourceRegistry
import           Ouroboros.Consensus.Util.STM (WithFingerprint)

import           Ouroboros.Consensus.Storage.ChainDB.API (AddBlockPromise (..),
                     ChainDbError (..), InvalidBlockReason, StreamFrom,
                     StreamTo, UnknownRange)
import           Ouroboros.Consensus.Storage.Serialisation

import           Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB (LedgerDB',
                     LgrDB, LgrDbSerialiseConstraints)
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB as LgrDB
import           Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB,
                     ImmutableDbSerialiseConstraints)
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
import           Ouroboros.Consensus.Storage.VolatileDB (VolatileDB,
                     VolatileDbSerialiseConstraints)
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB

-- | All the serialisation related constraints needed by the ChainDB.
class ( ImmutableDbSerialiseConstraints blk
      , LgrDbSerialiseConstraints blk
      , VolatileDbSerialiseConstraints blk
        -- Needed for Reader
      , EncodeDiskDep (NestedCtxt Header) blk
      ) => SerialiseDiskConstraints blk

-- | A handle to the internal ChainDB state
newtype ChainDbHandle m blk = CDBHandle (StrictTVar m (ChainDbState m blk))

-- | Check if the ChainDB is open, if so, executing the given function on the
-- 'ChainDbEnv', otherwise, throw a 'CloseDBError'.
getEnv :: forall m blk r. (IOLike m, HasCallStack)
       => ChainDbHandle m blk
       -> (ChainDbEnv m blk -> m r)
       -> m r
getEnv :: ChainDbHandle m blk -> (ChainDbEnv m blk -> m r) -> m r
getEnv (CDBHandle StrictTVar m (ChainDbState m blk)
varState) ChainDbEnv m blk -> m r
f = STM m (ChainDbState m blk) -> m (ChainDbState m blk)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar m (ChainDbState m blk) -> STM m (ChainDbState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (ChainDbState m blk)
varState) m (ChainDbState m blk) -> (ChainDbState m blk -> m r) -> m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ChainDbOpen ChainDbEnv m blk
env -> ChainDbEnv m blk -> m r
f ChainDbEnv m blk
env
    ChainDbState m blk
ChainDbClosed   -> ChainDbError -> m r
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (ChainDbError -> m r) -> ChainDbError -> m r
forall a b. (a -> b) -> a -> b
$ PrettyCallStack -> ChainDbError
ClosedDBError PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

-- | Variant 'of 'getEnv' for functions taking one argument.
getEnv1 :: (IOLike m, HasCallStack)
        => ChainDbHandle m blk
        -> (ChainDbEnv m blk -> a -> m r)
        -> a -> m r
getEnv1 :: ChainDbHandle m blk -> (ChainDbEnv m blk -> a -> m r) -> a -> m r
getEnv1 ChainDbHandle m blk
h ChainDbEnv m blk -> a -> m r
f a
a = ChainDbHandle m blk -> (ChainDbEnv m blk -> m r) -> m r
forall (m :: * -> *) blk r.
(IOLike m, HasCallStack) =>
ChainDbHandle m blk -> (ChainDbEnv m blk -> m r) -> m r
getEnv ChainDbHandle m blk
h (\ChainDbEnv m blk
env -> ChainDbEnv m blk -> a -> m r
f ChainDbEnv m blk
env a
a)

-- | Variant 'of 'getEnv' for functions taking two arguments.
getEnv2 :: (IOLike m, HasCallStack)
        => ChainDbHandle m blk
        -> (ChainDbEnv m blk -> a -> b -> m r)
        -> a -> b -> m r
getEnv2 :: ChainDbHandle m blk
-> (ChainDbEnv m blk -> a -> b -> m r) -> a -> b -> m r
getEnv2 ChainDbHandle m blk
h ChainDbEnv m blk -> a -> b -> m r
f a
a b
b = ChainDbHandle m blk -> (ChainDbEnv m blk -> m r) -> m r
forall (m :: * -> *) blk r.
(IOLike m, HasCallStack) =>
ChainDbHandle m blk -> (ChainDbEnv m blk -> m r) -> m r
getEnv ChainDbHandle m blk
h (\ChainDbEnv m blk
env -> ChainDbEnv m blk -> a -> b -> m r
f ChainDbEnv m blk
env a
a b
b)


-- | Variant of 'getEnv' that works in 'STM'.
getEnvSTM :: forall m blk r. (IOLike m, HasCallStack)
          => ChainDbHandle m blk
          -> (ChainDbEnv m blk -> STM m r)
          -> STM m r
getEnvSTM :: ChainDbHandle m blk -> (ChainDbEnv m blk -> STM m r) -> STM m r
getEnvSTM (CDBHandle StrictTVar m (ChainDbState m blk)
varState) ChainDbEnv m blk -> STM m r
f = StrictTVar m (ChainDbState m blk) -> STM m (ChainDbState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (ChainDbState m blk)
varState STM m (ChainDbState m blk)
-> (ChainDbState m blk -> STM m r) -> STM m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ChainDbOpen ChainDbEnv m blk
env -> ChainDbEnv m blk -> STM m r
f ChainDbEnv m blk
env
    ChainDbState m blk
ChainDbClosed   -> ChainDbError -> STM m r
forall (stm :: * -> *) e a.
(MonadSTMTx stm, MonadThrow stm, Exception e) =>
e -> stm a
throwSTM (ChainDbError -> STM m r) -> ChainDbError -> STM m r
forall a b. (a -> b) -> a -> b
$ PrettyCallStack -> ChainDbError
ClosedDBError PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

-- | Variant of 'getEnv1' that works in 'STM'.
getEnvSTM1 ::
     (IOLike m, HasCallStack)
  => ChainDbHandle m blk
  -> (ChainDbEnv m blk -> a -> STM m r)
  -> a -> STM m r
getEnvSTM1 :: ChainDbHandle m blk
-> (ChainDbEnv m blk -> a -> STM m r) -> a -> STM m r
getEnvSTM1 (CDBHandle StrictTVar m (ChainDbState m blk)
varState) ChainDbEnv m blk -> a -> STM m r
f a
a = StrictTVar m (ChainDbState m blk) -> STM m (ChainDbState m blk)
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (ChainDbState m blk)
varState STM m (ChainDbState m blk)
-> (ChainDbState m blk -> STM m r) -> STM m r
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    ChainDbOpen ChainDbEnv m blk
env -> ChainDbEnv m blk -> a -> STM m r
f ChainDbEnv m blk
env a
a
    ChainDbState m blk
ChainDbClosed   -> ChainDbError -> STM m r
forall (stm :: * -> *) e a.
(MonadSTMTx stm, MonadThrow stm, Exception e) =>
e -> stm a
throwSTM (ChainDbError -> STM m r) -> ChainDbError -> STM m r
forall a b. (a -> b) -> a -> b
$ PrettyCallStack -> ChainDbError
ClosedDBError PrettyCallStack
HasCallStack => PrettyCallStack
prettyCallStack

data ChainDbState m blk
  = ChainDbOpen   !(ChainDbEnv m blk)
  | ChainDbClosed
  deriving ((forall x. ChainDbState m blk -> Rep (ChainDbState m blk) x)
-> (forall x. Rep (ChainDbState m blk) x -> ChainDbState m blk)
-> Generic (ChainDbState m blk)
forall x. Rep (ChainDbState m blk) x -> ChainDbState m blk
forall x. ChainDbState m blk -> Rep (ChainDbState m blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk x.
Rep (ChainDbState m blk) x -> ChainDbState m blk
forall (m :: * -> *) blk x.
ChainDbState m blk -> Rep (ChainDbState m blk) x
$cto :: forall (m :: * -> *) blk x.
Rep (ChainDbState m blk) x -> ChainDbState m blk
$cfrom :: forall (m :: * -> *) blk x.
ChainDbState m blk -> Rep (ChainDbState m blk) x
Generic, Context -> ChainDbState m blk -> IO (Maybe ThunkInfo)
Proxy (ChainDbState m blk) -> String
(Context -> ChainDbState m blk -> IO (Maybe ThunkInfo))
-> (Context -> ChainDbState m blk -> IO (Maybe ThunkInfo))
-> (Proxy (ChainDbState m blk) -> String)
-> NoThunks (ChainDbState m blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
Context -> ChainDbState m blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
Proxy (ChainDbState m blk) -> String
showTypeOf :: Proxy (ChainDbState m blk) -> String
$cshowTypeOf :: forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
Proxy (ChainDbState m blk) -> String
wNoThunks :: Context -> ChainDbState m blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
Context -> ChainDbState m blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> ChainDbState m blk -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk) =>
Context -> ChainDbState m blk -> IO (Maybe ThunkInfo)
NoThunks)

data ChainDbEnv m blk = CDB
  { ChainDbEnv m blk -> ImmutableDB m blk
cdbImmutableDB     :: !(ImmutableDB m blk)
  , ChainDbEnv m blk -> VolatileDB m blk
cdbVolatileDB      :: !(VolatileDB m blk)
  , ChainDbEnv m blk -> LgrDB m blk
cdbLgrDB           :: !(LgrDB m blk)
  , ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbChain           :: !(StrictTVar m (AnchoredFragment (Header blk)))
    -- ^ Contains the current chain fragment.
    --
    -- INVARIANT: the anchor point of this fragment is the tip of the
    -- ImmutableDB. This implies that this fragment never contains any blocks
    -- that are stored in the immutable DB.
    --
    -- Note that this fragment might be shorter than @k@ headers when the
    -- whole chain is shorter than @k@ or in case of corruption of the
    -- VolatileDB.
    --
    -- Note that this fragment might also be /longer/ than @k@ headers,
    -- because the oldest blocks from the fragment might not yet have been
    -- copied from the VolatileDB to the ImmutableDB.
    --
    -- The anchor point of this chain should be the most recent \"immutable\"
    -- block according to the protocol, i.e., a block that cannot be rolled
    -- back.
    --
    -- Note that the \"immutable\" block isn't necessarily at the tip of the
    -- ImmutableDB, but could temporarily still be on the in-memory chain
    -- fragment. When the background thread that copies blocks to the
    -- ImmutableDB has caught up, the \"immutable\" block will be at the tip
    -- of the ImmutableDB again.
    --
    -- Note that the \"immutable\" block might be less than @k@ blocks from
    -- our tip in case the whole chain is shorter than @k@ or in case of
    -- corruption of the VolatileDB.
    --
    -- Note that the \"immutable\" block will /never/ be /more/ than @k@
    -- blocks back, as opposed to the anchor point of 'cdbChain'.
  , ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbIterators       :: !(StrictTVar m (Map IteratorKey (m ())))
    -- ^ The iterators.
    --
    -- This maps the 'IteratorKey's of each open 'Iterator' to a function
    -- that, when called, closes the iterator. This is used when closing the
    -- ChainDB: the open file handles used by iterators can be closed, and the
    -- iterators themselves are closed so that it is impossible to use an
    -- iterator after closing the ChainDB itself.
  , ChainDbEnv m blk
-> StrictTVar m (Map ReaderKey (ReaderHandle m blk))
cdbReaders         :: !(StrictTVar m (Map ReaderKey (ReaderHandle m blk)))
    -- ^ The readers.
    --
    -- A reader is open iff its 'ReaderKey' is this 'Map'.
    --
    -- INVARIANT: the 'readerPoint' of each reader is 'withinFragmentBounds'
    -- of the current chain fragment (retrieved 'cdbGetCurrentChain', not by
    -- reading 'cdbChain' directly).
  , ChainDbEnv m blk -> TopLevelConfig blk
cdbTopLevelConfig  :: !(TopLevelConfig blk)
  , ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbInvalid         :: !(StrictTVar m (WithFingerprint (InvalidBlocks blk)))
    -- ^ See the docstring of 'InvalidBlocks'.
    --
    -- The 'Fingerprint' changes every time a hash is added to the map, but
    -- not when hashes are garbage-collected from the map.
  , ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbNextIteratorKey :: !(StrictTVar m IteratorKey)
  , ChainDbEnv m blk -> StrictTVar m ReaderKey
cdbNextReaderKey   :: !(StrictTVar m ReaderKey)
  , ChainDbEnv m blk -> StrictMVar m ()
cdbCopyLock        :: !(StrictMVar m ())
    -- ^ Lock used to ensure that 'copyToImmutableDB' is not executed more than
    -- once concurrently.
    --
    -- Note that 'copyToImmutableDB' can still be executed concurrently with all
    -- others functions, just not with itself.
  , ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbTracer          :: !(Tracer m (TraceEvent blk))
  , ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTraceLedger     :: !(Tracer m (LedgerDB' blk))
  , ChainDbEnv m blk -> ResourceRegistry m
cdbRegistry        :: !(ResourceRegistry m)
    -- ^ Resource registry that will be used to (re)start the background
    -- threads, see 'cdbBgThreads'.
  , ChainDbEnv m blk -> DiffTime
cdbGcDelay         :: !DiffTime
    -- ^ How long to wait between copying a block from the VolatileDB to
    -- ImmutableDB and garbage collecting it from the VolatileDB
  , ChainDbEnv m blk -> DiffTime
cdbGcInterval      :: !DiffTime
    -- ^ Minimum time between two garbage collections. Is used to batch
    -- garbage collections.
  , ChainDbEnv m blk -> StrictTVar m (m ())
cdbKillBgThreads   :: !(StrictTVar m (m ()))
    -- ^ A handle to kill the background threads.
  , ChainDbEnv m blk -> ChunkInfo
cdbChunkInfo       :: !ImmutableDB.ChunkInfo
  , ChainDbEnv m blk -> blk -> Bool
cdbCheckIntegrity  :: !(blk -> Bool)
  , ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckInFuture   :: !(CheckInFuture m blk)
  , ChainDbEnv m blk -> BlocksToAdd m blk
cdbBlocksToAdd     :: !(BlocksToAdd m blk)
    -- ^ Queue of blocks that still have to be added.
  , ChainDbEnv m blk -> StrictTVar m (FutureBlocks blk)
cdbFutureBlocks    :: !(StrictTVar m (FutureBlocks blk))
    -- ^ Blocks from the future
    --
    -- Blocks that were added to the ChainDB but that were from the future
    -- according to 'CheckInFuture', without exceeding the clock skew
    -- ('inFutureExceedsClockSkew'). Blocks exceeding the clock skew are
    -- considered to be invalid ('InFutureExceedsClockSkew') and will be added
    -- 'cdbInvalid'.
    --
    -- Whenever a block is added to the ChainDB, we first trigger chain
    -- selection for all the blocks in this map so that blocks no longer from
    -- the future can get adopted. Note that when no blocks are added to the
    -- ChainDB, we will /not/ actively trigger chain selection for the blocks
    -- in this map.
    --
    -- The number of blocks from the future is bounded by the number of
    -- upstream peers multiplied by the max clock skew divided by the slot
    -- length.
  } deriving ((forall x. ChainDbEnv m blk -> Rep (ChainDbEnv m blk) x)
-> (forall x. Rep (ChainDbEnv m blk) x -> ChainDbEnv m blk)
-> Generic (ChainDbEnv m blk)
forall x. Rep (ChainDbEnv m blk) x -> ChainDbEnv m blk
forall x. ChainDbEnv m blk -> Rep (ChainDbEnv m blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk x.
Rep (ChainDbEnv m blk) x -> ChainDbEnv m blk
forall (m :: * -> *) blk x.
ChainDbEnv m blk -> Rep (ChainDbEnv m blk) x
$cto :: forall (m :: * -> *) blk x.
Rep (ChainDbEnv m blk) x -> ChainDbEnv m blk
$cfrom :: forall (m :: * -> *) blk x.
ChainDbEnv m blk -> Rep (ChainDbEnv m blk) x
Generic)

-- | We include @blk@ in 'showTypeOf' because it helps resolving type families
-- (but avoid including @m@ because we cannot impose @Typeable m@ as a
-- constraint and still have it work with the simulator)
instance (IOLike m, LedgerSupportsProtocol blk)
      => NoThunks (ChainDbEnv m blk) where
    showTypeOf :: Proxy (ChainDbEnv m blk) -> String
showTypeOf Proxy (ChainDbEnv m blk)
_ = String
"ChainDbEnv m " String -> String -> String
forall a. [a] -> [a] -> [a]
++ TypeRep -> String
forall a. Show a => a -> String
show (Proxy blk -> TypeRep
forall k (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy blk
forall k (t :: k). Proxy t
Proxy @blk))

{-------------------------------------------------------------------------------
  Exposed internals for testing purposes
-------------------------------------------------------------------------------}

data Internal m blk = Internal
  { Internal m blk -> m (WithOrigin SlotNo)
intCopyToImmutableDB     :: m (WithOrigin SlotNo)
    -- ^ Copy the blocks older than @k@ from to the VolatileDB to the
    -- ImmutableDB and update the in-memory chain fragment correspondingly.
    --
    -- The 'SlotNo' of the tip of the ImmutableDB after copying the blocks is
    -- returned. This can be used for a garbage collection on the VolatileDB.
  , Internal m blk -> SlotNo -> m ()
intGarbageCollect        :: SlotNo -> m ()
    -- ^ Perform garbage collection for blocks <= the given 'SlotNo'.
  , Internal m blk -> m ()
intUpdateLedgerSnapshots :: m ()
    -- ^ Write a new LedgerDB snapshot to disk and remove the oldest one(s).
  , Internal m blk -> m Void
intAddBlockRunner        :: m Void
    -- ^ Start the loop that adds blocks to the ChainDB retrieved from the
    -- queue populated by 'ChainDB.addBlock'. Execute this loop in a separate
    -- thread.
  , Internal m blk -> StrictTVar m (m ())
intKillBgThreads         :: StrictTVar m (m ())
    -- ^ A handle to kill the background threads.
  }

{-------------------------------------------------------------------------------
  Iterator-related
-------------------------------------------------------------------------------}

-- | We use this internally to track iterators in a map ('cdbIterators') in
-- the ChainDB state so that we can remove them from the map when the iterator
-- is closed.
--
-- We store them in the map so that the ChainDB can close all open iterators
-- when it is closed itself.
newtype IteratorKey = IteratorKey Word
  deriving stock   (Int -> IteratorKey -> String -> String
[IteratorKey] -> String -> String
IteratorKey -> String
(Int -> IteratorKey -> String -> String)
-> (IteratorKey -> String)
-> ([IteratorKey] -> String -> String)
-> Show IteratorKey
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [IteratorKey] -> String -> String
$cshowList :: [IteratorKey] -> String -> String
show :: IteratorKey -> String
$cshow :: IteratorKey -> String
showsPrec :: Int -> IteratorKey -> String -> String
$cshowsPrec :: Int -> IteratorKey -> String -> String
Show)
  deriving newtype (IteratorKey -> IteratorKey -> Bool
(IteratorKey -> IteratorKey -> Bool)
-> (IteratorKey -> IteratorKey -> Bool) -> Eq IteratorKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IteratorKey -> IteratorKey -> Bool
$c/= :: IteratorKey -> IteratorKey -> Bool
== :: IteratorKey -> IteratorKey -> Bool
$c== :: IteratorKey -> IteratorKey -> Bool
Eq, Eq IteratorKey
Eq IteratorKey
-> (IteratorKey -> IteratorKey -> Ordering)
-> (IteratorKey -> IteratorKey -> Bool)
-> (IteratorKey -> IteratorKey -> Bool)
-> (IteratorKey -> IteratorKey -> Bool)
-> (IteratorKey -> IteratorKey -> Bool)
-> (IteratorKey -> IteratorKey -> IteratorKey)
-> (IteratorKey -> IteratorKey -> IteratorKey)
-> Ord IteratorKey
IteratorKey -> IteratorKey -> Bool
IteratorKey -> IteratorKey -> Ordering
IteratorKey -> IteratorKey -> IteratorKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: IteratorKey -> IteratorKey -> IteratorKey
$cmin :: IteratorKey -> IteratorKey -> IteratorKey
max :: IteratorKey -> IteratorKey -> IteratorKey
$cmax :: IteratorKey -> IteratorKey -> IteratorKey
>= :: IteratorKey -> IteratorKey -> Bool
$c>= :: IteratorKey -> IteratorKey -> Bool
> :: IteratorKey -> IteratorKey -> Bool
$c> :: IteratorKey -> IteratorKey -> Bool
<= :: IteratorKey -> IteratorKey -> Bool
$c<= :: IteratorKey -> IteratorKey -> Bool
< :: IteratorKey -> IteratorKey -> Bool
$c< :: IteratorKey -> IteratorKey -> Bool
compare :: IteratorKey -> IteratorKey -> Ordering
$ccompare :: IteratorKey -> IteratorKey -> Ordering
$cp1Ord :: Eq IteratorKey
Ord, Int -> IteratorKey
IteratorKey -> Int
IteratorKey -> [IteratorKey]
IteratorKey -> IteratorKey
IteratorKey -> IteratorKey -> [IteratorKey]
IteratorKey -> IteratorKey -> IteratorKey -> [IteratorKey]
(IteratorKey -> IteratorKey)
-> (IteratorKey -> IteratorKey)
-> (Int -> IteratorKey)
-> (IteratorKey -> Int)
-> (IteratorKey -> [IteratorKey])
-> (IteratorKey -> IteratorKey -> [IteratorKey])
-> (IteratorKey -> IteratorKey -> [IteratorKey])
-> (IteratorKey -> IteratorKey -> IteratorKey -> [IteratorKey])
-> Enum IteratorKey
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: IteratorKey -> IteratorKey -> IteratorKey -> [IteratorKey]
$cenumFromThenTo :: IteratorKey -> IteratorKey -> IteratorKey -> [IteratorKey]
enumFromTo :: IteratorKey -> IteratorKey -> [IteratorKey]
$cenumFromTo :: IteratorKey -> IteratorKey -> [IteratorKey]
enumFromThen :: IteratorKey -> IteratorKey -> [IteratorKey]
$cenumFromThen :: IteratorKey -> IteratorKey -> [IteratorKey]
enumFrom :: IteratorKey -> [IteratorKey]
$cenumFrom :: IteratorKey -> [IteratorKey]
fromEnum :: IteratorKey -> Int
$cfromEnum :: IteratorKey -> Int
toEnum :: Int -> IteratorKey
$ctoEnum :: Int -> IteratorKey
pred :: IteratorKey -> IteratorKey
$cpred :: IteratorKey -> IteratorKey
succ :: IteratorKey -> IteratorKey
$csucc :: IteratorKey -> IteratorKey
Enum, Context -> IteratorKey -> IO (Maybe ThunkInfo)
Proxy IteratorKey -> String
(Context -> IteratorKey -> IO (Maybe ThunkInfo))
-> (Context -> IteratorKey -> IO (Maybe ThunkInfo))
-> (Proxy IteratorKey -> String)
-> NoThunks IteratorKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy IteratorKey -> String
$cshowTypeOf :: Proxy IteratorKey -> String
wNoThunks :: Context -> IteratorKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> IteratorKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> IteratorKey -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> IteratorKey -> IO (Maybe ThunkInfo)
NoThunks)

{-------------------------------------------------------------------------------
  Reader-related
-------------------------------------------------------------------------------}

-- Note: these things are not in the Reader module, because 'TraceEvent'
-- depends on them, 'ChainDbEnv.cdbTracer' depends on 'TraceEvent', and most
-- modules depend on 'ChainDbEnv'. Also, 'ChainDbEnv.cdbReaders' depends on
-- 'ReaderState'.

-- | We use this internally to track reader in a map ('cdbReaders') in the
-- ChainDB state so that we can remove them from the map when the reader is
-- closed.
--
-- We store them in the map so that the ChainDB can close all open readers
-- when it is closed itself and to update the readers in case we switch to a
-- different chain.
newtype ReaderKey = ReaderKey Word
  deriving stock   (Int -> ReaderKey -> String -> String
[ReaderKey] -> String -> String
ReaderKey -> String
(Int -> ReaderKey -> String -> String)
-> (ReaderKey -> String)
-> ([ReaderKey] -> String -> String)
-> Show ReaderKey
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReaderKey] -> String -> String
$cshowList :: [ReaderKey] -> String -> String
show :: ReaderKey -> String
$cshow :: ReaderKey -> String
showsPrec :: Int -> ReaderKey -> String -> String
$cshowsPrec :: Int -> ReaderKey -> String -> String
Show)
  deriving newtype (ReaderKey -> ReaderKey -> Bool
(ReaderKey -> ReaderKey -> Bool)
-> (ReaderKey -> ReaderKey -> Bool) -> Eq ReaderKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReaderKey -> ReaderKey -> Bool
$c/= :: ReaderKey -> ReaderKey -> Bool
== :: ReaderKey -> ReaderKey -> Bool
$c== :: ReaderKey -> ReaderKey -> Bool
Eq, Eq ReaderKey
Eq ReaderKey
-> (ReaderKey -> ReaderKey -> Ordering)
-> (ReaderKey -> ReaderKey -> Bool)
-> (ReaderKey -> ReaderKey -> Bool)
-> (ReaderKey -> ReaderKey -> Bool)
-> (ReaderKey -> ReaderKey -> Bool)
-> (ReaderKey -> ReaderKey -> ReaderKey)
-> (ReaderKey -> ReaderKey -> ReaderKey)
-> Ord ReaderKey
ReaderKey -> ReaderKey -> Bool
ReaderKey -> ReaderKey -> Ordering
ReaderKey -> ReaderKey -> ReaderKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReaderKey -> ReaderKey -> ReaderKey
$cmin :: ReaderKey -> ReaderKey -> ReaderKey
max :: ReaderKey -> ReaderKey -> ReaderKey
$cmax :: ReaderKey -> ReaderKey -> ReaderKey
>= :: ReaderKey -> ReaderKey -> Bool
$c>= :: ReaderKey -> ReaderKey -> Bool
> :: ReaderKey -> ReaderKey -> Bool
$c> :: ReaderKey -> ReaderKey -> Bool
<= :: ReaderKey -> ReaderKey -> Bool
$c<= :: ReaderKey -> ReaderKey -> Bool
< :: ReaderKey -> ReaderKey -> Bool
$c< :: ReaderKey -> ReaderKey -> Bool
compare :: ReaderKey -> ReaderKey -> Ordering
$ccompare :: ReaderKey -> ReaderKey -> Ordering
$cp1Ord :: Eq ReaderKey
Ord, Int -> ReaderKey
ReaderKey -> Int
ReaderKey -> [ReaderKey]
ReaderKey -> ReaderKey
ReaderKey -> ReaderKey -> [ReaderKey]
ReaderKey -> ReaderKey -> ReaderKey -> [ReaderKey]
(ReaderKey -> ReaderKey)
-> (ReaderKey -> ReaderKey)
-> (Int -> ReaderKey)
-> (ReaderKey -> Int)
-> (ReaderKey -> [ReaderKey])
-> (ReaderKey -> ReaderKey -> [ReaderKey])
-> (ReaderKey -> ReaderKey -> [ReaderKey])
-> (ReaderKey -> ReaderKey -> ReaderKey -> [ReaderKey])
-> Enum ReaderKey
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReaderKey -> ReaderKey -> ReaderKey -> [ReaderKey]
$cenumFromThenTo :: ReaderKey -> ReaderKey -> ReaderKey -> [ReaderKey]
enumFromTo :: ReaderKey -> ReaderKey -> [ReaderKey]
$cenumFromTo :: ReaderKey -> ReaderKey -> [ReaderKey]
enumFromThen :: ReaderKey -> ReaderKey -> [ReaderKey]
$cenumFromThen :: ReaderKey -> ReaderKey -> [ReaderKey]
enumFrom :: ReaderKey -> [ReaderKey]
$cenumFrom :: ReaderKey -> [ReaderKey]
fromEnum :: ReaderKey -> Int
$cfromEnum :: ReaderKey -> Int
toEnum :: Int -> ReaderKey
$ctoEnum :: Int -> ReaderKey
pred :: ReaderKey -> ReaderKey
$cpred :: ReaderKey -> ReaderKey
succ :: ReaderKey -> ReaderKey
$csucc :: ReaderKey -> ReaderKey
Enum, Context -> ReaderKey -> IO (Maybe ThunkInfo)
Proxy ReaderKey -> String
(Context -> ReaderKey -> IO (Maybe ThunkInfo))
-> (Context -> ReaderKey -> IO (Maybe ThunkInfo))
-> (Proxy ReaderKey -> String)
-> NoThunks ReaderKey
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy ReaderKey -> String
$cshowTypeOf :: Proxy ReaderKey -> String
wNoThunks :: Context -> ReaderKey -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> ReaderKey -> IO (Maybe ThunkInfo)
noThunks :: Context -> ReaderKey -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> ReaderKey -> IO (Maybe ThunkInfo)
NoThunks)

-- | Internal handle to a 'Reader' without an explicit @b@ (@blk@, @'Header'
-- blk@, etc.) parameter so 'Reader's with different' @b@s can be stored
-- together in 'cdbReaders'.
data ReaderHandle m blk = ReaderHandle
  { ReaderHandle m blk
-> Point blk -> AnchoredFragment (Header blk) -> STM m ()
rhSwitchFork :: Point blk -> AnchoredFragment (Header blk) -> STM m ()
    -- ^ When we have switched to a fork, all open 'Reader's must be notified.
  , ReaderHandle m blk -> m ()
rhClose      :: m ()
    -- ^ When closing the ChainDB, we must also close all open 'Reader's, as
    -- they might be holding on to resources.
    --
    -- Call 'rhClose' will release the resources used by the 'Reader'.
    --
    -- NOTE the 'Reader' is not removed from 'cdbReaders'. (That is done by
    -- 'closeAllReaders').
  }
  deriving Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo)
Proxy (ReaderHandle m blk) -> String
(Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo))
-> (Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo))
-> (Proxy (ReaderHandle m blk) -> String)
-> NoThunks (ReaderHandle m blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk.
Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk. Proxy (ReaderHandle m blk) -> String
showTypeOf :: Proxy (ReaderHandle m blk) -> String
$cshowTypeOf :: forall (m :: * -> *) blk. Proxy (ReaderHandle m blk) -> String
wNoThunks :: Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk.
Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *) blk.
Context -> ReaderHandle m blk -> IO (Maybe ThunkInfo)
NoThunks via OnlyCheckWhnfNamed "ReaderHandle" (ReaderHandle m blk)

-- | @b@ corresponds to the 'BlockComponent' that is being read.
data ReaderState m blk b
  = ReaderInit
    -- ^ The 'Reader' is in its initial state. Its 'ReaderRollState' is
    -- @'RollBackTo' 'genesisPoint'@.
    --
    -- This is equivalent to having a 'ReaderInImmutableDB' with the same
    -- 'ReaderRollState' and an iterator streaming after genesis. Opening such
    -- an iterator has a cost (index files will have to be read). However, in
    -- most cases, right after opening a Reader, the user of the Reader will try
    -- to move it forward, moving it from genesis to a more recent point on the
    -- chain. So we incur the cost of opening the iterator while not even using
    -- it.
    --
    -- Therefore, we have this extra initial state, that avoids this cost.
    -- When the user doesn't move the Reader forward, an iterator is opened.
  | ReaderInImmutableDB
      !(ReaderRollState blk)
      !(ImmutableDB.Iterator m blk (Point blk, b))
    -- ^ The 'Reader' is reading from the ImmutableDB.
    --
    -- Note that the iterator includes 'Point blk' in addition to @b@, as it
    -- is needed to keep track of where the iterator is.
    --
    -- INVARIANT: for all @ReaderInImmutableDB rollState immIt@: the predecessor
    -- of the next block streamed by @immIt@ must be the block identified by
    -- @readerRollStatePoint rollState@. In other words: the iterator is
    -- positioned /on/ @readerRollStatePoint rollState@.
  | ReaderInMem !(ReaderRollState blk)
    -- ^ The 'Reader' is reading from the in-memory current chain fragment.
  deriving ((forall x. ReaderState m blk b -> Rep (ReaderState m blk b) x)
-> (forall x. Rep (ReaderState m blk b) x -> ReaderState m blk b)
-> Generic (ReaderState m blk b)
forall x. Rep (ReaderState m blk b) x -> ReaderState m blk b
forall x. ReaderState m blk b -> Rep (ReaderState m blk b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (m :: * -> *) blk b x.
Rep (ReaderState m blk b) x -> ReaderState m blk b
forall (m :: * -> *) blk b x.
ReaderState m blk b -> Rep (ReaderState m blk b) x
$cto :: forall (m :: * -> *) blk b x.
Rep (ReaderState m blk b) x -> ReaderState m blk b
$cfrom :: forall (m :: * -> *) blk b x.
ReaderState m blk b -> Rep (ReaderState m blk b) x
Generic, Context -> ReaderState m blk b -> IO (Maybe ThunkInfo)
Proxy (ReaderState m blk b) -> String
(Context -> ReaderState m blk b -> IO (Maybe ThunkInfo))
-> (Context -> ReaderState m blk b -> IO (Maybe ThunkInfo))
-> (Proxy (ReaderState m blk b) -> String)
-> NoThunks (ReaderState m blk b)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk b.
StandardHash blk =>
Context -> ReaderState m blk b -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk b.
StandardHash blk =>
Proxy (ReaderState m blk b) -> String
showTypeOf :: Proxy (ReaderState m blk b) -> String
$cshowTypeOf :: forall (m :: * -> *) blk b.
StandardHash blk =>
Proxy (ReaderState m blk b) -> String
wNoThunks :: Context -> ReaderState m blk b -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk b.
StandardHash blk =>
Context -> ReaderState m blk b -> IO (Maybe ThunkInfo)
noThunks :: Context -> ReaderState m blk b -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *) blk b.
StandardHash blk =>
Context -> ReaderState m blk b -> IO (Maybe ThunkInfo)
NoThunks)

-- | Similar to 'Ouroboros.Network.MockChain.ProducerState.ReaderState'.
data ReaderRollState blk
  = RollBackTo      !(Point blk)
    -- ^ We don't know at which point the user is, but the next message we'll
    -- send is to roll back to this point.
  | RollForwardFrom !(Point blk)
    -- ^ We know that the reader is at this point and the next message we'll
    -- send is to roll forward to the point /after/ this point on our chain.
  deriving (ReaderRollState blk -> ReaderRollState blk -> Bool
(ReaderRollState blk -> ReaderRollState blk -> Bool)
-> (ReaderRollState blk -> ReaderRollState blk -> Bool)
-> Eq (ReaderRollState blk)
forall blk.
StandardHash blk =>
ReaderRollState blk -> ReaderRollState blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReaderRollState blk -> ReaderRollState blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
ReaderRollState blk -> ReaderRollState blk -> Bool
== :: ReaderRollState blk -> ReaderRollState blk -> Bool
$c== :: forall blk.
StandardHash blk =>
ReaderRollState blk -> ReaderRollState blk -> Bool
Eq, Int -> ReaderRollState blk -> String -> String
[ReaderRollState blk] -> String -> String
ReaderRollState blk -> String
(Int -> ReaderRollState blk -> String -> String)
-> (ReaderRollState blk -> String)
-> ([ReaderRollState blk] -> String -> String)
-> Show (ReaderRollState blk)
forall blk.
StandardHash blk =>
Int -> ReaderRollState blk -> String -> String
forall blk.
StandardHash blk =>
[ReaderRollState blk] -> String -> String
forall blk. StandardHash blk => ReaderRollState blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [ReaderRollState blk] -> String -> String
$cshowList :: forall blk.
StandardHash blk =>
[ReaderRollState blk] -> String -> String
show :: ReaderRollState blk -> String
$cshow :: forall blk. StandardHash blk => ReaderRollState blk -> String
showsPrec :: Int -> ReaderRollState blk -> String -> String
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> ReaderRollState blk -> String -> String
Show, (forall x. ReaderRollState blk -> Rep (ReaderRollState blk) x)
-> (forall x. Rep (ReaderRollState blk) x -> ReaderRollState blk)
-> Generic (ReaderRollState blk)
forall x. Rep (ReaderRollState blk) x -> ReaderRollState blk
forall x. ReaderRollState blk -> Rep (ReaderRollState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (ReaderRollState blk) x -> ReaderRollState blk
forall blk x. ReaderRollState blk -> Rep (ReaderRollState blk) x
$cto :: forall blk x. Rep (ReaderRollState blk) x -> ReaderRollState blk
$cfrom :: forall blk x. ReaderRollState blk -> Rep (ReaderRollState blk) x
Generic, Context -> ReaderRollState blk -> IO (Maybe ThunkInfo)
Proxy (ReaderRollState blk) -> String
(Context -> ReaderRollState blk -> IO (Maybe ThunkInfo))
-> (Context -> ReaderRollState blk -> IO (Maybe ThunkInfo))
-> (Proxy (ReaderRollState blk) -> String)
-> NoThunks (ReaderRollState blk)
forall blk.
StandardHash blk =>
Context -> ReaderRollState blk -> IO (Maybe ThunkInfo)
forall blk.
StandardHash blk =>
Proxy (ReaderRollState blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (ReaderRollState blk) -> String
$cshowTypeOf :: forall blk.
StandardHash blk =>
Proxy (ReaderRollState blk) -> String
wNoThunks :: Context -> ReaderRollState blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
StandardHash blk =>
Context -> ReaderRollState blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> ReaderRollState blk -> IO (Maybe ThunkInfo)
$cnoThunks :: forall blk.
StandardHash blk =>
Context -> ReaderRollState blk -> IO (Maybe ThunkInfo)
NoThunks)

-- | Get the point the 'ReaderRollState' should roll back to or roll forward
-- from.
readerRollStatePoint :: ReaderRollState blk -> Point blk
readerRollStatePoint :: ReaderRollState blk -> Point blk
readerRollStatePoint (RollBackTo      Point blk
pt) = Point blk
pt
readerRollStatePoint (RollForwardFrom Point blk
pt) = Point blk
pt

{-------------------------------------------------------------------------------
  Invalid blocks
-------------------------------------------------------------------------------}

-- | Hashes corresponding to invalid blocks. This is used to ignore these
-- blocks during chain selection.
type InvalidBlocks blk = Map (HeaderHash blk) (InvalidBlockInfo blk)

-- | In addition to the reason why a block is invalid, the slot number of the
-- block is stored, so that whenever a garbage collection is performed on the
-- VolatileDB for some slot @s@, the hashes older or equal to @s@ can be
-- removed from this map.
data InvalidBlockInfo blk = InvalidBlockInfo
  { InvalidBlockInfo blk -> InvalidBlockReason blk
invalidBlockReason :: !(InvalidBlockReason blk)
  , InvalidBlockInfo blk -> SlotNo
invalidBlockSlotNo :: !SlotNo
  } deriving (InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool
(InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool)
-> (InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool)
-> Eq (InvalidBlockInfo blk)
forall blk.
LedgerSupportsProtocol blk =>
InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool
$c/= :: forall blk.
LedgerSupportsProtocol blk =>
InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool
== :: InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool
$c== :: forall blk.
LedgerSupportsProtocol blk =>
InvalidBlockInfo blk -> InvalidBlockInfo blk -> Bool
Eq, Int -> InvalidBlockInfo blk -> String -> String
[InvalidBlockInfo blk] -> String -> String
InvalidBlockInfo blk -> String
(Int -> InvalidBlockInfo blk -> String -> String)
-> (InvalidBlockInfo blk -> String)
-> ([InvalidBlockInfo blk] -> String -> String)
-> Show (InvalidBlockInfo blk)
forall blk.
LedgerSupportsProtocol blk =>
Int -> InvalidBlockInfo blk -> String -> String
forall blk.
LedgerSupportsProtocol blk =>
[InvalidBlockInfo blk] -> String -> String
forall blk.
LedgerSupportsProtocol blk =>
InvalidBlockInfo blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [InvalidBlockInfo blk] -> String -> String
$cshowList :: forall blk.
LedgerSupportsProtocol blk =>
[InvalidBlockInfo blk] -> String -> String
show :: InvalidBlockInfo blk -> String
$cshow :: forall blk.
LedgerSupportsProtocol blk =>
InvalidBlockInfo blk -> String
showsPrec :: Int -> InvalidBlockInfo blk -> String -> String
$cshowsPrec :: forall blk.
LedgerSupportsProtocol blk =>
Int -> InvalidBlockInfo blk -> String -> String
Show, (forall x. InvalidBlockInfo blk -> Rep (InvalidBlockInfo blk) x)
-> (forall x. Rep (InvalidBlockInfo blk) x -> InvalidBlockInfo blk)
-> Generic (InvalidBlockInfo blk)
forall x. Rep (InvalidBlockInfo blk) x -> InvalidBlockInfo blk
forall x. InvalidBlockInfo blk -> Rep (InvalidBlockInfo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (InvalidBlockInfo blk) x -> InvalidBlockInfo blk
forall blk x. InvalidBlockInfo blk -> Rep (InvalidBlockInfo blk) x
$cto :: forall blk x. Rep (InvalidBlockInfo blk) x -> InvalidBlockInfo blk
$cfrom :: forall blk x. InvalidBlockInfo blk -> Rep (InvalidBlockInfo blk) x
Generic, Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo)
Proxy (InvalidBlockInfo blk) -> String
(Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo))
-> (Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo))
-> (Proxy (InvalidBlockInfo blk) -> String)
-> NoThunks (InvalidBlockInfo blk)
forall blk.
LedgerSupportsProtocol blk =>
Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo)
forall blk.
LedgerSupportsProtocol blk =>
Proxy (InvalidBlockInfo blk) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (InvalidBlockInfo blk) -> String
$cshowTypeOf :: forall blk.
LedgerSupportsProtocol blk =>
Proxy (InvalidBlockInfo blk) -> String
wNoThunks :: Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall blk.
LedgerSupportsProtocol blk =>
Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo)
$cnoThunks :: forall blk.
LedgerSupportsProtocol blk =>
Context -> InvalidBlockInfo blk -> IO (Maybe ThunkInfo)
NoThunks)

{-------------------------------------------------------------------------------
  Future blocks
-------------------------------------------------------------------------------}

-- | Blocks from the future for which we still need to trigger chain
-- selection.
--
-- See 'cdbFutureBlocks' for more info.
type FutureBlocks blk = Map (HeaderHash blk) (Header blk)

{-------------------------------------------------------------------------------
  Blocks to add
-------------------------------------------------------------------------------}

-- | FIFO queue used to add blocks asynchronously to the ChainDB. Blocks are
-- read from this queue by a background thread, which processes the blocks
-- synchronously.
newtype BlocksToAdd m blk = BlocksToAdd (TBQueue m (BlockToAdd m blk))
  deriving Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo)
Proxy (BlocksToAdd m blk) -> String
(Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo))
-> (Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo))
-> (Proxy (BlocksToAdd m blk) -> String)
-> NoThunks (BlocksToAdd m blk)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
forall (m :: * -> *) blk.
Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo)
forall (m :: * -> *) blk. Proxy (BlocksToAdd m blk) -> String
showTypeOf :: Proxy (BlocksToAdd m blk) -> String
$cshowTypeOf :: forall (m :: * -> *) blk. Proxy (BlocksToAdd m blk) -> String
wNoThunks :: Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall (m :: * -> *) blk.
Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo)
noThunks :: Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo)
$cnoThunks :: forall (m :: * -> *) blk.
Context -> BlocksToAdd m blk -> IO (Maybe ThunkInfo)
NoThunks via OnlyCheckWhnfNamed "BlocksToAdd" (BlocksToAdd m blk)

-- | Entry in the 'BlocksToAdd' queue: a block together with the 'TMVar's used
-- to implement 'AddBlockPromise'.
data BlockToAdd m blk = BlockToAdd
  { BlockToAdd m blk -> blk
blockToAdd            :: !blk
  , BlockToAdd m blk -> StrictTMVar m Bool
varBlockWrittenToDisk :: !(StrictTMVar m Bool)
    -- ^ Used for the 'blockWrittenToDisk' field of 'AddBlockPromise'.
  , BlockToAdd m blk -> StrictTMVar m (Point blk)
varBlockProcessed     :: !(StrictTMVar m (Point blk))
    -- ^ Used for the 'blockProcessed' field of 'AddBlockPromise'.
  }

-- | Create a new 'BlocksToAdd' with the given size.
newBlocksToAdd :: IOLike m => Word -> m (BlocksToAdd m blk)
newBlocksToAdd :: Word -> m (BlocksToAdd m blk)
newBlocksToAdd Word
queueSize = TBQueue_ (STM m) (BlockToAdd m blk) -> BlocksToAdd m blk
forall (m :: * -> *) blk.
TBQueue m (BlockToAdd m blk) -> BlocksToAdd m blk
BlocksToAdd (TBQueue_ (STM m) (BlockToAdd m blk) -> BlocksToAdd m blk)
-> m (TBQueue_ (STM m) (BlockToAdd m blk)) -> m (BlocksToAdd m blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    STM m (TBQueue_ (STM m) (BlockToAdd m blk))
-> m (TBQueue_ (STM m) (BlockToAdd m blk))
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (Natural -> STM m (TBQueue_ (STM m) (BlockToAdd m blk))
forall (stm :: * -> *) a.
MonadSTMTx stm =>
Natural -> stm (TBQueue_ stm a)
newTBQueue (Word -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
queueSize))

-- | Add a block to the 'BlocksToAdd' queue. Can block when the queue is full.
addBlockToAdd
  :: (IOLike m, HasHeader blk)
  => Tracer m (TraceAddBlockEvent blk)
  -> BlocksToAdd m blk
  -> blk
  -> m (AddBlockPromise m blk)
addBlockToAdd :: Tracer m (TraceAddBlockEvent blk)
-> BlocksToAdd m blk -> blk -> m (AddBlockPromise m blk)
addBlockToAdd Tracer m (TraceAddBlockEvent blk)
tracer (BlocksToAdd TBQueue m (BlockToAdd m blk)
queue) blk
blk = do
    StrictTMVar m Bool
varBlockWrittenToDisk <- m (StrictTMVar m Bool)
forall (m :: * -> *) a. MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarIO
    StrictTMVar m (Point blk)
varBlockProcessed     <- m (StrictTMVar m (Point blk))
forall (m :: * -> *) a. MonadSTM m => m (StrictTMVar m a)
newEmptyTMVarIO
    let !toAdd :: BlockToAdd m blk
toAdd = BlockToAdd :: forall (m :: * -> *) blk.
blk
-> StrictTMVar m Bool
-> StrictTMVar m (Point blk)
-> BlockToAdd m blk
BlockToAdd
          { blockToAdd :: blk
blockToAdd = blk
blk
          , StrictTMVar m Bool
varBlockWrittenToDisk :: StrictTMVar m Bool
varBlockWrittenToDisk :: StrictTMVar m Bool
varBlockWrittenToDisk
          , StrictTMVar m (Point blk)
varBlockProcessed :: StrictTMVar m (Point blk)
varBlockProcessed :: StrictTMVar m (Point blk)
varBlockProcessed
          }
    Natural
queueSize <- STM m Natural -> m Natural
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Natural -> m Natural) -> STM m Natural -> m Natural
forall a b. (a -> b) -> a -> b
$ do
      TBQueue m (BlockToAdd m blk) -> BlockToAdd m blk -> STM m ()
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> a -> stm ()
writeTBQueue  TBQueue m (BlockToAdd m blk)
queue BlockToAdd m blk
toAdd
      TBQueue m (BlockToAdd m blk) -> STM m Natural
forall (stm :: * -> *) a.
MonadSTMTx stm =>
TBQueue_ stm a -> stm Natural
lengthTBQueue TBQueue m (BlockToAdd m blk)
queue
    Tracer m (TraceAddBlockEvent blk) -> TraceAddBlockEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceAddBlockEvent blk)
tracer (TraceAddBlockEvent blk -> m ()) -> TraceAddBlockEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$
      RealPoint blk -> Word -> TraceAddBlockEvent blk
forall blk. RealPoint blk -> Word -> TraceAddBlockEvent blk
AddedBlockToQueue (blk -> RealPoint blk
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint blk
blk) (Natural -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
queueSize)
    AddBlockPromise m blk -> m (AddBlockPromise m blk)
forall (m :: * -> *) a. Monad m => a -> m a
return AddBlockPromise :: forall (m :: * -> *) blk.
STM m Bool -> STM m (Point blk) -> AddBlockPromise m blk
AddBlockPromise
      { blockWrittenToDisk :: STM m Bool
blockWrittenToDisk      = StrictTMVar m Bool -> STM m Bool
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar m Bool
varBlockWrittenToDisk
      , blockProcessed :: STM m (Point blk)
blockProcessed          = StrictTMVar m (Point blk) -> STM m (Point blk)
forall (m :: * -> *) a. MonadSTM m => StrictTMVar m a -> STM m a
readTMVar StrictTMVar m (Point blk)
varBlockProcessed
      }

-- | Get the oldest block from the 'BlocksToAdd' queue. Can block when the
-- queue is empty.
getBlockToAdd :: IOLike m => BlocksToAdd m blk -> m (BlockToAdd m blk)
getBlockToAdd :: BlocksToAdd m blk -> m (BlockToAdd m blk)
getBlockToAdd (BlocksToAdd TBQueue m (BlockToAdd m blk)
queue) = STM m (BlockToAdd m blk) -> m (BlockToAdd m blk)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (BlockToAdd m blk) -> m (BlockToAdd m blk))
-> STM m (BlockToAdd m blk) -> m (BlockToAdd m blk)
forall a b. (a -> b) -> a -> b
$ TBQueue m (BlockToAdd m blk) -> STM m (BlockToAdd m blk)
forall (stm :: * -> *) a. MonadSTMTx stm => TBQueue_ stm a -> stm a
readTBQueue TBQueue m (BlockToAdd m blk)
queue

{-------------------------------------------------------------------------------
  Trace types
-------------------------------------------------------------------------------}

-- | Trace type for the various events of the ChainDB.
data TraceEvent blk
  = TraceAddBlockEvent          (TraceAddBlockEvent           blk)
  | TraceReaderEvent            (TraceReaderEvent             blk)
  | TraceCopyToImmutableDBEvent (TraceCopyToImmutableDBEvent  blk)
  | TraceGCEvent                (TraceGCEvent                 blk)
  | TraceInitChainSelEvent      (TraceInitChainSelEvent       blk)
  | TraceOpenEvent              (TraceOpenEvent               blk)
  | TraceIteratorEvent          (TraceIteratorEvent           blk)
  | TraceLedgerEvent            (LgrDB.TraceEvent             blk)
  | TraceLedgerReplayEvent      (LgrDB.TraceLedgerReplayEvent blk)
  | TraceImmutableDBEvent       (ImmutableDB.TraceEvent       blk)
  | TraceVolatileDBEvent        (VolatileDB.TraceEvent        blk)
  deriving ((forall x. TraceEvent blk -> Rep (TraceEvent blk) x)
-> (forall x. Rep (TraceEvent blk) x -> TraceEvent blk)
-> Generic (TraceEvent blk)
forall x. Rep (TraceEvent blk) x -> TraceEvent blk
forall x. TraceEvent blk -> Rep (TraceEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TraceEvent blk) x -> TraceEvent blk
forall blk x. TraceEvent blk -> Rep (TraceEvent blk) x
$cto :: forall blk x. Rep (TraceEvent blk) x -> TraceEvent blk
$cfrom :: forall blk x. TraceEvent blk -> Rep (TraceEvent blk) x
Generic)

deriving instance
  ( HasHeader blk
  , Eq (Header blk)
  , LedgerSupportsProtocol blk
  , InspectLedger blk
  ) => Eq (TraceEvent blk)
deriving instance
  ( HasHeader blk
  , Show (Header blk)
  , LedgerSupportsProtocol blk
  , InspectLedger blk
  ) => Show (TraceEvent blk)

data TraceOpenEvent blk =
    -- | The ChainDB was opened.
    OpenedDB
      (Point blk)  -- ^ Immutable tip
      (Point blk)  -- ^ Tip of the current chain

    -- | The ChainDB was closed.
  | ClosedDB
      (Point blk)  -- ^ Immutable tip
      (Point blk)  -- ^ Tip of the current chain

    -- | The ImmutableDB was opened.
  | OpenedImmutableDB
      (Point blk)          -- ^ Immutable tip
      ImmutableDB.ChunkNo  -- ^ Chunk number of the immutable tip

    -- | The VolatileDB was opened.
  | OpenedVolatileDB

    -- | The LedgerDB was opened.
  | OpenedLgrDB
  deriving ((forall x. TraceOpenEvent blk -> Rep (TraceOpenEvent blk) x)
-> (forall x. Rep (TraceOpenEvent blk) x -> TraceOpenEvent blk)
-> Generic (TraceOpenEvent blk)
forall x. Rep (TraceOpenEvent blk) x -> TraceOpenEvent blk
forall x. TraceOpenEvent blk -> Rep (TraceOpenEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TraceOpenEvent blk) x -> TraceOpenEvent blk
forall blk x. TraceOpenEvent blk -> Rep (TraceOpenEvent blk) x
$cto :: forall blk x. Rep (TraceOpenEvent blk) x -> TraceOpenEvent blk
$cfrom :: forall blk x. TraceOpenEvent blk -> Rep (TraceOpenEvent blk) x
Generic, TraceOpenEvent blk -> TraceOpenEvent blk -> Bool
(TraceOpenEvent blk -> TraceOpenEvent blk -> Bool)
-> (TraceOpenEvent blk -> TraceOpenEvent blk -> Bool)
-> Eq (TraceOpenEvent blk)
forall blk.
StandardHash blk =>
TraceOpenEvent blk -> TraceOpenEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceOpenEvent blk -> TraceOpenEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceOpenEvent blk -> TraceOpenEvent blk -> Bool
== :: TraceOpenEvent blk -> TraceOpenEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
TraceOpenEvent blk -> TraceOpenEvent blk -> Bool
Eq, Int -> TraceOpenEvent blk -> String -> String
[TraceOpenEvent blk] -> String -> String
TraceOpenEvent blk -> String
(Int -> TraceOpenEvent blk -> String -> String)
-> (TraceOpenEvent blk -> String)
-> ([TraceOpenEvent blk] -> String -> String)
-> Show (TraceOpenEvent blk)
forall blk.
StandardHash blk =>
Int -> TraceOpenEvent blk -> String -> String
forall blk.
StandardHash blk =>
[TraceOpenEvent blk] -> String -> String
forall blk. StandardHash blk => TraceOpenEvent blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TraceOpenEvent blk] -> String -> String
$cshowList :: forall blk.
StandardHash blk =>
[TraceOpenEvent blk] -> String -> String
show :: TraceOpenEvent blk -> String
$cshow :: forall blk. StandardHash blk => TraceOpenEvent blk -> String
showsPrec :: Int -> TraceOpenEvent blk -> String -> String
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> TraceOpenEvent blk -> String -> String
Show)

-- | Information about the new tip of the current chain.
--
-- NOTE: the fields of this record are intentionally lazy to prevent the
-- forcing of this information in case it doesn't have to be traced. However,
-- this means that the tracer processing this message /must not/ hold on to
-- it, otherwise it leaks memory.
data NewTipInfo blk = NewTipInfo {
      NewTipInfo blk -> RealPoint blk
newTipPoint       :: RealPoint blk
      -- ^ The new tip of the current chain.
    , NewTipInfo blk -> EpochNo
newTipEpoch       :: EpochNo
      -- ^ The epoch of the new tip.
    , NewTipInfo blk -> Word64
newTipSlotInEpoch :: Word64
      -- ^ The slot in the epoch, i.e., the relative slot number, of the new
      -- tip.
    , NewTipInfo blk -> RealPoint blk
newTipTrigger     :: RealPoint blk
      -- ^ The new tip of the current chain ('newTipPoint') is the result of
      -- performing chain selection for a /trigger/ block ('newTipTrigger').
      -- In most cases, we add a new block to the tip of the current chain, in
      -- which case the new tip /is/ the trigger block.
      --
      -- However, this is not always the case. For example, with our current
      -- chain being A and having a disconnected C lying around, adding B will
      -- result in A -> B -> C as the new chain. The trigger B /= the new tip
      -- C.
    }
  deriving (NewTipInfo blk -> NewTipInfo blk -> Bool
(NewTipInfo blk -> NewTipInfo blk -> Bool)
-> (NewTipInfo blk -> NewTipInfo blk -> Bool)
-> Eq (NewTipInfo blk)
forall blk.
StandardHash blk =>
NewTipInfo blk -> NewTipInfo blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewTipInfo blk -> NewTipInfo blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
NewTipInfo blk -> NewTipInfo blk -> Bool
== :: NewTipInfo blk -> NewTipInfo blk -> Bool
$c== :: forall blk.
StandardHash blk =>
NewTipInfo blk -> NewTipInfo blk -> Bool
Eq, Int -> NewTipInfo blk -> String -> String
[NewTipInfo blk] -> String -> String
NewTipInfo blk -> String
(Int -> NewTipInfo blk -> String -> String)
-> (NewTipInfo blk -> String)
-> ([NewTipInfo blk] -> String -> String)
-> Show (NewTipInfo blk)
forall blk.
StandardHash blk =>
Int -> NewTipInfo blk -> String -> String
forall blk.
StandardHash blk =>
[NewTipInfo blk] -> String -> String
forall blk. StandardHash blk => NewTipInfo blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [NewTipInfo blk] -> String -> String
$cshowList :: forall blk.
StandardHash blk =>
[NewTipInfo blk] -> String -> String
show :: NewTipInfo blk -> String
$cshow :: forall blk. StandardHash blk => NewTipInfo blk -> String
showsPrec :: Int -> NewTipInfo blk -> String -> String
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> NewTipInfo blk -> String -> String
Show, (forall x. NewTipInfo blk -> Rep (NewTipInfo blk) x)
-> (forall x. Rep (NewTipInfo blk) x -> NewTipInfo blk)
-> Generic (NewTipInfo blk)
forall x. Rep (NewTipInfo blk) x -> NewTipInfo blk
forall x. NewTipInfo blk -> Rep (NewTipInfo blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (NewTipInfo blk) x -> NewTipInfo blk
forall blk x. NewTipInfo blk -> Rep (NewTipInfo blk) x
$cto :: forall blk x. Rep (NewTipInfo blk) x -> NewTipInfo blk
$cfrom :: forall blk x. NewTipInfo blk -> Rep (NewTipInfo blk) x
Generic)

-- | Trace type for the various events that occur when adding a block.
data TraceAddBlockEvent blk =
    -- | A block with a 'BlockNo' more than @k@ back than the current tip was
    -- ignored.
    IgnoreBlockOlderThanK (RealPoint blk)

    -- | A block that is already in the Volatile DB was ignored.
  | IgnoreBlockAlreadyInVolatileDB (RealPoint blk)

    -- | A block that is know to be invalid was ignored.
  | IgnoreInvalidBlock (RealPoint blk) (InvalidBlockReason blk)

    -- | The block was added to the queue and will be added to the ChainDB by
    -- the background thread. The size of the queue is included.
  | AddedBlockToQueue (RealPoint blk) Word

    -- | The block is from the future, i.e., its slot number is greater than
    -- the current slot (the second argument).
  | BlockInTheFuture (RealPoint blk) SlotNo

    -- | A block was added to the Volatile DB
  | AddedBlockToVolatileDB (RealPoint blk) BlockNo IsEBB

    -- | The block fits onto the current chain, we'll try to use it to extend
    -- our chain.
  | TryAddToCurrentChain (RealPoint blk)

    -- | The block fits onto some fork, we'll try to switch to that fork (if
    -- it is preferable to our chain).
  | TrySwitchToAFork (RealPoint blk) (ChainDiff (HeaderFields blk))

    -- | The block doesn't fit onto any other block, so we store it and ignore
    -- it.
  | StoreButDontChange (RealPoint blk)

    -- | The new block fits onto the current chain (first
    -- fragment) and we have successfully used it to extend our (new) current
    -- chain (second fragment).
  | AddedToCurrentChain
      [LedgerEvent blk]
      (NewTipInfo blk)
      (AnchoredFragment (Header blk))
      (AnchoredFragment (Header blk))

    -- | The new block fits onto some fork and we have switched to that fork
    -- (second fragment), as it is preferable to our (previous) current chain
    -- (first fragment).
  | SwitchedToAFork
      [LedgerEvent blk]
      (NewTipInfo blk)
      (AnchoredFragment (Header blk))
      (AnchoredFragment (Header blk))

    -- | An event traced during validating performed while adding a block.
  | AddBlockValidation (TraceValidationEvent blk)

    -- | Run chain selection for a block that was previously from the future.
    -- This is done for all blocks from the future each time a new block is
    -- added.
  | ChainSelectionForFutureBlock (RealPoint blk)
  deriving ((forall x.
 TraceAddBlockEvent blk -> Rep (TraceAddBlockEvent blk) x)
-> (forall x.
    Rep (TraceAddBlockEvent blk) x -> TraceAddBlockEvent blk)
-> Generic (TraceAddBlockEvent blk)
forall x. Rep (TraceAddBlockEvent blk) x -> TraceAddBlockEvent blk
forall x. TraceAddBlockEvent blk -> Rep (TraceAddBlockEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TraceAddBlockEvent blk) x -> TraceAddBlockEvent blk
forall blk x.
TraceAddBlockEvent blk -> Rep (TraceAddBlockEvent blk) x
$cto :: forall blk x.
Rep (TraceAddBlockEvent blk) x -> TraceAddBlockEvent blk
$cfrom :: forall blk x.
TraceAddBlockEvent blk -> Rep (TraceAddBlockEvent blk) x
Generic)

deriving instance
  ( HasHeader blk
  , Eq (Header blk)
  , LedgerSupportsProtocol blk
  , InspectLedger blk
  ) => Eq (TraceAddBlockEvent blk)
deriving instance
  ( HasHeader blk
  , Show (Header blk)
  , LedgerSupportsProtocol blk
  , InspectLedger blk
  ) => Show (TraceAddBlockEvent blk)

data TraceValidationEvent blk =
    -- | A point was found to be invalid.
    InvalidBlock
      (ExtValidationError blk)
      (RealPoint blk)

    -- | A candidate chain was invalid.
  | InvalidCandidate
      (AnchoredFragment (Header blk))

    -- | A candidate chain was valid.
  | ValidCandidate (AnchoredFragment (Header blk))

    -- | Candidate contains headers from the future which do no exceed the
    -- clock skew.
  | CandidateContainsFutureBlocks
      (AnchoredFragment (Header blk))
      -- ^ Candidate chain containing headers from the future
      [Header blk]
      -- ^ Headers from the future, not exceeding clock skew

    -- | Candidate contains headers from the future which exceed the
    -- clock skew, making them invalid.
  | CandidateContainsFutureBlocksExceedingClockSkew
      (AnchoredFragment (Header blk))
      -- ^ Candidate chain containing headers from the future
      [Header blk]
      -- ^ Headers from the future, exceeding clock skew
  deriving ((forall x.
 TraceValidationEvent blk -> Rep (TraceValidationEvent blk) x)
-> (forall x.
    Rep (TraceValidationEvent blk) x -> TraceValidationEvent blk)
-> Generic (TraceValidationEvent blk)
forall x.
Rep (TraceValidationEvent blk) x -> TraceValidationEvent blk
forall x.
TraceValidationEvent blk -> Rep (TraceValidationEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TraceValidationEvent blk) x -> TraceValidationEvent blk
forall blk x.
TraceValidationEvent blk -> Rep (TraceValidationEvent blk) x
$cto :: forall blk x.
Rep (TraceValidationEvent blk) x -> TraceValidationEvent blk
$cfrom :: forall blk x.
TraceValidationEvent blk -> Rep (TraceValidationEvent blk) x
Generic)

deriving instance
  ( HasHeader              blk
  , Eq (Header             blk)
  , LedgerSupportsProtocol blk
  ) => Eq (TraceValidationEvent blk)
deriving instance
  ( Show (Header           blk)
  , LedgerSupportsProtocol blk
  ) => Show (TraceValidationEvent blk)

data TraceInitChainSelEvent blk
  = InitChainSelValidation (TraceValidationEvent blk)
    -- ^ An event traced during validation performed while performing initial
    -- chain selection.
  deriving ((forall x.
 TraceInitChainSelEvent blk -> Rep (TraceInitChainSelEvent blk) x)
-> (forall x.
    Rep (TraceInitChainSelEvent blk) x -> TraceInitChainSelEvent blk)
-> Generic (TraceInitChainSelEvent blk)
forall x.
Rep (TraceInitChainSelEvent blk) x -> TraceInitChainSelEvent blk
forall x.
TraceInitChainSelEvent blk -> Rep (TraceInitChainSelEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TraceInitChainSelEvent blk) x -> TraceInitChainSelEvent blk
forall blk x.
TraceInitChainSelEvent blk -> Rep (TraceInitChainSelEvent blk) x
$cto :: forall blk x.
Rep (TraceInitChainSelEvent blk) x -> TraceInitChainSelEvent blk
$cfrom :: forall blk x.
TraceInitChainSelEvent blk -> Rep (TraceInitChainSelEvent blk) x
Generic)

deriving instance
  ( HasHeader              blk
  , Eq (Header             blk)
  , LedgerSupportsProtocol blk
  ) => Eq (TraceInitChainSelEvent blk)
deriving instance
  ( Show (Header           blk)
  , LedgerSupportsProtocol blk
  ) => Show (TraceInitChainSelEvent blk)


data TraceReaderEvent blk =
    -- | A new reader was created.
    NewReader

    -- | The reader was in the 'ReaderInMem' state but its point is no longer on
    -- the in-memory chain fragment, so it has to switch to the
    -- 'ReaderInImmutableDB' state.
  | ReaderNoLongerInMem (ReaderRollState blk)

    -- | The reader was in the 'ReaderInImmutableDB' state and is switched to
    -- the 'ReaderInMem' state.
  | ReaderSwitchToMem
      (Point blk)          -- ^ Point at which the reader is
      (WithOrigin SlotNo)  -- ^ Slot number at the tip of the ImmutableDB

    -- | The reader is in the 'ReaderInImmutableDB' state but the iterator is
    -- exhausted while the ImmutableDB has grown, so we open a new iterator to
    -- stream these blocks too.
  | ReaderNewImmIterator
      (Point blk)          -- ^ Point at which the reader is
      (WithOrigin SlotNo)  -- ^ Slot number at the tip of the ImmutableDB
  deriving ((forall x. TraceReaderEvent blk -> Rep (TraceReaderEvent blk) x)
-> (forall x. Rep (TraceReaderEvent blk) x -> TraceReaderEvent blk)
-> Generic (TraceReaderEvent blk)
forall x. Rep (TraceReaderEvent blk) x -> TraceReaderEvent blk
forall x. TraceReaderEvent blk -> Rep (TraceReaderEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TraceReaderEvent blk) x -> TraceReaderEvent blk
forall blk x. TraceReaderEvent blk -> Rep (TraceReaderEvent blk) x
$cto :: forall blk x. Rep (TraceReaderEvent blk) x -> TraceReaderEvent blk
$cfrom :: forall blk x. TraceReaderEvent blk -> Rep (TraceReaderEvent blk) x
Generic, TraceReaderEvent blk -> TraceReaderEvent blk -> Bool
(TraceReaderEvent blk -> TraceReaderEvent blk -> Bool)
-> (TraceReaderEvent blk -> TraceReaderEvent blk -> Bool)
-> Eq (TraceReaderEvent blk)
forall blk.
StandardHash blk =>
TraceReaderEvent blk -> TraceReaderEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceReaderEvent blk -> TraceReaderEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceReaderEvent blk -> TraceReaderEvent blk -> Bool
== :: TraceReaderEvent blk -> TraceReaderEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
TraceReaderEvent blk -> TraceReaderEvent blk -> Bool
Eq, Int -> TraceReaderEvent blk -> String -> String
[TraceReaderEvent blk] -> String -> String
TraceReaderEvent blk -> String
(Int -> TraceReaderEvent blk -> String -> String)
-> (TraceReaderEvent blk -> String)
-> ([TraceReaderEvent blk] -> String -> String)
-> Show (TraceReaderEvent blk)
forall blk.
StandardHash blk =>
Int -> TraceReaderEvent blk -> String -> String
forall blk.
StandardHash blk =>
[TraceReaderEvent blk] -> String -> String
forall blk. StandardHash blk => TraceReaderEvent blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TraceReaderEvent blk] -> String -> String
$cshowList :: forall blk.
StandardHash blk =>
[TraceReaderEvent blk] -> String -> String
show :: TraceReaderEvent blk -> String
$cshow :: forall blk. StandardHash blk => TraceReaderEvent blk -> String
showsPrec :: Int -> TraceReaderEvent blk -> String -> String
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> TraceReaderEvent blk -> String -> String
Show)


data TraceCopyToImmutableDBEvent blk
  = CopiedBlockToImmutableDB (Point blk)
    -- ^ A block was successfully copied to the ImmutableDB.
  | NoBlocksToCopyToImmutableDB
    -- ^ There are no block to copy to the ImmutableDB.
  deriving ((forall x.
 TraceCopyToImmutableDBEvent blk
 -> Rep (TraceCopyToImmutableDBEvent blk) x)
-> (forall x.
    Rep (TraceCopyToImmutableDBEvent blk) x
    -> TraceCopyToImmutableDBEvent blk)
-> Generic (TraceCopyToImmutableDBEvent blk)
forall x.
Rep (TraceCopyToImmutableDBEvent blk) x
-> TraceCopyToImmutableDBEvent blk
forall x.
TraceCopyToImmutableDBEvent blk
-> Rep (TraceCopyToImmutableDBEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TraceCopyToImmutableDBEvent blk) x
-> TraceCopyToImmutableDBEvent blk
forall blk x.
TraceCopyToImmutableDBEvent blk
-> Rep (TraceCopyToImmutableDBEvent blk) x
$cto :: forall blk x.
Rep (TraceCopyToImmutableDBEvent blk) x
-> TraceCopyToImmutableDBEvent blk
$cfrom :: forall blk x.
TraceCopyToImmutableDBEvent blk
-> Rep (TraceCopyToImmutableDBEvent blk) x
Generic, TraceCopyToImmutableDBEvent blk
-> TraceCopyToImmutableDBEvent blk -> Bool
(TraceCopyToImmutableDBEvent blk
 -> TraceCopyToImmutableDBEvent blk -> Bool)
-> (TraceCopyToImmutableDBEvent blk
    -> TraceCopyToImmutableDBEvent blk -> Bool)
-> Eq (TraceCopyToImmutableDBEvent blk)
forall blk.
StandardHash blk =>
TraceCopyToImmutableDBEvent blk
-> TraceCopyToImmutableDBEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceCopyToImmutableDBEvent blk
-> TraceCopyToImmutableDBEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceCopyToImmutableDBEvent blk
-> TraceCopyToImmutableDBEvent blk -> Bool
== :: TraceCopyToImmutableDBEvent blk
-> TraceCopyToImmutableDBEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
TraceCopyToImmutableDBEvent blk
-> TraceCopyToImmutableDBEvent blk -> Bool
Eq, Int -> TraceCopyToImmutableDBEvent blk -> String -> String
[TraceCopyToImmutableDBEvent blk] -> String -> String
TraceCopyToImmutableDBEvent blk -> String
(Int -> TraceCopyToImmutableDBEvent blk -> String -> String)
-> (TraceCopyToImmutableDBEvent blk -> String)
-> ([TraceCopyToImmutableDBEvent blk] -> String -> String)
-> Show (TraceCopyToImmutableDBEvent blk)
forall blk.
StandardHash blk =>
Int -> TraceCopyToImmutableDBEvent blk -> String -> String
forall blk.
StandardHash blk =>
[TraceCopyToImmutableDBEvent blk] -> String -> String
forall blk.
StandardHash blk =>
TraceCopyToImmutableDBEvent blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TraceCopyToImmutableDBEvent blk] -> String -> String
$cshowList :: forall blk.
StandardHash blk =>
[TraceCopyToImmutableDBEvent blk] -> String -> String
show :: TraceCopyToImmutableDBEvent blk -> String
$cshow :: forall blk.
StandardHash blk =>
TraceCopyToImmutableDBEvent blk -> String
showsPrec :: Int -> TraceCopyToImmutableDBEvent blk -> String -> String
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> TraceCopyToImmutableDBEvent blk -> String -> String
Show)

data TraceGCEvent blk
  = ScheduledGC SlotNo Time
    -- ^ A garbage collection for the given 'SlotNo' was scheduled to happen
    -- at the given time.
  | PerformedGC SlotNo
    -- ^ A garbage collection for the given 'SlotNo' was performed.
  deriving ((forall x. TraceGCEvent blk -> Rep (TraceGCEvent blk) x)
-> (forall x. Rep (TraceGCEvent blk) x -> TraceGCEvent blk)
-> Generic (TraceGCEvent blk)
forall x. Rep (TraceGCEvent blk) x -> TraceGCEvent blk
forall x. TraceGCEvent blk -> Rep (TraceGCEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TraceGCEvent blk) x -> TraceGCEvent blk
forall blk x. TraceGCEvent blk -> Rep (TraceGCEvent blk) x
$cto :: forall blk x. Rep (TraceGCEvent blk) x -> TraceGCEvent blk
$cfrom :: forall blk x. TraceGCEvent blk -> Rep (TraceGCEvent blk) x
Generic, TraceGCEvent blk -> TraceGCEvent blk -> Bool
(TraceGCEvent blk -> TraceGCEvent blk -> Bool)
-> (TraceGCEvent blk -> TraceGCEvent blk -> Bool)
-> Eq (TraceGCEvent blk)
forall blk. TraceGCEvent blk -> TraceGCEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceGCEvent blk -> TraceGCEvent blk -> Bool
$c/= :: forall blk. TraceGCEvent blk -> TraceGCEvent blk -> Bool
== :: TraceGCEvent blk -> TraceGCEvent blk -> Bool
$c== :: forall blk. TraceGCEvent blk -> TraceGCEvent blk -> Bool
Eq, Int -> TraceGCEvent blk -> String -> String
[TraceGCEvent blk] -> String -> String
TraceGCEvent blk -> String
(Int -> TraceGCEvent blk -> String -> String)
-> (TraceGCEvent blk -> String)
-> ([TraceGCEvent blk] -> String -> String)
-> Show (TraceGCEvent blk)
forall blk. Int -> TraceGCEvent blk -> String -> String
forall blk. [TraceGCEvent blk] -> String -> String
forall blk. TraceGCEvent blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TraceGCEvent blk] -> String -> String
$cshowList :: forall blk. [TraceGCEvent blk] -> String -> String
show :: TraceGCEvent blk -> String
$cshow :: forall blk. TraceGCEvent blk -> String
showsPrec :: Int -> TraceGCEvent blk -> String -> String
$cshowsPrec :: forall blk. Int -> TraceGCEvent blk -> String -> String
Show)

data TraceIteratorEvent blk
    -- | An unknown range was requested, see 'UnknownRange'.
  = UnknownRangeRequested (UnknownRange blk)

    -- | Stream only from the VolatileDB.
  | StreamFromVolatileDB
      (StreamFrom blk)
      (StreamTo   blk)
      [RealPoint  blk]

    -- | Stream only from the ImmutableDB.
  | StreamFromImmutableDB
      (StreamFrom blk)
      (StreamTo   blk)

    -- | Stream from both the VolatileDB and the ImmutableDB.
  | StreamFromBoth
      (StreamFrom blk)
      (StreamTo   blk)
      [RealPoint  blk]

    -- | A block is no longer in the VolatileDB because it has been garbage
    -- collected. It might now be in the ImmutableDB if it was part of the
    -- current chain.
  | BlockMissingFromVolatileDB (RealPoint blk)

    -- | A block that has been garbage collected from the VolatileDB is now
    -- found and streamed from the ImmutableDB.
  | BlockWasCopiedToImmutableDB (RealPoint blk)

    -- | A block is no longer in the VolatileDB and isn't in the ImmutableDB
    -- either; it wasn't part of the current chain.
  | BlockGCedFromVolatileDB    (RealPoint blk)

    -- | We have streamed one or more blocks from the ImmutableDB that were part
    -- of the VolatileDB when initialising the iterator. Now, we have to look
    -- back in the VolatileDB again because the ImmutableDB doesn't have the
    -- next block we're looking for.
  | SwitchBackToVolatileDB
  deriving ((forall x.
 TraceIteratorEvent blk -> Rep (TraceIteratorEvent blk) x)
-> (forall x.
    Rep (TraceIteratorEvent blk) x -> TraceIteratorEvent blk)
-> Generic (TraceIteratorEvent blk)
forall x. Rep (TraceIteratorEvent blk) x -> TraceIteratorEvent blk
forall x. TraceIteratorEvent blk -> Rep (TraceIteratorEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TraceIteratorEvent blk) x -> TraceIteratorEvent blk
forall blk x.
TraceIteratorEvent blk -> Rep (TraceIteratorEvent blk) x
$cto :: forall blk x.
Rep (TraceIteratorEvent blk) x -> TraceIteratorEvent blk
$cfrom :: forall blk x.
TraceIteratorEvent blk -> Rep (TraceIteratorEvent blk) x
Generic, TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool
(TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool)
-> (TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool)
-> Eq (TraceIteratorEvent blk)
forall blk.
StandardHash blk =>
TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool
== :: TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
TraceIteratorEvent blk -> TraceIteratorEvent blk -> Bool
Eq, Int -> TraceIteratorEvent blk -> String -> String
[TraceIteratorEvent blk] -> String -> String
TraceIteratorEvent blk -> String
(Int -> TraceIteratorEvent blk -> String -> String)
-> (TraceIteratorEvent blk -> String)
-> ([TraceIteratorEvent blk] -> String -> String)
-> Show (TraceIteratorEvent blk)
forall blk.
StandardHash blk =>
Int -> TraceIteratorEvent blk -> String -> String
forall blk.
StandardHash blk =>
[TraceIteratorEvent blk] -> String -> String
forall blk. StandardHash blk => TraceIteratorEvent blk -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [TraceIteratorEvent blk] -> String -> String
$cshowList :: forall blk.
StandardHash blk =>
[TraceIteratorEvent blk] -> String -> String
show :: TraceIteratorEvent blk -> String
$cshow :: forall blk. StandardHash blk => TraceIteratorEvent blk -> String
showsPrec :: Int -> TraceIteratorEvent blk -> String -> String
$cshowsPrec :: forall blk.
StandardHash blk =>
Int -> TraceIteratorEvent blk -> String -> String
Show)