{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications    #-}

-- | Queries
module Ouroboros.Consensus.Storage.ChainDB.Impl.Query (
    -- * Queries
    getBlockComponent
  , getCurrentChain
  , getIsFetched
  , getIsInvalidBlock
  , getIsValid
  , getLedgerDB
  , getMaxSlotNo
  , getTipBlock
  , getTipHeader
  , getTipPoint
    -- * Low-level queries
  , getAnyBlockComponent
  , getAnyKnownBlock
  , getAnyKnownBlockComponent
  ) where

import qualified Data.Map.Strict as Map
import qualified Data.Set as Set

import           Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.Block (MaxSlotNo, maxSlotNoFromWithOrigin)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Config
import           Ouroboros.Consensus.Protocol.Abstract
import           Ouroboros.Consensus.Util (eitherToMaybe)
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.STM (WithFingerprint (..))

import           Ouroboros.Consensus.Storage.ChainDB.API (BlockComponent (..),
                     ChainDbFailure (..), InvalidBlockReason)
import qualified Ouroboros.Consensus.Storage.ChainDB.Impl.LgrDB as LgrDB
import           Ouroboros.Consensus.Storage.ChainDB.Impl.Types
import           Ouroboros.Consensus.Storage.ImmutableDB (ImmutableDB)
import qualified Ouroboros.Consensus.Storage.ImmutableDB as ImmutableDB
import           Ouroboros.Consensus.Storage.VolatileDB (VolatileDB)
import qualified Ouroboros.Consensus.Storage.VolatileDB as VolatileDB

-- | Return the last @k@ headers.
--
-- While the in-memory fragment ('cdbChain') might temporarily be longer than
-- @k@ (until the background thread has copied those blocks to the
-- ImmutableDB), this function will never return a fragment longer than @k@.
--
-- The anchor point of the returned fragment will be the most recent
-- \"immutable\" block, i.e. a block that cannot be rolled back. In
-- ChainDB.md, we call this block @i@.
--
-- Note that the returned fragment may be shorter than @k@ in case the whole
-- chain itself is shorter than @k@ or in case the VolatileDB was corrupted.
-- In the latter case, we don't take blocks already in the ImmutableDB into
-- account, as we know they /must/ have been \"immutable\" at some point, and,
-- therefore, /must/ still be \"immutable\".
getCurrentChain
  :: forall m blk.
     ( IOLike m
     , HasHeader (Header blk)
     , ConsensusProtocol (BlockProtocol blk)
     )
  => ChainDbEnv m blk
  -> STM m (AnchoredFragment (Header blk))
getCurrentChain :: ChainDbEnv m blk -> STM m (AnchoredFragment (Header blk))
getCurrentChain CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
..} =
    Word64
