{-# LANGUAGE DeriveAnyClass      #-}
# LANGUAGE DeriveGeneric        #
{-# LANGUAGE FlexibleContexts    #-}
# LANGUAGE LambdaCase           #
# LANGUAGE NamedFieldPuns       #
{-# LANGUAGE PatternSynonyms     #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
# LANGUAGE ScopedTypeVariables #
# LANGUAGE ViewPatterns         #

-- | Iterators
module Ouroboros.Consensus.Storage.ChainDB.Impl.Iterator (
    closeAllIterators
  , stream
    -- * Exported for testing purposes
  , IteratorEnv (..)
  , newIterator
  ) where

import           Control.Monad (unless, when)
import           Control.Monad.Except (ExceptT (..), catchError, lift,
                     runExceptT, throwError, withExceptT)
import           Control.Tracer
import           Data.Functor (($>))
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (isJust)
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)

import           Ouroboros.Consensus.Storage.ChainDB.API (BlockComponent (..),
                     ChainDbError (..), Iterator (..), IteratorResult (..),
                     StreamFrom (..), StreamTo (..), UnknownRange (..),
                     getPoint, validBounds)

import           Ouroboros.Consensus.Storage.ChainDB.Impl.Paths (Path (..),
                     computePath)
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

-- | Stream blocks
--
  = Start & end point
--
-- The start point can either be in the ImmutableDB (on our chain) or in the
  VolatileDB ( on our chain or on a recent fork ) . We first check whether it is
  in the VolatileDB , if not , we check if it is in the ImmutableDB ( see
-- \"Garbage collection\" for why this order is important). Similarly for the
-- end point.
--
  If a bound ca n't be found in the ChainDB , an ' UnknownRange ' error is
-- returned.
--
-- When the bounds are nonsensical, e.g.,
  > StreamFromExclusive ( Point      ( SlotNo 3 ) _ )
  > StreamToInclusive    ( RealPoint ( SlotNo 3 ) _ )
  An ' InvalidIteratorRange ' exception is thrown .
--
-- = Paths of blocks
--
-- To stream blocks from the ImmutableDB we can simply use the iterators
-- offered by the ImmutableDB.
--
  To stream blocks from the VolatileDB we have to construct a path of points
  backwards through the VolatileDB , starting from the end point using
-- 'getPredecessor' until we get to the start point, genesis, or we get to a
  block that is not in the VolatileDB . Then , for each point in the path , we
  can ask the VolatileDB for the corresponding block .
--
  If the path through the VolatileDB is incomplete , we will first have to
-- stream blocks from the ImmutableDB and then switch to the path through the
  VolatileDB . We only allow the tip of the ImmutableDB to be the switchover
-- point between the two DBs. In other words, the incomplete path through the
  VolatileDB must fit onto the tip of the ImmutableDB . This must be true at
-- the time of initialising the iterator, but does not have to hold during the
-- whole lifetime of the iterator. If it doesn't fit on it, it means the path
-- forked off more than @k@ blocks in the past and blocks belonging to it are
-- more likely to go missing because of garbage-collection (see the next
  paragraph ) . In that case , we return ' ForkTooOld ' .
--
-- = Garbage collection
--
-- We have to be careful about the following: as our chain grows, blocks from
-- our chain will be copied to the ImmutableDB in the background. After a
  while , old blocks will be garbage - collected from the VolatileDB . Blocks
-- that were part of the current chain will be in the ImmutableDB, but blocks
-- that only lived on forks will be gone forever.
--
  This means that blocks that were part of the VolatileDB when the iterator
  was initialised might no longer be part of the VolatileDB when we come to
-- the point that the iterator will try to read them. When this is noticed, we
-- will try to open an iterator from the ImmutableDB to obtain the blocks that
-- have moved over. However, this will only work if they were and are part of
-- the current chain, otherwise they will have been deleted from the
  VolatileDB without being copied to the ImmutableDB .
--
-- This iterator is opened with an open upper bound and will be used to stream
-- blocks until the path has been fully streamed, the iterator is exhausted,
  or a block does n't match the expected point . In the latter two cases , we
  switch back to the VolatileDB . If the block is missing from the VolatileDB ,
-- we will switch back to streaming from the ImmutableDB. If that fails, we
  switch back to the VolatileDB . To avoid eternally switching between the two
  DBs , we only switch back to the VolatileDB if the stream from the
  ImmutableDB has made progress , i.e. streamed at least one block with the
-- expected point. If no block was streamed from the ImmutableDB, not even the
  first one , we know for sure that that block is n't part of the VolatileDB
-- (the reason we switch to the ImmutableDB) and isn't part of the ImmutableDB
-- (no block was streamed). In that case, we return 'IteratorBlockGCed' and
-- stop the stream.
--
-- Note that the open upper bound doesn't allow us to include blocks in the
-- stream that are copied to the ImmutableDB after opening this iterator, as
-- the bound of the iterator is fixed upon initialisation. These newly added
-- blocks will be included in the stream because we will repeatedly open new
-- ImmutableDB iterators (as long as we make progress).
--
-- = Bounds checking
--
  The VolatileDB is hash - based instead of point - based . While the bounds of a
  stream are /point / s , we can simply check whether the hashes of the bounds
-- match the hashes stored in the points.
--
-- The ImmutableDB is slot-based instead of point-based, which means that
-- before we know whether a block in the ImmutableDB matches a given point, we
  must first read the block 's hash corresponding to the point 's slot from the
-- (cached) on-disk indices, after which we can then verify whether it matches
-- the hash of the point. This is important for the start and end bounds (both
-- points) of a stream in case they are in the ImmutableDB (i.e., their slots
  are < = the tip of the ImmutableDB ): we must first read the hashes
-- corresponding to the bounds from the (cached) on-disk indices to be sure
  the range is valid . Note that these reads happen before the first call to
-- 'iteratorNext'.
--
-- Note that when streaming to an /exclusive/ bound, the block corresponding
-- to that bound ('Point') must exist in the ChainDB.
--
-- The ImmutableDB will keep the on-disk indices of a chunk of blocks in
  memory after the first read so that the next lookup does n't have to read
-- from disk. When both bounds are in the same chunk, which will typically be
  the case , only checking the first bound will require disk reads , the second
-- will be cached.
--
-- = Costs
--
-- Opening an iterator has some costs:
--
-- * When blocks have to be streamed from the ImmutableDB: as discussed in
--   \"Bounds checking\", the hashes corresponding to the bounds have to be
--   read from the (cached) on-disk indices.
--
-- * When blocks have to be streamed both from the ImmutableDB and the
    VolatileDB , only the hash of the block corresponding to the lower bound
--   will have to be read from the ImmutableDB upfront, as described in the
--   previous bullet point. Note that the hash of the block corresponding to
--   the upper bound does not have to be read from disk, since it will be in
    the VolatileDB , which means that we know its hash already from the
--   in-memory index.
--
-- In summary:
--
  * Only streaming from the VolatileDB : 0 ( cached ) reads from disk upfront .
  * Only streaming from the ImmutableDB : 2 ( cached ) reads from disk upfront .
  * Streaming from both the ImmutableDB and the VolatileDB : 1 ( cached ) read
--   from disk upfront.
--
-- Additionally, when we notice during streaming that a block is no longer in
  the VolatileDB , we try to see whether it can be streamed from the ImmutableDB
  instead . Opening such an iterator costs 2 ( cached ) reads from disk upfront .
-- This can happen multiple times.
stream
  :: forall m blk b.
     ( IOLike m
     , HasHeader blk
     , HasCallStack
     )
  => ChainDbHandle m blk
  -> ResourceRegistry m
  -> BlockComponent blk b
  -> StreamFrom blk
  -> StreamTo blk
  -> m (Either (UnknownRange blk) (Iterator m blk b))
stream h registry blockComponent from to = getEnv h $ \cdb ->
    newIterator (fromChainDbEnv cdb) getItEnv registry blockComponent from to
  where
    getItEnv :: forall r. (IteratorEnv m blk -> m r) -> m r
    getItEnv f = getEnv h (f . fromChainDbEnv)

{-------------------------------------------------------------------------------
  Iterator environment
-------------------------------------------------------------------------------}

-- | Environment containing everything needed to implement iterators.
--
-- The main purpose of bundling these things in a separate record is to make
-- it easier to test this code: no need to set up a whole ChainDB, just
-- provide this record.
data IteratorEnv m blk = IteratorEnv {
      itImmutableDB     :: ImmutableDB m blk
    , itVolatileDB      :: VolatileDB m blk
    , itIterators       :: StrictTVar m (Map IteratorKey (m ()))
    , itNextIteratorKey :: StrictTVar m IteratorKey
    , itTracer          :: Tracer m (TraceIteratorEvent blk)
    }

  | Obtain an ' IteratorEnv ' from a ' ChainDbEnv ' .
fromChainDbEnv :: ChainDbEnv m blk -> IteratorEnv m blk
fromChainDbEnv CDB{..} = IteratorEnv {
      itImmutableDB     = cdbImmutableDB
    , itVolatileDB      = cdbVolatileDB
    , itIterators       = cdbIterators
    , itNextIteratorKey = cdbNextIteratorKey
    , itTracer          = contramap TraceIteratorEvent cdbTracer
    }

-- | See 'stream'.
newIterator ::
     forall m blk b. (IOLike m, HasHeader blk, HasCallStack)
  => IteratorEnv m blk
  -> (forall r. (IteratorEnv m blk -> m r) -> m r)
     -- ^ Function with which the operations on the returned iterator should
  obtain their ' IteratorEnv ' . This function should check whether the
     -- ChainDB is still open or throw an exception otherwise. This makes sure
  that when we call ' iteratorNext ' , we first check whether the ChainDB
     -- is still open.
  -> ResourceRegistry m
  -> BlockComponent blk b
  -> StreamFrom blk
  -> StreamTo blk
  -> m (Either (UnknownRange blk) (Iterator m blk b))
newIterator itEnv@IteratorEnv{..} getItEnv registry blockComponent from to = do
    unless (validBounds from to) $
      throwIO $ InvalidIteratorRange from to
    res <- runExceptT start
    case res of
      Left e -> trace $ UnknownRangeRequested e
      _      -> return ()
    return res
  where
    trace = traceWith itTracer

    endPoint :: RealPoint blk
    endPoint = case to of
      StreamToInclusive pt -> pt

    -- | Use the tip of the ImmutableDB to determine whether to look directly
  in the ImmutableDB ( the range is < = the tip ) or first try the
  VolatileDB ( in the other cases ) .
    start :: HasCallStack
          => ExceptT (UnknownRange blk) m (Iterator m blk b)
    start = lift (atomically (ImmutableDB.getTip itImmutableDB)) >>= \case
      Origin -> findPathInVolatileDB
      NotOrigin ImmutableDB.Tip { tipSlotNo, tipHash, tipIsEBB } ->
        case realPointSlot endPoint `compare` tipSlotNo of
          -- The end point is < the tip of the ImmutableDB
          LT -> streamFromImmutableDB

          EQ | realPointHash endPoint == tipHash
                -- The end point == the tip of the ImmutableDB
             -> streamFromImmutableDB

             -- The end point /= the tip of the ImmutableDB.
             --
             -- The end point can be a regular block or EBB. So can the tip of
             -- the ImmutableDB. We distinguish the following for cases where
  each block and EBB has the same slot number , and a block or
             -- EBB /not/ on the current chain is indicated with a '.
             --
  1 .  : .. :> EBB :> B
             --    end point: B'
     desired outcome : ForkTooOld
             --
  2 .  : .. :> EBB :> B
             --    end point: EBB'
     desired outcome : ForkTooOld
             --
  3 .  : .. :> EBB :> B
             --    end point: EBB
             --    desired outcome: stream from ImmutableDB
             --
  4 .  : .. :> EBB
             --    end point: B
     desired outcome : find path in the VolatileDB
             --
  5 .  : .. :> EBB
             --    end point: B'
     desired outcome : ForkTooOld
             --
  6 .  : .. :> EBB
             --    end point: EBB'
     desired outcome : ForkTooOld
             --
             -- We don't know upfront whether the given end point refers to a
             -- block or EBB nor whether it is part of the current chain or
             -- not. This means we don't know yet with which case we are
             -- dealing. The only thing we know for sure, is whether the
  ImmutableDB tip ends with a regular block ( 1 - 3 ) or an EBB
  ( 4 - 6 ) .

             | IsNotEBB <- tipIsEBB  -- Cases 1-3
             -> streamFromImmutableDB `catchError`
                -- We also use 'streamFromImmutableDB' to check whether the
                -- block or EBB is in the ImmutableDB. If that's not the case,
  ' streamFromImmutableDB ' will return ' MissingBlock ' . Instead
  of returning that , we should return ' ForkTooOld ' , which is
                -- more correct.
                const (throwError $ ForkTooOld from)
             | otherwise  -- Cases 4-6
             -> findPathInVolatileDB

          -- The end point is > the tip of the ImmutableDB
          GT -> findPathInVolatileDB

    -- | PRECONDITION: the upper bound >= the tip of the ImmutableDB.
  Greater or /equal/ , because of EBBs :(
    findPathInVolatileDB ::
         HasCallStack => ExceptT (UnknownRange blk) m (Iterator m blk b)
    findPathInVolatileDB = do
      path <- lift $ computePathVolatileDB itVolatileDB from to
      case path of
        NotInVolatileDB        _hash        -> throwError $ ForkTooOld from
        PartiallyInVolatileDB  predHash pts -> streamFromBoth predHash pts
        CompletelyInVolatileDB pts          -> case NE.nonEmpty pts of
          Just pts' -> lift $ streamFromVolatileDB pts'
          Nothing   -> lift $ emptyIterator

    streamFromVolatileDB :: NonEmpty (RealPoint blk) -> m (Iterator m blk b)
    streamFromVolatileDB pts = do
      trace $ StreamFromVolatileDB from to (NE.toList pts)
      createIterator $ InVolatileDB from pts

    streamFromImmutableDB :: ExceptT (UnknownRange blk) m (Iterator m blk b)
    streamFromImmutableDB = do
      lift $ trace $ StreamFromImmutableDB from to
      streamFromImmutableDBHelper to

    streamFromImmutableDBHelper ::
         StreamTo blk
      -> ExceptT (UnknownRange blk) m (Iterator m blk b)
    streamFromImmutableDBHelper to' = do
        -- 'ImmutableDB.stream' will check the hash of the block at the
        -- start and end bounds.
        immIt <-
          withExceptT missingBlockToUnknownRange $ ExceptT $
            ImmutableDB.stream
              itImmutableDB
              registry
              ((,) <$> getPoint <*> blockComponent)
              from
              to'
        lift $ createIterator $ InImmutableDB from immIt (StreamTo to')

  | If we have to stream from both the ImmutableDB and the VolatileDB , we
    -- only allow the (current) tip of the ImmutableDB to be the switchover
    -- point between the two DBs. If not, this would mean we have to stream a
    -- fork that forks off more than @k@ blocks in the past, in which case the
  risk of blocks going missing due to GC increases . So we refuse such a
    -- stream.
    streamFromBoth ::
         HasCallStack
      => HeaderHash blk
      -> [RealPoint blk]
      -> ExceptT (UnknownRange blk) m (Iterator m blk b)
    streamFromBoth predHash pts = do
        lift $ trace $ StreamFromBoth from to pts
        lift (fmap ImmutableDB.tipToRealPoint <$>
               atomically (ImmutableDB.getTip itImmutableDB)) >>= \case
          -- The ImmutableDB is empty
          Origin -> throwError $ ForkTooOld from
          -- The incomplete path fits onto the tip of the ImmutableDB.
          NotOrigin pt@(RealPoint _ tipHash)
            | tipHash == predHash
            -> case NE.nonEmpty pts of
                 Just pts' -> startStream pt pts'
                 -- The lower bound was in the ImmutableDB and the upper was
  in the VolatileDB , but the path of points in the
  VolatileDB is actually empty . It must be that the
  exclusive bound was in the VolatileDB and its
                 -- predecessor is the tip of the ImmutableDB.
                 Nothing   -> streamFromImmutableDBHelper (StreamToInclusive pt)
            -- The incomplete path doesn't fit onto the tip of the
            -- ImmutableDB. Note that since we have constructed the
  incomplete path through the VolatileDB , blocks might have
  moved from the VolatileDB to the ImmutableDB so that the tip
            -- of the ImmutableDB has changed. Either the path used to fit
            -- onto the tip but the tip has changed, or the path simply
            -- never fitted onto the tip.
            | otherwise  -> case dropWhile (/= pt) pts of
              -- The current tip is not in the path, this means that the path
              -- never fitted onto the tip of the ImmutableDB. We refuse this
              -- stream.
              []              -> throwError $ ForkTooOld from
              -- The current tip is in the path, with some points after it,
              -- this means that some blocks in our path have moved from the
  VolatileDB to the ImmutableDB . We can shift the switchover
              -- point to the current tip.
              _tipPt:pt':pts' -> startStream pt (pt' NE.:| pts')
              -- The current tip is the end of the path, this means we can
              -- actually stream everything from just the ImmutableDB. It
              -- could be that the exclusive end bound was not part of the
              -- ImmutableDB, so stream to the current tip of the ImmutableDB
              -- (inclusive) to avoid trying to stream (exclusive) to a block
              -- that's not in the ImmutableDB.
              [_tipPt]        -> streamFromImmutableDBHelper (StreamToInclusive pt)
      where
        startStream ::
             RealPoint blk -- ^ Tip of the ImmutableDB
          -> NonEmpty (RealPoint blk)
          -> ExceptT (UnknownRange blk) m (Iterator m blk b)
        startStream immTip pts' = do
          let immEnd = SwitchToVolatileDBFrom (StreamToInclusive immTip) pts'
          immIt <- withExceptT missingBlockToUnknownRange $ ExceptT $
            ImmutableDB.stream
              itImmutableDB
              registry
              ((,) <$> getPoint <*> blockComponent)
              from
              (StreamToInclusive immTip)
          lift $ createIterator $ InImmutableDB from immIt immEnd

    makeIterator ::
         Bool  -- ^ Register the iterator in 'cdbIterators'?
      -> IteratorState m blk b
      -> m (Iterator m blk b)
    makeIterator register itState = do
      iteratorKey <- makeNewIteratorKey
      varItState  <- newTVarIO itState
      when register $ atomically $ modifyTVar itIterators $
  Note that we do n't use ' itEnv ' here , because that would mean that
        -- invoking the function only works when the database is open, which
        -- probably won't be the case.
        Map.insert iteratorKey (implIteratorClose varItState iteratorKey itEnv)
      return Iterator {
          iteratorNext  = getItEnv $
            implIteratorNext  registry varItState blockComponent
        , iteratorClose = getItEnv $
            implIteratorClose          varItState iteratorKey
        }

    emptyIterator :: m (Iterator m blk b)
    emptyIterator = makeIterator False Closed

    -- | This is 'makeIterator' +  it in 'cdbIterators'.
    createIterator :: IteratorState m blk b -> m (Iterator m blk b)
    createIterator = makeIterator True

    makeNewIteratorKey :: m IteratorKey
    makeNewIteratorKey = atomically $ do
      newIteratorKey <- readTVar itNextIteratorKey
      modifyTVar itNextIteratorKey succ
      return newIteratorKey

  | Variant of ' computePath ' that computes a path through the VolatileDB .
  Throws an ' InvalidIteratorRange ' exception when the range is invalid ( i.e. ,
-- 'computePath' returned 'Nothing').
computePathVolatileDB ::
     (IOLike m, HasHeader blk)
  => VolatileDB m blk
  -> StreamFrom blk
  -> StreamTo   blk
  -> m (Path blk)
computePathVolatileDB volatileDB from to = do
    lookupBlockInfo <- atomically $ VolatileDB.getBlockInfo volatileDB
    case computePath lookupBlockInfo from to of
      Just path -> return path
      Nothing   -> throwIO $ InvalidIteratorRange from to

-- | Close the iterator and remove it from the map of iterators ('itIterators'
-- and thus 'cdbIterators').
implIteratorClose ::
     IOLike m
  => StrictTVar m (IteratorState m blk b)
  -> IteratorKey
  -> IteratorEnv m blk
  -> m ()
implIteratorClose varItState itrKey IteratorEnv{..} = do
    mbImmIt <- atomically $ do
      modifyTVar itIterators (Map.delete itrKey)
      mbImmIt <- iteratorStateImmutableIt <$> readTVar varItState
      writeTVar varItState Closed
      return mbImmIt
    mapM_ ImmutableDB.iteratorClose mbImmIt

-- | Possible states of an iterator.
--
-- When streaming solely from the ImmutableDB ('InImmutableDB' where
  ' InImmutableDBEnd ' is /not/ ' SwitchToVolatileDBFrom ' ): we will remain in this
-- state until we are done, and end up in 'Closed'.
--
  When streaming solely from the VolatileDB ( '  ' ): when
-- 'VolatileDB.getBlock' returns 'Nothing', i.e. the block is missing from the
  VolatileDB and might have moved to the ImmutableDB : we switch to the
-- 'InImmutableDBRetry' state, unless we just come from that state, in that
-- case, return 'IteratorBlockGCed' and close the iterator.
--
-- When streaming from the ImmutableDB with a planned switchover to the
  VolatileDB ( ' InImmutableDB ' where ' InImmutableDBEnd ' is
-- 'SwitchToVolatileDBFrom') and we have reached the end of the ImmutableDB
-- iterator (exhausted or upper bound is reached): we switch to the
-- 'InVolatileDB' state.
--
  In the ' InImmutableDBRetry ' state , we distinguish two cases :
--
  1 . We have just switched to it because a block was missing from the
     VolatileDB . We have an iterator that could stream this block from the
      ( if it was indeed moved to the ImmutableDB ) . If the streamed
--    block matches the expected point, we continue. If not, or if the
--    iterator is immediately exhausted, then the block is missing and we
--    return 'IteratorBlockGCed' and close the iterator.
--
  2 . We have successfully streamed one or more blocks from the ImmutableDB
     that were previously part of the VolatileDB . When we now encounter a
--    block of which the point does not match the expected point or when the
--    iterator is exhausted, we switch back to the 'InVolatileDB' state.
--
data IteratorState m blk b
  = InImmutableDB
      !(StreamFrom blk)
      !(ImmutableDB.Iterator m blk (Point blk, b))
      !(InImmutableDBEnd blk)
    -- ^ Streaming from the ImmutableDB.
    --
  Invariant : an ImmutableDB iterator opened using the ' StreamFrom '
    -- parameter as lower bound will yield the same next block as the iterator
  stored as parameter . There is one difference , which is exactly the
  reason for keeping track of this ' StreamFrom ' : if the latter iterator
    -- (the parameter) is exhausted and blocks have been appended to the end
    -- of the ImmutableDB since it was originally opened, the new iterator can
    -- include them in its stream.
    --
    -- Invariant: the iterator is not exhausted.
  | InVolatileDB
      !(StreamFrom blk)
      !(NonEmpty (RealPoint blk))
  ^ Streaming from the VolatileDB .
    --
    -- The (non-empty) list of points is the path to follow through the
  VolatileDB .
    --
    -- Invariant: if the blocks corresponding to the points have been moved to
    -- the ImmutableDB, it should be possible to stream these blocks from the
  ImmutableDB by starting an iterator using the ' StreamFrom ' parameter .
    -- Note that the points of these blocks still have to be checked against
    -- the points in the path, because the blocks might not have been part of
    -- the current chain, in which case they will not be in the ImmutableDB.
  | InImmutableDBRetry
      !(StreamFrom blk)
      !(ImmutableDB.Iterator m blk (Point blk, b))
      !(NonEmpty (RealPoint blk))
  ^ When streaming blocks ( a list of points ) from the VolatileDB , we
  noticed a block was missing from the VolatileDB . It may have moved to
    -- the ImmutableDB since we initialised the iterator (and built the path),
    -- so we'll try if we can stream it from the ImmutableDB.
    --
    -- Invariants: invariants of 'InImmutableDB' + invariant of 'InVolatileDB'.

  | Closed
  deriving (Generic)

instance (Typeable blk, StandardHash blk)
      => NoThunks (IteratorState m blk b)
  -- use generic instance

  | Extract the ImmutableDB Iterator from the ' IteratorState ' .
iteratorStateImmutableIt ::
     IteratorState m blk b
  -> Maybe (ImmutableDB.Iterator m blk (Point blk, b))
iteratorStateImmutableIt = \case
    Closed                       -> Nothing
    InImmutableDB      _ immIt _ -> Just immIt
    InImmutableDBRetry _ immIt _ -> Just immIt
    InVolatileDB {}              -> Nothing

-- | Determines if/when to stop streaming from the ImmutableDB and what to do
-- afterwards.
data InImmutableDBEnd blk =
    StreamAll
    -- ^ Don't stop streaming until the iterator is exhausted.
  | StreamTo               !(StreamTo blk)
    -- ^ Stream to the upper bound.
  | SwitchToVolatileDBFrom !(StreamTo blk) !(NonEmpty (RealPoint blk))
    -- ^ Stream to the upper bound. Afterwards, start streaming the path (the
  second parameter ) from the VolatileDB .
  deriving (Generic, NoThunks)

implIteratorNext ::
    forall m blk b. (IOLike m, HasHeader blk)
  => ResourceRegistry m
  -> StrictTVar m (IteratorState m blk b)
  -> BlockComponent blk b
  -> IteratorEnv m blk
  -> m (IteratorResult blk b)
implIteratorNext registry varItState blockComponent IteratorEnv{..} =
    atomically (readTVar varItState) >>= \case
      Closed ->
        return IteratorExhausted
      InImmutableDB continueAfter immIt immEnd ->
        nextInImmutableDB continueAfter immIt immEnd
      InImmutableDBRetry continueAfter immIt immPts ->
        nextInImmutableDBRetry (Just continueAfter) immIt immPts
      InVolatileDB continueAfter volPts ->
        nextInVolatileDB continueAfter volPts
  where
    trace = traceWith itTracer

    -- | Read the next block while in the 'InVolatileDB' state.
    nextInVolatileDB ::
         StreamFrom blk
  ^ In case the block corresponding to the first point in
  the path is missing from the VolatileDB , we can use this
         -- lower bound to try to stream it from the ImmutableDB (if
         -- the block indeed has been moved there).
      -> NonEmpty (RealPoint blk)
      -> m (IteratorResult blk b)
    nextInVolatileDB continueFrom (pt@(realPointHash -> hash) NE.:| pts) =
      VolatileDB.getBlockComponent itVolatileDB blockComponent hash >>= \case
        -- Block is missing
        Nothing -> do
            trace $ BlockMissingFromVolatileDB pt
            -- Try if we can stream a block from the ImmutableDB that was
  previously in the VolatileDB . This will only work if the block
            -- was part of the current chain, otherwise it will not have been
            -- copied to the ImmutableDB.
            --
            -- This call cannot throw a 'ReadFutureSlotError' or a
            -- 'ReadFutureEBBError' because if the block is missing, it /must/
            -- have been garbage-collected, which means that its slot was
            -- older than the slot of the tip of the ImmutableDB.
            (fmap ImmutableDB.tipToRealPoint <$>
              atomically (ImmutableDB.getTip itImmutableDB)) >>= \case
              Origin ->
  The block was in the VolatileDB , but is n't anymore . This can
  only happen due to GC . It 's not guaranteed that GC will have
  moved /that/ block to the  ( so it might have just
  disappeared altogether ) , /but/ after GC the ImmutableDB
  can not be empty ( because GC will only be triggered after some
                -- newly immutable blocks have been copied to the ImmutableDB).
                error "nextInVolatileDB: impossible"
              NotOrigin tip -> do
                errOrIt <- ImmutableDB.stream
                  itImmutableDB
                  registry
                  ((,) <$> getPoint <*> blockComponent)
                  continueFrom
                  (StreamToInclusive tip)
                case errOrIt of
                  -- The block was not found in the ImmutableDB, it must have
                  -- been garbage-collected
                  Left  _ -> do
                    trace $ BlockGCedFromVolatileDB pt
                    return $ IteratorBlockGCed pt
                  Right immIt ->
                    nextInImmutableDBRetry Nothing immIt (pt NE.:| pts)

        -- Block is there
        Just b | Just pts' <- NE.nonEmpty pts -> do
          let continueFrom' = StreamFromExclusive (realPointToPoint pt)
          atomically $ writeTVar varItState (InVolatileDB continueFrom' pts')
          return $ IteratorResult b
        -- No more points, so we can stop
        Just b -> do
          atomically $ writeTVar varItState Closed
          return $ IteratorResult b

    -- | Read the next block while in the 'InImmutableDB' state.
    nextInImmutableDB ::
         StreamFrom blk
      -> ImmutableDB.Iterator m blk (Point blk, b)
      -> InImmutableDBEnd blk
      -> m (IteratorResult blk b)
    nextInImmutableDB continueFrom immIt immEnd =
      selectResult immIt >>= \case
        NotDone (pt, b) -> do
          let continueFrom' = StreamFromExclusive pt
          atomically $ writeTVar varItState (InImmutableDB continueFrom' immIt immEnd)
          return $ IteratorResult b
        -- True indicates that this is the last element in the stream
        DoneAfter (pt, b) | SwitchToVolatileDBFrom _ pts <- immEnd -> do
          let continueFrom' = StreamFromExclusive pt
          atomically $ writeTVar varItState (InVolatileDB continueFrom' pts)
          return $ IteratorResult b
        DoneAfter (_pt, b) -> do
          atomically $ writeTVar varItState Closed
          return $ IteratorResult b
        Done | SwitchToVolatileDBFrom _ pts <- immEnd ->
          nextInVolatileDB continueFrom pts
        Done -> do
  No need to switch to the VolatileDB , so we can stop
          atomically $ writeTVar varItState Closed
          return IteratorExhausted

    -- | Read the next block while in the 'InImmutableDBRetry' state.
    --
    -- We try to stream blocks that we suspect are now in the ImmutableDB
  because they are no longer in the VolatileDB . We do n't know this for
    -- sure, so we must check whether they match the expected points.
    nextInImmutableDBRetry ::
         Maybe (StreamFrom blk)
         -- ^ 'Nothing' iff the iterator was just opened and nothing has been
         -- streamed from it yet. This is used to avoid switching right back
  to the VolatileDB if we came from there .
       -> ImmutableDB.Iterator m blk (Point blk, b)
       -> NonEmpty (RealPoint blk)
       -> m (IteratorResult blk b)
    nextInImmutableDBRetry mbContinueFrom immIt (expectedPt NE.:| pts) =
      selectResult immIt >>= \case
        NotDone (actualPt, b) | actualPt == realPointToPoint expectedPt -> do
          trace $ BlockWasCopiedToImmutableDB expectedPt
          let continueFrom' = StreamFromExclusive (realPointToPoint expectedPt)
          case NE.nonEmpty pts of
            Nothing      -> do
              atomically $ writeTVar varItState Closed
              ImmutableDB.iteratorClose immIt
            Just pts' ->
              atomically $ writeTVar varItState $
                InImmutableDBRetry continueFrom' immIt pts'
          return $ IteratorResult b

        DoneAfter (actualPt, b) | actualPt == realPointToPoint expectedPt -> do
          -- 'DoneAfter': 'selectResult' will have closed the ImmutableDB iterator
          -- already
          trace $ BlockWasCopiedToImmutableDB expectedPt
          let continueFrom' = StreamFromExclusive (realPointToPoint expectedPt)
          case NE.nonEmpty pts of
            Nothing      -> atomically $ writeTVar varItState Closed
            Just pts' -> do
              atomically $ writeTVar varItState $ InVolatileDB continueFrom' pts'
              trace SwitchBackToVolatileDB
          return $ IteratorResult b

  Point mismatch or ' Done ' . Close the ImmutableDB Iterator ( idempotent ) .
        _ -> ImmutableDB.iteratorClose immIt *> case mbContinueFrom of
          -- We just switched to this state and the iterator was just opened.
          -- The block must be GC'ed, since we opened the iterator because it
  was missing from the VolatileDB and now it is not in the
          -- ImmutableDB either.
          Nothing -> do
            atomically $ writeTVar varItState Closed
            trace $ BlockGCedFromVolatileDB expectedPt
            return $ IteratorBlockGCed expectedPt

          -- We have already streamed something from the iterator. We can try
  looking in the VolatileDB again . If we had n't streamed something
  yet , switching to the VolatileDB would be pointless as we just
          -- came from there.
          Just continueFrom -> do
            trace SwitchBackToVolatileDB
            nextInVolatileDB continueFrom (expectedPt NE.:| pts)

    -- | Given an ImmutableDB iterator, try to stream a value from it and
    -- convert it to a 'Done'. See the documentation of 'Done' for more
    -- details.
    --
    -- Note that this function closes the iterator when necessary, i.e., when
    -- the return value is 'Done' or 'DoneAfter'.
    selectResult ::
         ImmutableDB.Iterator m blk (Point blk, b)
      -> m (Done (Point blk, b))
    selectResult immIt = do
        itRes   <-                        ImmutableDB.iteratorNext    immIt
        hasNext <- isJust <$> atomically (ImmutableDB.iteratorHasNext immIt)
        case itRes of
          ImmutableDB.IteratorResult blk -> select blk hasNext
          ImmutableDB.IteratorExhausted  -> return Done
      where
        select blk hasNext
          | hasNext
          = return $ NotDone blk
          | otherwise
          = ImmutableDB.iteratorClose immIt $> DoneAfter blk

-- | Auxiliary data type used for 'selectResult' in 'implIteratorNext'.
data Done blk =
    Done
    -- ^ We're done with the iterator, either it is exhausted or we reached
    -- its upper bound.
  | DoneAfter blk
    -- ^ We're done with the iterator, but have to return this last block. We
    -- must have reached its upper /inclusive/ bound.
  | NotDone     blk
    -- ^ We're not done yet with the iterator and have to return this block.

missingBlockToUnknownRange ::
     ImmutableDB.MissingBlock blk
  -> UnknownRange blk
missingBlockToUnknownRange = MissingBlock . ImmutableDB.missingBlockPoint

  | Close all open ' Iterator 's .
--
  This  be called when the ChainDB is already closed .
closeAllIterators :: IOLike m => ChainDbEnv m blk -> m ()
closeAllIterators CDB{..} = do
    iteratorClosers <- atomically $ Map.elems <$> readTVar cdbIterators
    -- Note that each closer removes its entry from the 'cdbIterators' map.
    sequence_ iteratorClosers

# LANGUAGE DeriveAnyClass      #
# LANGUAGE FlexibleContexts    #
# LANGUAGE PatternSynonyms     #
# LANGUAGE RankNTypes          #
# LANGUAGE RecordWildCards     #
 | Iterators
 * Exported for testing purposes
 | Stream blocks


 The start point can either be in the ImmutableDB (on our chain) or in the
 \"Garbage collection\" for why this order is important). Similarly for the
 end point.

 returned.

 When the bounds are nonsensical, e.g.,

 = Paths of blocks

 To stream blocks from the ImmutableDB we can simply use the iterators
 offered by the ImmutableDB.

 'getPredecessor' until we get to the start point, genesis, or we get to a

 stream blocks from the ImmutableDB and then switch to the path through the
 point between the two DBs. In other words, the incomplete path through the
 the time of initialising the iterator, but does not have to hold during the
 whole lifetime of the iterator. If it doesn't fit on it, it means the path
 forked off more than @k@ blocks in the past and blocks belonging to it are
 more likely to go missing because of garbage-collection (see the next

 = Garbage collection

 We have to be careful about the following: as our chain grows, blocks from
 our chain will be copied to the ImmutableDB in the background. After a
 that were part of the current chain will be in the ImmutableDB, but blocks
 that only lived on forks will be gone forever.

 the point that the iterator will try to read them. When this is noticed, we
 will try to open an iterator from the ImmutableDB to obtain the blocks that
 have moved over. However, this will only work if they were and are part of
 the current chain, otherwise they will have been deleted from the

 This iterator is opened with an open upper bound and will be used to stream
 blocks until the path has been fully streamed, the iterator is exhausted,
 we will switch back to streaming from the ImmutableDB. If that fails, we
 expected point. If no block was streamed from the ImmutableDB, not even the
 (the reason we switch to the ImmutableDB) and isn't part of the ImmutableDB
 (no block was streamed). In that case, we return 'IteratorBlockGCed' and
 stop the stream.

 Note that the open upper bound doesn't allow us to include blocks in the
 stream that are copied to the ImmutableDB after opening this iterator, as
 the bound of the iterator is fixed upon initialisation. These newly added
 blocks will be included in the stream because we will repeatedly open new
 ImmutableDB iterators (as long as we make progress).

 = Bounds checking

 match the hashes stored in the points.

 The ImmutableDB is slot-based instead of point-based, which means that
 before we know whether a block in the ImmutableDB matches a given point, we
 (cached) on-disk indices, after which we can then verify whether it matches
 the hash of the point. This is important for the start and end bounds (both
 points) of a stream in case they are in the ImmutableDB (i.e., their slots
 corresponding to the bounds from the (cached) on-disk indices to be sure
 'iteratorNext'.

 Note that when streaming to an /exclusive/ bound, the block corresponding
 to that bound ('Point') must exist in the ChainDB.

 The ImmutableDB will keep the on-disk indices of a chunk of blocks in
 from disk. When both bounds are in the same chunk, which will typically be
 will be cached.

 = Costs

 Opening an iterator has some costs:

 * When blocks have to be streamed from the ImmutableDB: as discussed in
   \"Bounds checking\", the hashes corresponding to the bounds have to be
   read from the (cached) on-disk indices.

 * When blocks have to be streamed both from the ImmutableDB and the
   will have to be read from the ImmutableDB upfront, as described in the
   previous bullet point. Note that the hash of the block corresponding to
   the upper bound does not have to be read from disk, since it will be in
   in-memory index.

 In summary:

   from disk upfront.

 Additionally, when we notice during streaming that a block is no longer in
 This can happen multiple times.
------------------------------------------------------------------------------
  Iterator environment
------------------------------------------------------------------------------
 | Environment containing everything needed to implement iterators.

 The main purpose of bundling these things in a separate record is to make
 it easier to test this code: no need to set up a whole ChainDB, just
 provide this record.
 | See 'stream'.
 ^ Function with which the operations on the returned iterator should
 ChainDB is still open or throw an exception otherwise. This makes sure
 is still open.
 | Use the tip of the ImmutableDB to determine whether to look directly
 The end point is < the tip of the ImmutableDB
 The end point == the tip of the ImmutableDB
 The end point /= the tip of the ImmutableDB.

 The end point can be a regular block or EBB. So can the tip of
 the ImmutableDB. We distinguish the following for cases where
 EBB /not/ on the current chain is indicated with a '.

    end point: B'

    end point: EBB'

    end point: EBB
    desired outcome: stream from ImmutableDB

    end point: B

    end point: B'

    end point: EBB'

 We don't know upfront whether the given end point refers to a
 block or EBB nor whether it is part of the current chain or
 not. This means we don't know yet with which case we are
 dealing. The only thing we know for sure, is whether the
 Cases 1-3
 We also use 'streamFromImmutableDB' to check whether the
 block or EBB is in the ImmutableDB. If that's not the case,
 more correct.
 Cases 4-6
 The end point is > the tip of the ImmutableDB
 | PRECONDITION: the upper bound >= the tip of the ImmutableDB.
 'ImmutableDB.stream' will check the hash of the block at the
 start and end bounds.
 only allow the (current) tip of the ImmutableDB to be the switchover
 point between the two DBs. If not, this would mean we have to stream a
 fork that forks off more than @k@ blocks in the past, in which case the
 stream.
 The ImmutableDB is empty
 The incomplete path fits onto the tip of the ImmutableDB.
 The lower bound was in the ImmutableDB and the upper was
 predecessor is the tip of the ImmutableDB.
 The incomplete path doesn't fit onto the tip of the
 ImmutableDB. Note that since we have constructed the
 of the ImmutableDB has changed. Either the path used to fit
 onto the tip but the tip has changed, or the path simply
 never fitted onto the tip.
 The current tip is not in the path, this means that the path
 never fitted onto the tip of the ImmutableDB. We refuse this
 stream.
 The current tip is in the path, with some points after it,
 this means that some blocks in our path have moved from the
 point to the current tip.
 The current tip is the end of the path, this means we can
 actually stream everything from just the ImmutableDB. It
 could be that the exclusive end bound was not part of the
 ImmutableDB, so stream to the current tip of the ImmutableDB
 (inclusive) to avoid trying to stream (exclusive) to a block
 that's not in the ImmutableDB.
 ^ Tip of the ImmutableDB
 ^ Register the iterator in 'cdbIterators'?
 invoking the function only works when the database is open, which
 probably won't be the case.
 | This is 'makeIterator' +  it in 'cdbIterators'.
 'computePath' returned 'Nothing').
 | Close the iterator and remove it from the map of iterators ('itIterators'
 and thus 'cdbIterators').
 | Possible states of an iterator.

 When streaming solely from the ImmutableDB ('InImmutableDB' where
 state until we are done, and end up in 'Closed'.

 'VolatileDB.getBlock' returns 'Nothing', i.e. the block is missing from the
 'InImmutableDBRetry' state, unless we just come from that state, in that
 case, return 'IteratorBlockGCed' and close the iterator.

 When streaming from the ImmutableDB with a planned switchover to the
 'SwitchToVolatileDBFrom') and we have reached the end of the ImmutableDB
 iterator (exhausted or upper bound is reached): we switch to the
 'InVolatileDB' state.


    block matches the expected point, we continue. If not, or if the
    iterator is immediately exhausted, then the block is missing and we
    return 'IteratorBlockGCed' and close the iterator.

    block of which the point does not match the expected point or when the
    iterator is exhausted, we switch back to the 'InVolatileDB' state.

 ^ Streaming from the ImmutableDB.

 parameter as lower bound will yield the same next block as the iterator
 (the parameter) is exhausted and blocks have been appended to the end
 of the ImmutableDB since it was originally opened, the new iterator can
 include them in its stream.

 Invariant: the iterator is not exhausted.

 The (non-empty) list of points is the path to follow through the

 Invariant: if the blocks corresponding to the points have been moved to
 the ImmutableDB, it should be possible to stream these blocks from the
 Note that the points of these blocks still have to be checked against
 the points in the path, because the blocks might not have been part of
 the current chain, in which case they will not be in the ImmutableDB.
 the ImmutableDB since we initialised the iterator (and built the path),
 so we'll try if we can stream it from the ImmutableDB.

 Invariants: invariants of 'InImmutableDB' + invariant of 'InVolatileDB'.
 use generic instance
 | Determines if/when to stop streaming from the ImmutableDB and what to do
 afterwards.
 ^ Don't stop streaming until the iterator is exhausted.
 ^ Stream to the upper bound.
 ^ Stream to the upper bound. Afterwards, start streaming the path (the
 | Read the next block while in the 'InVolatileDB' state.
 lower bound to try to stream it from the ImmutableDB (if
 the block indeed has been moved there).
 Block is missing
 Try if we can stream a block from the ImmutableDB that was
 was part of the current chain, otherwise it will not have been
 copied to the ImmutableDB.

 This call cannot throw a 'ReadFutureSlotError' or a
 'ReadFutureEBBError' because if the block is missing, it /must/
 have been garbage-collected, which means that its slot was
 older than the slot of the tip of the ImmutableDB.
 newly immutable blocks have been copied to the ImmutableDB).
 The block was not found in the ImmutableDB, it must have
 been garbage-collected
 Block is there
 No more points, so we can stop
 | Read the next block while in the 'InImmutableDB' state.
 True indicates that this is the last element in the stream
 | Read the next block while in the 'InImmutableDBRetry' state.

 We try to stream blocks that we suspect are now in the ImmutableDB
 sure, so we must check whether they match the expected points.
 ^ 'Nothing' iff the iterator was just opened and nothing has been
 streamed from it yet. This is used to avoid switching right back
 'DoneAfter': 'selectResult' will have closed the ImmutableDB iterator
 already
 We just switched to this state and the iterator was just opened.
 The block must be GC'ed, since we opened the iterator because it
 ImmutableDB either.
 We have already streamed something from the iterator. We can try
 came from there.
 | Given an ImmutableDB iterator, try to stream a value from it and
 convert it to a 'Done'. See the documentation of 'Done' for more
 details.

 Note that this function closes the iterator when necessary, i.e., when
 the return value is 'Done' or 'DoneAfter'.
 | Auxiliary data type used for 'selectResult' in 'implIteratorNext'.
 ^ We're done with the iterator, either it is exhausted or we reached
 its upper bound.
 ^ We're done with the iterator, but have to return this last block. We
 must have reached its upper /inclusive/ bound.
 ^ We're not done yet with the iterator and have to return this block.

 Note that each closer removes its entry from the 'cdbIterators' map.
# LANGUAGE DeriveGeneric        #
# LANGUAGE LambdaCase           #
# LANGUAGE NamedFieldPuns       #
# LANGUAGE ScopedTypeVariables #
# LANGUAGE ViewPatterns         #

module Ouroboros.Consensus.Storage.ChainDB.Impl.Iterator (
    closeAllIterators
  , stream
  , IteratorEnv (..)
  , newIterator
  ) where

import           Control.Monad (unless, when)
import           Control.Monad.Except (ExceptT (..), catchError, lift,
                     runExceptT, throwError, withExceptT)
import           Control.Tracer
import           Data.Functor (($>))
import           Data.List.NonEmpty (NonEmpty)
import qualified Data.List.NonEmpty as NE
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (isJust)
import           Data.Typeable (Typeable)
import           GHC.Generics (Generic)
import           GHC.Stack (HasCallStack)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Util.IOLike
import           Ouroboros.Consensus.Util.ResourceRegistry (ResourceRegistry)

import           Ouroboros.Consensus.Storage.ChainDB.API (BlockComponent (..),
                     ChainDbError (..), Iterator (..), IteratorResult (..),
                     StreamFrom (..), StreamTo (..), UnknownRange (..),
                     getPoint, validBounds)

import           Ouroboros.Consensus.Storage.ChainDB.Impl.Paths (Path (..),
                     computePath)
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

  = Start & end point
  VolatileDB ( on our chain or on a recent fork ) . We first check whether it is
  in the VolatileDB , if not , we check if it is in the ImmutableDB ( see
  If a bound ca n't be found in the ChainDB , an ' UnknownRange ' error is
  > StreamFromExclusive ( Point      ( SlotNo 3 ) _ )
  > StreamToInclusive    ( RealPoint ( SlotNo 3 ) _ )
  An ' InvalidIteratorRange ' exception is thrown .
  To stream blocks from the VolatileDB we have to construct a path of points
  backwards through the VolatileDB , starting from the end point using
  block that is not in the VolatileDB . Then , for each point in the path , we
  can ask the VolatileDB for the corresponding block .
  If the path through the VolatileDB is incomplete , we will first have to
  VolatileDB . We only allow the tip of the ImmutableDB to be the switchover
  VolatileDB must fit onto the tip of the ImmutableDB . This must be true at
  paragraph ) . In that case , we return ' ForkTooOld ' .
  while , old blocks will be garbage - collected from the VolatileDB . Blocks
  This means that blocks that were part of the VolatileDB when the iterator
  was initialised might no longer be part of the VolatileDB when we come to
  VolatileDB without being copied to the ImmutableDB .
  or a block does n't match the expected point . In the latter two cases , we
  switch back to the VolatileDB . If the block is missing from the VolatileDB ,
  switch back to the VolatileDB . To avoid eternally switching between the two
  DBs , we only switch back to the VolatileDB if the stream from the
  ImmutableDB has made progress , i.e. streamed at least one block with the
  first one , we know for sure that that block is n't part of the VolatileDB
  The VolatileDB is hash - based instead of point - based . While the bounds of a
  stream are /point / s , we can simply check whether the hashes of the bounds
  must first read the block 's hash corresponding to the point 's slot from the
  are < = the tip of the ImmutableDB ): we must first read the hashes
  the range is valid . Note that these reads happen before the first call to
  memory after the first read so that the next lookup does n't have to read
  the case , only checking the first bound will require disk reads , the second
    VolatileDB , only the hash of the block corresponding to the lower bound
    the VolatileDB , which means that we know its hash already from the
  * Only streaming from the VolatileDB : 0 ( cached ) reads from disk upfront .
  * Only streaming from the ImmutableDB : 2 ( cached ) reads from disk upfront .
  * Streaming from both the ImmutableDB and the VolatileDB : 1 ( cached ) read
  the VolatileDB , we try to see whether it can be streamed from the ImmutableDB
  instead . Opening such an iterator costs 2 ( cached ) reads from disk upfront .
stream
  :: forall m blk b.
     ( IOLike m
     , HasHeader blk
     , HasCallStack
     )
  => ChainDbHandle m blk
  -> ResourceRegistry m
  -> BlockComponent blk b
  -> StreamFrom blk
  -> StreamTo blk
  -> m (Either (UnknownRange blk) (Iterator m blk b))
stream h registry blockComponent from to = getEnv h $ \cdb ->
    newIterator (fromChainDbEnv cdb) getItEnv registry blockComponent from to
  where
    getItEnv :: forall r. (IteratorEnv m blk -> m r) -> m r
    getItEnv f = getEnv h (f . fromChainDbEnv)


data IteratorEnv m blk = IteratorEnv {
      itImmutableDB     :: ImmutableDB m blk
    , itVolatileDB      :: VolatileDB m blk
    , itIterators       :: StrictTVar m (Map IteratorKey (m ()))
    , itNextIteratorKey :: StrictTVar m IteratorKey
    , itTracer          :: Tracer m (TraceIteratorEvent blk)
    }

  | Obtain an ' IteratorEnv ' from a ' ChainDbEnv ' .
fromChainDbEnv :: ChainDbEnv m blk -> IteratorEnv m blk
fromChainDbEnv CDB{..} = IteratorEnv {
      itImmutableDB     = cdbImmutableDB
    , itVolatileDB      = cdbVolatileDB
    , itIterators       = cdbIterators
    , itNextIteratorKey = cdbNextIteratorKey
    , itTracer          = contramap TraceIteratorEvent cdbTracer
    }

newIterator ::
     forall m blk b. (IOLike m, HasHeader blk, HasCallStack)
  => IteratorEnv m blk
  -> (forall r. (IteratorEnv m blk -> m r) -> m r)
  obtain their ' IteratorEnv ' . This function should check whether the
  that when we call ' iteratorNext ' , we first check whether the ChainDB
  -> ResourceRegistry m
  -> BlockComponent blk b
  -> StreamFrom blk
  -> StreamTo blk
  -> m (Either (UnknownRange blk) (Iterator m blk b))
newIterator itEnv@IteratorEnv{..} getItEnv registry blockComponent from to = do
    unless (validBounds from to) $
      throwIO $ InvalidIteratorRange from to
    res <- runExceptT start
    case res of
      Left e -> trace $ UnknownRangeRequested e
      _      -> return ()
    return res
  where
    trace = traceWith itTracer

    endPoint :: RealPoint blk
    endPoint = case to of
      StreamToInclusive pt -> pt

  in the ImmutableDB ( the range is < = the tip ) or first try the
  VolatileDB ( in the other cases ) .
    start :: HasCallStack
          => ExceptT (UnknownRange blk) m (Iterator m blk b)
    start = lift (atomically (ImmutableDB.getTip itImmutableDB)) >>= \case
      Origin -> findPathInVolatileDB
      NotOrigin ImmutableDB.Tip { tipSlotNo, tipHash, tipIsEBB } ->
        case realPointSlot endPoint `compare` tipSlotNo of
          LT -> streamFromImmutableDB

          EQ | realPointHash endPoint == tipHash
             -> streamFromImmutableDB

  each block and EBB has the same slot number , and a block or
  1 .  : .. :> EBB :> B
     desired outcome : ForkTooOld
  2 .  : .. :> EBB :> B
     desired outcome : ForkTooOld
  3 .  : .. :> EBB :> B
  4 .  : .. :> EBB
     desired outcome : find path in the VolatileDB
  5 .  : .. :> EBB
     desired outcome : ForkTooOld
  6 .  : .. :> EBB
     desired outcome : ForkTooOld
  ImmutableDB tip ends with a regular block ( 1 - 3 ) or an EBB
  ( 4 - 6 ) .

             -> streamFromImmutableDB `catchError`
  ' streamFromImmutableDB ' will return ' MissingBlock ' . Instead
  of returning that , we should return ' ForkTooOld ' , which is
                const (throwError $ ForkTooOld from)
             -> findPathInVolatileDB

          GT -> findPathInVolatileDB

  Greater or /equal/ , because of EBBs :(
    findPathInVolatileDB ::
         HasCallStack => ExceptT (UnknownRange blk) m (Iterator m blk b)
    findPathInVolatileDB = do
      path <- lift $ computePathVolatileDB itVolatileDB from to
      case path of
        NotInVolatileDB        _hash        -> throwError $ ForkTooOld from
        PartiallyInVolatileDB  predHash pts -> streamFromBoth predHash pts
        CompletelyInVolatileDB pts          -> case NE.nonEmpty pts of
          Just pts' -> lift $ streamFromVolatileDB pts'
          Nothing   -> lift $ emptyIterator

    streamFromVolatileDB :: NonEmpty (RealPoint blk) -> m (Iterator m blk b)
    streamFromVolatileDB pts = do
      trace $ StreamFromVolatileDB from to (NE.toList pts)
      createIterator $ InVolatileDB from pts

    streamFromImmutableDB :: ExceptT (UnknownRange blk) m (Iterator m blk b)
    streamFromImmutableDB = do
      lift $ trace $ StreamFromImmutableDB from to
      streamFromImmutableDBHelper to

    streamFromImmutableDBHelper ::
         StreamTo blk
      -> ExceptT (UnknownRange blk) m (Iterator m blk b)
    streamFromImmutableDBHelper to' = do
        immIt <-
          withExceptT missingBlockToUnknownRange $ ExceptT $
            ImmutableDB.stream
              itImmutableDB
              registry
              ((,) <$> getPoint <*> blockComponent)
              from
              to'
        lift $ createIterator $ InImmutableDB from immIt (StreamTo to')

  | If we have to stream from both the ImmutableDB and the VolatileDB , we
  risk of blocks going missing due to GC increases . So we refuse such a
    streamFromBoth ::
         HasCallStack
      => HeaderHash blk
      -> [RealPoint blk]
      -> ExceptT (UnknownRange blk) m (Iterator m blk b)
    streamFromBoth predHash pts = do
        lift $ trace $ StreamFromBoth from to pts
        lift (fmap ImmutableDB.tipToRealPoint <$>
               atomically (ImmutableDB.getTip itImmutableDB)) >>= \case
          Origin -> throwError $ ForkTooOld from
          NotOrigin pt@(RealPoint _ tipHash)
            | tipHash == predHash
            -> case NE.nonEmpty pts of
                 Just pts' -> startStream pt pts'
  in the VolatileDB , but the path of points in the
  VolatileDB is actually empty . It must be that the
  exclusive bound was in the VolatileDB and its
                 Nothing   -> streamFromImmutableDBHelper (StreamToInclusive pt)
  incomplete path through the VolatileDB , blocks might have
  moved from the VolatileDB to the ImmutableDB so that the tip
            | otherwise  -> case dropWhile (/= pt) pts of
              []              -> throwError $ ForkTooOld from
  VolatileDB to the ImmutableDB . We can shift the switchover
              _tipPt:pt':pts' -> startStream pt (pt' NE.:| pts')
              [_tipPt]        -> streamFromImmutableDBHelper (StreamToInclusive pt)
      where
        startStream ::
          -> NonEmpty (RealPoint blk)
          -> ExceptT (UnknownRange blk) m (Iterator m blk b)
        startStream immTip pts' = do
          let immEnd = SwitchToVolatileDBFrom (StreamToInclusive immTip) pts'
          immIt <- withExceptT missingBlockToUnknownRange $ ExceptT $
            ImmutableDB.stream
              itImmutableDB
              registry
              ((,) <$> getPoint <*> blockComponent)
              from
              (StreamToInclusive immTip)
          lift $ createIterator $ InImmutableDB from immIt immEnd

    makeIterator ::
      -> IteratorState m blk b
      -> m (Iterator m blk b)
    makeIterator register itState = do
      iteratorKey <- makeNewIteratorKey
      varItState  <- newTVarIO itState
      when register $ atomically $ modifyTVar itIterators $
  Note that we do n't use ' itEnv ' here , because that would mean that
        Map.insert iteratorKey (implIteratorClose varItState iteratorKey itEnv)
      return Iterator {
          iteratorNext  = getItEnv $
            implIteratorNext  registry varItState blockComponent
        , iteratorClose = getItEnv $
            implIteratorClose          varItState iteratorKey
        }

    emptyIterator :: m (Iterator m blk b)
    emptyIterator = makeIterator False Closed

    createIterator :: IteratorState m blk b -> m (Iterator m blk b)
    createIterator = makeIterator True

    makeNewIteratorKey :: m IteratorKey
    makeNewIteratorKey = atomically $ do
      newIteratorKey <- readTVar itNextIteratorKey
      modifyTVar itNextIteratorKey succ
      return newIteratorKey

  | Variant of ' computePath ' that computes a path through the VolatileDB .
  Throws an ' InvalidIteratorRange ' exception when the range is invalid ( i.e. ,
computePathVolatileDB ::
     (IOLike m, HasHeader blk)
  => VolatileDB m blk
  -> StreamFrom blk
  -> StreamTo   blk
  -> m (Path blk)
computePathVolatileDB volatileDB from to = do
    lookupBlockInfo <- atomically $ VolatileDB.getBlockInfo volatileDB
    case computePath lookupBlockInfo from to of
      Just path -> return path
      Nothing   -> throwIO $ InvalidIteratorRange from to

implIteratorClose ::
     IOLike m
  => StrictTVar m (IteratorState m blk b)
  -> IteratorKey
  -> IteratorEnv m blk
  -> m ()
implIteratorClose varItState itrKey IteratorEnv{..} = do
    mbImmIt <- atomically $ do
      modifyTVar itIterators (Map.delete itrKey)
      mbImmIt <- iteratorStateImmutableIt <$> readTVar varItState
      writeTVar varItState Closed
      return mbImmIt
    mapM_ ImmutableDB.iteratorClose mbImmIt

  ' InImmutableDBEnd ' is /not/ ' SwitchToVolatileDBFrom ' ): we will remain in this
  When streaming solely from the VolatileDB ( '  ' ): when
  VolatileDB and might have moved to the ImmutableDB : we switch to the
  VolatileDB ( ' InImmutableDB ' where ' InImmutableDBEnd ' is
  In the ' InImmutableDBRetry ' state , we distinguish two cases :
  1 . We have just switched to it because a block was missing from the
     VolatileDB . We have an iterator that could stream this block from the
      ( if it was indeed moved to the ImmutableDB ) . If the streamed
  2 . We have successfully streamed one or more blocks from the ImmutableDB
     that were previously part of the VolatileDB . When we now encounter a
data IteratorState m blk b
  = InImmutableDB
      !(StreamFrom blk)
      !(ImmutableDB.Iterator m blk (Point blk, b))
      !(InImmutableDBEnd blk)
  Invariant : an ImmutableDB iterator opened using the ' StreamFrom '
  stored as parameter . There is one difference , which is exactly the
  reason for keeping track of this ' StreamFrom ' : if the latter iterator
  | InVolatileDB
      !(StreamFrom blk)
      !(NonEmpty (RealPoint blk))
  ^ Streaming from the VolatileDB .
  VolatileDB .
  ImmutableDB by starting an iterator using the ' StreamFrom ' parameter .
  | InImmutableDBRetry
      !(StreamFrom blk)
      !(ImmutableDB.Iterator m blk (Point blk, b))
      !(NonEmpty (RealPoint blk))
  ^ When streaming blocks ( a list of points ) from the VolatileDB , we
  noticed a block was missing from the VolatileDB . It may have moved to

  | Closed
  deriving (Generic)

instance (Typeable blk, StandardHash blk)
      => NoThunks (IteratorState m blk b)

  | Extract the ImmutableDB Iterator from the ' IteratorState ' .
iteratorStateImmutableIt ::
     IteratorState m blk b
  -> Maybe (ImmutableDB.Iterator m blk (Point blk, b))
iteratorStateImmutableIt = \case
    Closed                       -> Nothing
    InImmutableDB      _ immIt _ -> Just immIt
    InImmutableDBRetry _ immIt _ -> Just immIt
    InVolatileDB {}              -> Nothing

data InImmutableDBEnd blk =
    StreamAll
  | StreamTo               !(StreamTo blk)
  | SwitchToVolatileDBFrom !(StreamTo blk) !(NonEmpty (RealPoint blk))
  second parameter ) from the VolatileDB .
  deriving (Generic, NoThunks)

implIteratorNext ::
    forall m blk b. (IOLike m, HasHeader blk)
  => ResourceRegistry m
  -> StrictTVar m (IteratorState m blk b)
  -> BlockComponent blk b
  -> IteratorEnv m blk
  -> m (IteratorResult blk b)
implIteratorNext registry varItState blockComponent IteratorEnv{..} =
    atomically (readTVar varItState) >>= \case
      Closed ->
        return IteratorExhausted
      InImmutableDB continueAfter immIt immEnd ->
        nextInImmutableDB continueAfter immIt immEnd
      InImmutableDBRetry continueAfter immIt immPts ->
        nextInImmutableDBRetry (Just continueAfter) immIt immPts
      InVolatileDB continueAfter volPts ->
        nextInVolatileDB continueAfter volPts
  where
    trace = traceWith itTracer

    nextInVolatileDB ::
         StreamFrom blk
  ^ In case the block corresponding to the first point in
  the path is missing from the VolatileDB , we can use this
      -> NonEmpty (RealPoint blk)
      -> m (IteratorResult blk b)
    nextInVolatileDB continueFrom (pt@(realPointHash -> hash) NE.:| pts) =
      VolatileDB.getBlockComponent itVolatileDB blockComponent hash >>= \case
        Nothing -> do
            trace $ BlockMissingFromVolatileDB pt
  previously in the VolatileDB . This will only work if the block
            (fmap ImmutableDB.tipToRealPoint <$>
              atomically (ImmutableDB.getTip itImmutableDB)) >>= \case
              Origin ->
  The block was in the VolatileDB , but is n't anymore . This can
  only happen due to GC . It 's not guaranteed that GC will have
  moved /that/ block to the  ( so it might have just
  disappeared altogether ) , /but/ after GC the ImmutableDB
  can not be empty ( because GC will only be triggered after some
                error "nextInVolatileDB: impossible"
              NotOrigin tip -> do
                errOrIt <- ImmutableDB.stream
                  itImmutableDB
                  registry
                  ((,) <$> getPoint <*> blockComponent)
                  continueFrom
                  (StreamToInclusive tip)
                case errOrIt of
                  Left  _ -> do
                    trace $ BlockGCedFromVolatileDB pt
                    return $ IteratorBlockGCed pt
                  Right immIt ->
                    nextInImmutableDBRetry Nothing immIt (pt NE.:| pts)

        Just b | Just pts' <- NE.nonEmpty pts -> do
          let continueFrom' = StreamFromExclusive (realPointToPoint pt)
          atomically $ writeTVar varItState (InVolatileDB continueFrom' pts')
          return $ IteratorResult b
        Just b -> do
          atomically $ writeTVar varItState Closed
          return $ IteratorResult b

    nextInImmutableDB ::
         StreamFrom blk
      -> ImmutableDB.Iterator m blk (Point blk, b)
      -> InImmutableDBEnd blk
      -> m (IteratorResult blk b)
    nextInImmutableDB continueFrom immIt immEnd =
      selectResult immIt >>= \case
        NotDone (pt, b) -> do
          let continueFrom' = StreamFromExclusive pt
          atomically $ writeTVar varItState (InImmutableDB continueFrom' immIt immEnd)
          return $ IteratorResult b
        DoneAfter (pt, b) | SwitchToVolatileDBFrom _ pts <- immEnd -> do
          let continueFrom' = StreamFromExclusive pt
          atomically $ writeTVar varItState (InVolatileDB continueFrom' pts)
          return $ IteratorResult b
        DoneAfter (_pt, b) -> do
          atomically $ writeTVar varItState Closed
          return $ IteratorResult b
        Done | SwitchToVolatileDBFrom _ pts <- immEnd ->
          nextInVolatileDB continueFrom pts
        Done -> do
  No need to switch to the VolatileDB , so we can stop
          atomically $ writeTVar varItState Closed
          return IteratorExhausted

  because they are no longer in the VolatileDB . We do n't know this for
    nextInImmutableDBRetry ::
         Maybe (StreamFrom blk)
  to the VolatileDB if we came from there .
       -> ImmutableDB.Iterator m blk (Point blk, b)
       -> NonEmpty (RealPoint blk)
       -> m (IteratorResult blk b)
    nextInImmutableDBRetry mbContinueFrom immIt (expectedPt NE.:| pts) =
      selectResult immIt >>= \case
        NotDone (actualPt, b) | actualPt == realPointToPoint expectedPt -> do
          trace $ BlockWasCopiedToImmutableDB expectedPt
          let continueFrom' = StreamFromExclusive (realPointToPoint expectedPt)
          case NE.nonEmpty pts of
            Nothing      -> do
              atomically $ writeTVar varItState Closed
              ImmutableDB.iteratorClose immIt
            Just pts' ->
              atomically $ writeTVar varItState $
                InImmutableDBRetry continueFrom' immIt pts'
          return $ IteratorResult b

        DoneAfter (actualPt, b) | actualPt == realPointToPoint expectedPt -> do
          trace $ BlockWasCopiedToImmutableDB expectedPt
          let continueFrom' = StreamFromExclusive (realPointToPoint expectedPt)
          case NE.nonEmpty pts of
            Nothing      -> atomically $ writeTVar varItState Closed
            Just pts' -> do
              atomically $ writeTVar varItState $ InVolatileDB continueFrom' pts'
              trace SwitchBackToVolatileDB
          return $ IteratorResult b

  Point mismatch or ' Done ' . Close the ImmutableDB Iterator ( idempotent ) .
        _ -> ImmutableDB.iteratorClose immIt *> case mbContinueFrom of
  was missing from the VolatileDB and now it is not in the
          Nothing -> do
            atomically $ writeTVar varItState Closed
            trace $ BlockGCedFromVolatileDB expectedPt
            return $ IteratorBlockGCed expectedPt

  looking in the VolatileDB again . If we had n't streamed something
  yet , switching to the VolatileDB would be pointless as we just
          Just continueFrom -> do
            trace SwitchBackToVolatileDB
            nextInVolatileDB continueFrom (expectedPt NE.:| pts)

    selectResult ::
         ImmutableDB.Iterator m blk (Point blk, b)
      -> m (Done (Point blk, b))
    selectResult immIt = do
        itRes   <-                        ImmutableDB.iteratorNext    immIt
        hasNext <- isJust <$> atomically (ImmutableDB.iteratorHasNext immIt)
        case itRes of
          ImmutableDB.IteratorResult blk -> select blk hasNext
          ImmutableDB.IteratorExhausted  -> return Done
      where
        select blk hasNext
          | hasNext
          = return $ NotDone blk
          | otherwise
          = ImmutableDB.iteratorClose immIt $> DoneAfter blk

data Done blk =
    Done
  | DoneAfter blk
  | NotDone     blk

missingBlockToUnknownRange ::
     ImmutableDB.MissingBlock blk
  -> UnknownRange blk
missingBlockToUnknownRange = MissingBlock . ImmutableDB.missingBlockPoint

  | Close all open ' Iterator 's .
  This  be called when the ChainDB is already closed .
closeAllIterators :: IOLike m => ChainDbEnv m blk -> m ()
closeAllIterators CDB{..} = do
    iteratorClosers <- atomically $ Map.elems <$> readTVar cdbIterators
    sequence_ iteratorClosers