-> AnchoredFragment (Header blk) -> AnchoredFragment (Header blk)
forall v a b.
Anchorable v a b =>
Word64 -> AnchoredSeq v a b -> AnchoredSeq v a b
AF.anchorNewest Word64
k (AnchoredFragment (Header blk) -> AnchoredFragment (Header blk))
-> STM m (AnchoredFragment (Header blk))
-> STM m (AnchoredFragment (Header blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (AnchoredFragment (Header blk))
-> STM m (AnchoredFragment (Header blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (AnchoredFragment (Header blk))
cdbChain
  where
    SecurityParam Word64
k = TopLevelConfig blk -> SecurityParam
forall blk.
ConsensusProtocol (BlockProtocol blk) =>
TopLevelConfig blk -> SecurityParam
configSecurityParam TopLevelConfig blk
cdbTopLevelConfig

getLedgerDB ::
     IOLike m
  => ChainDbEnv m blk -> STM m (LgrDB.LedgerDB' blk)
getLedgerDB :: ChainDbEnv m blk -> STM m (LedgerDB' blk)
getLedgerDB CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = LgrDB m blk -> STM m (LedgerDB' blk)
forall (m :: * -> *) blk.
IOLike m =>
LgrDB m blk -> STM m (LedgerDB' blk)
LgrDB.getCurrent LgrDB m blk
cdbLgrDB

getTipBlock
  :: forall m blk.
     ( IOLike m
     , HasHeader blk
     , HasHeader (Header blk)
     )
  => ChainDbEnv m blk
  -> m (Maybe blk)
getTipBlock :: ChainDbEnv m blk -> m (Maybe blk)
getTipBlock cdb :: ChainDbEnv m blk
cdb@CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = do
    Point blk
tipPoint <- STM m (Point blk) -> m (Point blk)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (Point blk) -> m (Point blk))
-> STM m (Point blk) -> m (Point blk)
forall a b. (a -> b) -> a -> b
$ ChainDbEnv m blk -> STM m (Point blk)
forall (m :: * -> *) blk.
(IOLike m, HasHeader (Header blk)) =>
ChainDbEnv m blk -> STM m (Point blk)
getTipPoint ChainDbEnv m blk
cdb
    case Point blk -> WithOrigin (RealPoint blk)
forall blk. Point blk -> WithOrigin (RealPoint blk)
pointToWithOriginRealPoint Point blk
tipPoint of
      WithOrigin (RealPoint blk)
Origin      -> Maybe blk -> m (Maybe blk)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe blk
forall a. Maybe a
Nothing
      NotOrigin RealPoint blk
p -> blk -> Maybe blk
forall a. a -> Maybe a
Just (blk -> Maybe blk) -> m blk -> m (Maybe blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImmutableDB m blk -> VolatileDB m blk -> RealPoint blk -> m blk
forall (m :: * -> *) blk.
(IOLike m, HasHeader blk) =>
ImmutableDB m blk -> VolatileDB m blk -> RealPoint blk -> m blk
getAnyKnownBlock ImmutableDB m blk
cdbImmutableDB VolatileDB m blk
cdbVolatileDB RealPoint blk
p

getTipHeader
  :: forall m blk.
     ( IOLike m
     , HasHeader blk
     , HasHeader (Header blk)
     )
  => ChainDbEnv m blk
  -> m (Maybe (Header blk))
getTipHeader :: ChainDbEnv m blk -> m (Maybe (Header blk))
getTipHeader CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = do
    Either (Anchor (Header blk)) (Header blk)
anchorOrHdr <- AnchoredFragment (Header blk)
-> Either (Anchor (Header blk)) (Header blk)
forall v a b. Anchorable v a b => AnchoredSeq v a b -> Either a b
AF.head (AnchoredFragment (Header blk)
 -> Either (Anchor (Header blk)) (Header blk))
-> m (AnchoredFragment (Header blk))
-> m (Either (Anchor (Header blk)) (Header blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> STM m (AnchoredFragment (Header blk))
-> m (AnchoredFragment (Header blk))
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (StrictTVar m (AnchoredFragment (Header blk))
-> STM m (AnchoredFragment (Header blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (AnchoredFragment (Header blk))
cdbChain)
    case Either (Anchor (Header blk)) (Header blk)
anchorOrHdr of
      Right Header blk
hdr   -> Maybe (Header blk) -> m (Maybe (Header blk))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Header blk) -> m (Maybe (Header blk)))
-> Maybe (Header blk) -> m (Maybe (Header blk))
forall a b. (a -> b) -> a -> b
$ Header blk -> Maybe (Header blk)
forall a. a -> Maybe a
Just Header blk
hdr
      Left Anchor (Header blk)
anchor ->
        case Point blk -> WithOrigin (RealPoint blk)
forall blk. Point blk -> WithOrigin (RealPoint blk)
pointToWithOriginRealPoint (Point (Header blk) -> Point blk
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Anchor (Header blk) -> Point (Header blk)
forall block. Anchor block -> Point block
AF.anchorToPoint Anchor (Header blk)
anchor)) of
          WithOrigin (RealPoint blk)
Origin      -> Maybe (Header blk) -> m (Maybe (Header blk))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Header blk)
forall a. Maybe a
Nothing
          NotOrigin RealPoint blk
p ->
            -- In this case, the fragment is empty but the anchor point is not
            -- genesis. It must be that the VolatileDB got emptied and that our
            -- current tip is now the tip of the ImmutableDB.

            -- Note that we can't use 'getBlockAtTip' because a block might have
            -- been appended to the ImmutableDB since we obtained 'anchorOrHdr'.
            Header blk -> Maybe (Header blk)
forall a. a -> Maybe a
Just (Header blk -> Maybe (Header blk))
-> m (Header blk) -> m (Maybe (Header blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImmutableDB m blk
-> BlockComponent blk (Header blk)
-> RealPoint blk
-> m (Header blk)
forall (m :: * -> *) blk b.
(MonadThrow m, HasHeader blk) =>
ImmutableDB m blk -> BlockComponent blk b -> RealPoint blk -> m b
ImmutableDB.getKnownBlockComponent ImmutableDB m blk
cdbImmutableDB BlockComponent blk (Header blk)
forall blk. BlockComponent blk (Header blk)
GetHeader RealPoint blk
p

getTipPoint
  :: forall m blk. (IOLike m, HasHeader (Header blk))
  => ChainDbEnv m blk -> STM m (Point blk)
getTipPoint :: ChainDbEnv m blk -> STM m (Point blk)
getTipPoint CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} =
    (Point (Header blk) -> Point blk
forall b b'.
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Header blk) -> Point blk)
-> (AnchoredFragment (Header blk) -> Point (Header blk))
-> AnchoredFragment (Header blk)
-> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment (Header blk) -> Point (Header blk)
forall block.
HasHeader block =>
AnchoredFragment block -> Point block
AF.headPoint) (AnchoredFragment (Header blk) -> Point blk)
-> STM m (AnchoredFragment (Header blk)) -> STM m (Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (AnchoredFragment (Header blk))
-> STM m (AnchoredFragment (Header blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (AnchoredFragment (Header blk))
cdbChain

getBlockComponent ::
     forall m blk b. IOLike m
  => ChainDbEnv m blk
  -> BlockComponent blk b
  -> RealPoint blk -> m (Maybe b)
getBlockComponent :: ChainDbEnv m blk
-> BlockComponent blk b -> RealPoint blk -> m (Maybe b)
getBlockComponent CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = ImmutableDB m blk
-> VolatileDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Maybe b)
forall (m :: * -> *) blk b.
IOLike m =>
ImmutableDB m blk
-> VolatileDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Maybe b)
getAnyBlockComponent ImmutableDB m blk
cdbImmutableDB VolatileDB m blk
cdbVolatileDB

getIsFetched ::
     forall m blk. IOLike m
  => ChainDbEnv m blk -> STM m (Point blk -> Bool)
getIsFetched :: ChainDbEnv m blk -> STM m (Point blk -> Bool)
getIsFetched CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = (HeaderHash blk -> Bool) -> Point blk -> Bool
basedOnHash ((HeaderHash blk -> Bool) -> Point blk -> Bool)
-> STM m (HeaderHash blk -> Bool) -> STM m (Point blk -> Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VolatileDB m blk -> STM m (HeaderHash blk -> Bool)
forall (m :: * -> *) blk.
Functor (STM m) =>
VolatileDB m blk -> STM m (HeaderHash blk -> Bool)
VolatileDB.getIsMember VolatileDB m blk
cdbVolatileDB
  where
    -- The volatile DB indexes by hash only, not by points. However, it should
    -- not be possible to have two points with the same hash but different
    -- slot numbers.
    basedOnHash :: (HeaderHash blk -> Bool) -> Point blk -> Bool
    basedOnHash :: (HeaderHash blk -> Bool) -> Point blk -> Bool
basedOnHash HeaderHash blk -> Bool
f Point blk
p =
        case Point blk -> ChainHash blk
forall block. Point block -> ChainHash block
pointHash Point blk
p of
          BlockHash HeaderHash blk
hash -> HeaderHash blk -> Bool
f HeaderHash blk
hash
          ChainHash blk
GenesisHash    -> Bool
False

getIsInvalidBlock ::
     forall m blk. (IOLike m, HasHeader blk)
  => ChainDbEnv m blk
  -> STM m (WithFingerprint (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
getIsInvalidBlock :: ChainDbEnv m blk
-> STM
     m
     (WithFingerprint
        (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
getIsInvalidBlock CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} =
  (InvalidBlocks blk
 -> HeaderHash blk -> Maybe (InvalidBlockReason blk))
-> WithFingerprint (InvalidBlocks blk)
-> WithFingerprint
     (HeaderHash blk -> Maybe (InvalidBlockReason blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe (InvalidBlockInfo blk) -> Maybe (InvalidBlockReason blk))
-> (HeaderHash blk -> Maybe (InvalidBlockInfo blk))
-> HeaderHash blk
-> Maybe (InvalidBlockReason blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((InvalidBlockInfo blk -> InvalidBlockReason blk)
-> Maybe (InvalidBlockInfo blk) -> Maybe (InvalidBlockReason blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap InvalidBlockInfo blk -> InvalidBlockReason blk
forall blk. InvalidBlockInfo blk -> InvalidBlockReason blk
invalidBlockReason) ((HeaderHash blk -> Maybe (InvalidBlockInfo blk))
 -> HeaderHash blk -> Maybe (InvalidBlockReason blk))
-> (InvalidBlocks blk
    -> HeaderHash blk -> Maybe (InvalidBlockInfo blk))
-> InvalidBlocks blk
-> HeaderHash blk
-> Maybe (InvalidBlockReason blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (HeaderHash blk
 -> InvalidBlocks blk -> Maybe (InvalidBlockInfo blk))
-> InvalidBlocks blk
-> HeaderHash blk
-> Maybe (InvalidBlockInfo blk)
forall a b c. (a -> b -> c) -> b -> a -> c
flip HeaderHash blk -> InvalidBlocks blk -> Maybe (InvalidBlockInfo blk)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup) (WithFingerprint (InvalidBlocks blk)
 -> WithFingerprint
      (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
-> STM m (WithFingerprint (InvalidBlocks blk))
-> STM
     m
     (WithFingerprint
        (HeaderHash blk -> Maybe (InvalidBlockReason blk)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (WithFingerprint (InvalidBlocks blk))
-> STM m (WithFingerprint (InvalidBlocks blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbInvalid

getIsValid ::
     forall m blk. (IOLike m, HasHeader blk)
  => ChainDbEnv m blk
  -> STM m (RealPoint blk -> Maybe Bool)
getIsValid :: ChainDbEnv m blk -> STM m (RealPoint blk -> Maybe Bool)
getIsValid CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = do
    Set (RealPoint blk)
prevApplied <- LgrDB m blk -> STM m (Set (RealPoint blk))
forall (m :: * -> *) blk.
IOLike m =>
LgrDB m blk -> STM m (Set (RealPoint blk))
LgrDB.getPrevApplied LgrDB m blk
cdbLgrDB
    InvalidBlocks blk
invalid     <- WithFingerprint (InvalidBlocks blk) -> InvalidBlocks blk
forall a. WithFingerprint a -> a
forgetFingerprint (WithFingerprint (InvalidBlocks blk) -> InvalidBlocks blk)
-> STM m (WithFingerprint (InvalidBlocks blk))
-> STM m (InvalidBlocks blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (WithFingerprint (InvalidBlocks blk))
-> STM m (WithFingerprint (InvalidBlocks blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbInvalid
    (RealPoint blk -> Maybe Bool)
-> STM m (RealPoint blk -> Maybe Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return ((RealPoint blk -> Maybe Bool)
 -> STM m (RealPoint blk -> Maybe Bool))
-> (RealPoint blk -> Maybe Bool)
-> STM m (RealPoint blk -> Maybe Bool)
forall a b. (a -> b) -> a -> b
$ \pt :: RealPoint blk
pt@(RealPoint SlotNo
_ HeaderHash blk
hash) ->
      -- Blocks from the future that were valid according to the ledger but
      -- that exceeded the max clock skew will be in 'prevApplied' *and*
      -- 'invalid'. So we first check 'invalid' before 'prevApplied'. See
      -- #2413.
      if | HeaderHash blk -> InvalidBlocks blk -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member HeaderHash blk
hash InvalidBlocks blk
invalid   -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False
         | RealPoint blk -> Set (RealPoint blk) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member RealPoint blk
pt Set (RealPoint blk)
prevApplied -> Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True
         | Bool
otherwise                 -> Maybe Bool
forall a. Maybe a
Nothing

getMaxSlotNo ::
     forall m blk. (IOLike m, HasHeader (Header blk))
  => ChainDbEnv m blk -> STM m MaxSlotNo
getMaxSlotNo :: ChainDbEnv m blk -> STM m MaxSlotNo
getMaxSlotNo CDB{Tracer m (LedgerDB' blk)
Tracer m (TraceEvent blk)
DiffTime
StrictTVar m (m ())
StrictTVar m (FutureBlocks m blk)
StrictTVar m (Map FollowerKey (FollowerHandle m blk))
StrictTVar m (Map IteratorKey (m ()))
StrictTVar m (AnchoredFragment (Header blk))
StrictTVar m (StrictMaybe (Header blk))
StrictTVar m (WithFingerprint (InvalidBlocks blk))
StrictTVar m (TentativeState blk)
StrictTVar m FollowerKey
StrictTVar m IteratorKey
TopLevelConfig blk
StrictMVar m ()
VolatileDB m blk
ChunkInfo
ResourceRegistry m
ImmutableDB m blk
CheckInFuture m blk
LgrDB m blk
BlocksToAdd m blk
blk -> Bool
cdbFutureBlocks :: StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: BlocksToAdd m blk
cdbCheckInFuture :: CheckInFuture m blk
cdbCheckIntegrity :: blk -> Bool
cdbChunkInfo :: ChunkInfo
cdbKillBgThreads :: StrictTVar m (m ())
cdbGcInterval :: DiffTime
cdbGcDelay :: DiffTime
cdbRegistry :: ResourceRegistry m
cdbTraceLedger :: Tracer m (LedgerDB' blk)
cdbTracer :: Tracer m (TraceEvent blk)
cdbCopyLock :: StrictMVar m ()
cdbNextFollowerKey :: StrictTVar m FollowerKey
cdbNextIteratorKey :: StrictTVar m IteratorKey
cdbInvalid :: StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: TopLevelConfig blk
cdbFollowers :: StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: StrictTVar m (TentativeState blk)
cdbChain :: StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: LgrDB m blk
cdbVolatileDB :: VolatileDB m blk
cdbImmutableDB :: ImmutableDB m blk
cdbFutureBlocks :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (FutureBlocks m blk)
cdbBlocksToAdd :: forall (m :: * -> *) blk. ChainDbEnv m blk -> BlocksToAdd m blk
cdbCheckInFuture :: forall (m :: * -> *) blk. ChainDbEnv m blk -> CheckInFuture m blk
cdbCheckIntegrity :: forall (m :: * -> *) blk. ChainDbEnv m blk -> blk -> Bool
cdbChunkInfo :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ChunkInfo
cdbKillBgThreads :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictTVar m (m ())
cdbGcInterval :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbGcDelay :: forall (m :: * -> *) blk. ChainDbEnv m blk -> DiffTime
cdbRegistry :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ResourceRegistry m
cdbTraceLedger :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (LedgerDB' blk)
cdbTracer :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> Tracer m (TraceEvent blk)
cdbCopyLock :: forall (m :: * -> *) blk. ChainDbEnv m blk -> StrictMVar m ()
cdbNextFollowerKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m FollowerKey
cdbNextIteratorKey :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m IteratorKey
cdbInvalid :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (WithFingerprint (InvalidBlocks blk))
cdbTopLevelConfig :: forall (m :: * -> *) blk. ChainDbEnv m blk -> TopLevelConfig blk
cdbFollowers :: forall (m :: * -> *) blk.
ChainDbEnv m blk
-> StrictTVar m (Map FollowerKey (FollowerHandle m blk))
cdbIterators :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (Map IteratorKey (m ()))
cdbTentativeHeader :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (StrictMaybe (Header blk))
cdbTentativeState :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (TentativeState blk)
cdbChain :: forall (m :: * -> *) blk.
ChainDbEnv m blk -> StrictTVar m (AnchoredFragment (Header blk))
cdbLgrDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> LgrDB m blk
cdbVolatileDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> VolatileDB m blk
cdbImmutableDB :: forall (m :: * -> *) blk. ChainDbEnv m blk -> ImmutableDB m blk
..} = do
    -- Note that we need to look at both the current chain and the VolatileDB
    -- in all cases (even when the VolatileDB is not empty), because the
    -- VolatileDB might have been corrupted.
    --
    -- For example, imagine the VolatileDB has been corrupted so that it only
    -- contains block 9'. The ImmutableDB contains blocks 1-10. The max slot
    -- of the current chain will be 10 (being the anchor point of the empty
    -- current chain), while the max slot of the VolatileDB will be 9.
    MaxSlotNo
curChainMaxSlotNo <- WithOrigin SlotNo -> MaxSlotNo
maxSlotNoFromWithOrigin (WithOrigin SlotNo -> MaxSlotNo)
-> (AnchoredFragment (Header blk) -> WithOrigin SlotNo)
-> AnchoredFragment (Header blk)
-> MaxSlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredFragment (Header blk) -> WithOrigin SlotNo
forall block.
HasHeader block =>
AnchoredFragment block -> WithOrigin SlotNo
AF.headSlot
                     (AnchoredFragment (Header blk) -> MaxSlotNo)
-> STM m (AnchoredFragment (Header blk)) -> STM m MaxSlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StrictTVar m (AnchoredFragment (Header blk))
-> STM m (AnchoredFragment (Header blk))
forall (m :: * -> *) a. MonadSTM m => StrictTVar m a -> STM m a
readTVar StrictTVar m (AnchoredFragment (Header blk))
cdbChain
    MaxSlotNo
volatileDbMaxSlotNo    <- VolatileDB m blk -> HasCallStack => STM m MaxSlotNo
forall (m :: * -> *) blk.
VolatileDB m blk -> HasCallStack => STM m MaxSlotNo
VolatileDB.getMaxSlotNo VolatileDB m blk
cdbVolatileDB
    MaxSlotNo -> STM m MaxSlotNo
forall (m :: * -> *) a. Monad m => a -> m a
return (MaxSlotNo -> STM m MaxSlotNo) -> MaxSlotNo -> STM m MaxSlotNo
forall a b. (a -> b) -> a -> b
$ MaxSlotNo
curChainMaxSlotNo MaxSlotNo -> MaxSlotNo -> MaxSlotNo
forall a. Ord a => a -> a -> a
`max` MaxSlotNo
volatileDbMaxSlotNo

{-------------------------------------------------------------------------------
  Unifying interface over the immutable DB and volatile DB, but independent
  of the ledger DB. These functions therefore do not require the entire
  Chain DB to have been initialized.
-------------------------------------------------------------------------------}

-- | Variant of 'getAnyBlockComponent' instantiated with 'GetBlock'.
getAnyKnownBlock ::
     forall m blk.
     ( IOLike m
     , HasHeader blk
     )
  => ImmutableDB m blk
  -> VolatileDB m blk
  -> RealPoint blk
  -> m blk
getAnyKnownBlock :: ImmutableDB m blk -> VolatileDB m blk -> RealPoint blk -> m blk
getAnyKnownBlock ImmutableDB m blk
immutableDB VolatileDB m blk
volatileDB =
    ImmutableDB m blk
-> VolatileDB m blk
-> BlockComponent blk blk
-> RealPoint blk
-> m blk
forall (m :: * -> *) blk b.
(IOLike m, HasHeader blk) =>
ImmutableDB m blk
-> VolatileDB m blk -> BlockComponent blk b -> RealPoint blk -> m b
getAnyKnownBlockComponent ImmutableDB m blk
immutableDB VolatileDB m blk
volatileDB BlockComponent blk blk
forall blk. BlockComponent blk blk
GetBlock

-- | Wrapper around 'getAnyBlockComponent' for blocks we know should exist.
--
-- If the block does not exist, this indicates disk failure.
getAnyKnownBlockComponent ::
     forall m blk b.
     ( IOLike m
     , HasHeader blk
     )
  => ImmutableDB m blk
  -> VolatileDB m blk
  -> BlockComponent blk b
  -> RealPoint blk
  -> m b
getAnyKnownBlockComponent :: ImmutableDB m blk
-> VolatileDB m blk -> BlockComponent blk b -> RealPoint blk -> m b
getAnyKnownBlockComponent ImmutableDB m blk
immutableDB VolatileDB m blk
volatileDB BlockComponent blk b
blockComponent RealPoint blk
p = do
    Either (ChainDbFailure blk) b
mBlock <-
      RealPoint blk -> Maybe b -> Either (ChainDbFailure blk) b
forall blk b.
RealPoint blk -> Maybe b -> Either (ChainDbFailure blk) b
mustExist RealPoint blk
p (Maybe b -> Either (ChainDbFailure blk) b)
-> m (Maybe b) -> m (Either (ChainDbFailure blk) b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        ImmutableDB m blk
-> VolatileDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Maybe b)
forall (m :: * -> *) blk b.
IOLike m =>
ImmutableDB m blk
-> VolatileDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Maybe b)
getAnyBlockComponent ImmutableDB m blk
immutableDB VolatileDB m blk
volatileDB BlockComponent blk b
blockComponent RealPoint blk
p
    case Either (ChainDbFailure blk) b
mBlock of
      Right b
b  -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
b
      Left ChainDbFailure blk
err -> ChainDbFailure blk -> m b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO ChainDbFailure blk
err

-- | Get a block component from either the immutable DB or volatile DB.
--
-- Returns 'Nothing' if the 'Point' is unknown.
-- Throws 'NoGenesisBlockException' if the 'Point' refers to the genesis block.
getAnyBlockComponent ::
     forall m blk b. IOLike m
  => ImmutableDB m blk
  -> VolatileDB m blk
  -> BlockComponent blk b
  -> RealPoint blk
  -> m (Maybe b)
getAnyBlockComponent :: ImmutableDB m blk
-> VolatileDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Maybe b)
getAnyBlockComponent ImmutableDB m blk
immutableDB VolatileDB m blk
volatileDB BlockComponent blk b
blockComponent RealPoint blk
p = do
    -- Note: to determine whether a block is in the ImmutableDB, we can
    -- look at the slot of its tip, which we'll call @immTipSlot@. If the
    -- slot of the requested point > @immTipSlot@, then the block will not
    -- be in the ImmutableDB but in the VolatileDB. However, there is a
    -- race condition here: if between the time we got @immTipSlot@ and
    -- the time we look up the block in the VolatileDB the block was moved
    -- from the VolatileDB to the ImmutableDB, and it was deleted from the
    -- VolatileDB, we won't find the block, even though it is in the
    -- ChainDB.
    --
    -- Therefore, we first query the VolatileDB and if the block is not in
    -- it, then we can get @immTipSlot@ and compare it to the slot of the
    -- requested point. If the slot <= @immTipSlot@ it /must/ be in the
    -- ImmutableDB (no race condition here).
    Maybe b
mbVolatileB <- VolatileDB m blk
-> BlockComponent blk b -> HeaderHash blk -> m (Maybe b)
forall (m :: * -> *) blk.
VolatileDB m blk
-> forall b.
   HasCallStack =>
   BlockComponent blk b -> HeaderHash blk -> m (Maybe b)
VolatileDB.getBlockComponent
                     VolatileDB m blk
volatileDB
                     BlockComponent blk b
blockComponent
                     HeaderHash blk
hash
    case Maybe b
mbVolatileB of
      Just b
b -> Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b)) -> Maybe b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ b -> Maybe b
forall a. a -> Maybe a
Just b
b
      Maybe b
Nothing    -> do
        -- ImmutableDB will throw an exception if we ask for a block past the tip
        WithOrigin SlotNo
immTipSlot <- STM m (WithOrigin SlotNo) -> m (WithOrigin SlotNo)
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (WithOrigin SlotNo) -> m (WithOrigin SlotNo))
-> STM m (WithOrigin SlotNo) -> m (WithOrigin SlotNo)
forall a b. (a -> b) -> a -> b
$ ImmutableDB m blk -> STM m (WithOrigin SlotNo)
forall (m :: * -> *) blk.
(MonadSTM m, HasCallStack) =>
ImmutableDB m blk -> STM m (WithOrigin SlotNo)
ImmutableDB.getTipSlot ImmutableDB m blk
immutableDB
        if SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin (RealPoint blk -> SlotNo
forall blk. RealPoint blk -> SlotNo
realPointSlot RealPoint blk
p) WithOrigin SlotNo -> WithOrigin SlotNo -> Bool
forall a. Ord a => a -> a -> Bool
> WithOrigin SlotNo
immTipSlot then
          -- It's not supposed to be in the ImmutableDB and the VolatileDB
          -- didn't contain it, so return 'Nothing'.
          Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
        else
          Either (MissingBlock blk) b -> Maybe b
forall a b. Either a b -> Maybe b
eitherToMaybe (Either (MissingBlock blk) b -> Maybe b)
-> m (Either (MissingBlock blk) b) -> m (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
            ImmutableDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Either (MissingBlock blk) b)
forall (m :: * -> *) blk b.
HasCallStack =>
ImmutableDB m blk
-> BlockComponent blk b
-> RealPoint blk
-> m (Either (MissingBlock blk) b)
ImmutableDB.getBlockComponent ImmutableDB m blk
immutableDB BlockComponent blk b
blockComponent RealPoint blk
p
  where
    hash :: HeaderHash blk
hash = RealPoint blk -> HeaderHash blk
forall blk. RealPoint blk -> HeaderHash blk
realPointHash RealPoint blk
p

mustExist :: RealPoint blk -> Maybe b -> Either (ChainDbFailure blk) b
mustExist :: RealPoint blk -> Maybe b -> Either (ChainDbFailure blk) b
mustExist RealPoint blk
p Maybe b
Nothing  = ChainDbFailure blk -> Either (ChainDbFailure blk) b
forall a b. a -> Either a b
Left  (ChainDbFailure blk -> Either (ChainDbFailure blk) b)
-> ChainDbFailure blk -> Either (ChainDbFailure blk) b
forall a b. (a -> b) -> a -> b
$ RealPoint blk -> ChainDbFailure blk
forall blk. RealPoint blk -> ChainDbFailure blk
ChainDbMissingBlock RealPoint blk
p
mustExist RealPoint blk
_ (Just b
b) = b -> Either (ChainDbFailure blk) b
forall a b. b -> Either a b
Right (b -> Either (ChainDbFailure blk) b)
-> b -> Either (ChainDbFailure blk) b
forall a b. (a -> b) -> a -> b
$ b
b