{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

module Ouroboros.Consensus.Storage.ChainDB.API
  ( -- * Main ChainDB API
    ChainDB (..)
  , getCurrentTip
  , getTipBlockNo

    -- * Adding a block
  , AddBlockPromise (..)
  , AddBlockResult (..)
  , addBlock
  , addBlockWaitWrittenToDisk
  , addBlock_

    -- * Trigger chain selection
  , ChainSelectionPromise (..)
  , triggerChainSelection
  , triggerChainSelectionAsync

    -- * Serialised block/header with its point
  , WithPoint (..)
  , getPoint
  , getSerialisedBlockWithPoint
  , getSerialisedHeaderWithPoint

    -- * BlockComponent
  , BlockComponent (..)

    -- * Support for tests
  , fromChain
  , toChain

    -- * Iterator API
  , Iterator (..)
  , IteratorResult (..)
  , StreamFrom (..)
  , StreamTo (..)
  , UnknownRange (..)
  , emptyIterator
  , streamAll
  , streamFrom
  , traverseIterator
  , validBounds

    -- * Followers
  , ChainType (..)
  , Follower (..)
  , traverseFollower

    -- * Recovery
  , ChainDbFailure (..)
  , IsEBB (..)

    -- * Exceptions
  , ChainDbError (..)

    -- * Genesis
  , GetLoEFragment
  , LoE (..)
  ) where

import Control.Monad (void)
import Control.ResourceRegistry
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderStateHistory
  ( HeaderStateHistory (..)
  )
import Ouroboros.Consensus.HeaderValidation (HeaderWithTime (..))
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Extended
import Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
import Ouroboros.Consensus.Storage.Common
import Ouroboros.Consensus.Storage.LedgerDB
  ( GetForkerError
  , ReadOnlyForker'
  , Statistics
  )
import Ouroboros.Consensus.Storage.Serialisation
import Ouroboros.Consensus.Util.CallStack
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Consensus.Util.STM (WithFingerprint)
import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
import qualified Ouroboros.Network.AnchoredFragment as AF
import Ouroboros.Network.Block
  ( ChainUpdate
  , MaxSlotNo
  , Serialised (..)
  )
import qualified Ouroboros.Network.Block as Network
import Ouroboros.Network.BlockFetch.ConsensusInterface
  ( ChainSelStarvation (..)
  )
import Ouroboros.Network.Mock.Chain (Chain (..))
import qualified Ouroboros.Network.Mock.Chain as Chain
import Ouroboros.Network.Protocol.LocalStateQuery.Type
import System.FS.API.Types (FsError)

-- | The chain database
--
-- The chain database provides a unified interface on top of:
--
-- * The ImmutableDB, storing the part of the chain that can't roll back.
-- * The VolatileDB, storing the blocks near the tip of the chain, possibly in
--   multiple competing forks.
-- * The LedgerDB, storing snapshots of the ledger state for blocks in the
--   ImmutableDB (and in-memory snapshots for the rest).
--
-- In addition to providing a unifying interface on top of these disparate
-- components, the main responsibilities that the ChainDB itself has are:
--
-- * Chain selection (on initialization and whenever a block is added)
-- * Trigger full recovery whenever we detect disk failure in any component
-- * Provide iterators across fixed fragments of the current chain
-- * Provide followers that track the status of the current chain
--
-- The ChainDB instantiates all the various type parameters of these databases
-- to conform to the unified interface we provide here.
data ChainDB m blk = ChainDB
  { forall (m :: * -> *) blk.
ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
addBlockAsync :: InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
  -- ^ Add a block to the heap of blocks
  --
  -- We do /not/ assume that the block is valid (under the legder rules);
  -- it is the responsibility of the Chain DB itself to only select chains
  -- that are valid.
  --
  -- Conversely, the caller cannot assume that the new block will be added
  -- to the current chain; even if the block is valid, it will not become
  -- part of the chain if there are other chains available that are
  -- preferred by the consensus algorithm (typically, longer chains).
  --
  -- This function typically returns immediately, yielding a
  -- 'AddBlockPromise' which can be used to wait for the result. You can
  -- use 'addBlock' to add the block synchronously.
  --
  -- NOTE: back pressure can be applied when overloaded.
  --
  -- PRECONDITON: the block to be added must not be from the future.
  --
  -- The current code ensures that the two sources of blocks
  -- ('ChainSync' and forging) do not allow blocks from the future,
  -- however this is not guaranteed when during initialization if the
  -- VolatileDB contains blocks from the future. See:
  -- https://github.com/IntersectMBO/ouroboros-consensus/blob/main/docs/website/contents/for-developers/HandlingBlocksFromTheFuture.md#handling-blocks-from-the-future
  , forall (m :: * -> *) blk.
ChainDB m blk -> m (ChainSelectionPromise m)
chainSelAsync :: m (ChainSelectionPromise m)
  -- ^ Trigger reprocessing of blocks postponed by the LoE.
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
getCurrentChain :: STM m (AnchoredFragment (Header blk))
  -- ^ Get the current chain fragment
  --
  -- Suppose the current chain is
  --
  -- > a -> b -> c -> d -> e -> f
  --
  -- and suppose @k = 2@; this means that the most distant fork we can
  -- switch to is something like
  --
  -- > a -> b -> c -> d -> e' -> f'
  --
  -- The fragment we return will be @[e, f]@, anchored at @d@. In other
  -- words, the length of the fragment will under normal circumstances
  -- be exactly @k@ blocks long. It may be shorter if
  --
  -- * We are near genesis
  --   The anchor will be the genesis point
  --   (which does not correspond to an actual block)
  --
  -- * The volatile DB suffered some data loss
  --   Typically (but not necessarily) the volatile DB will not be empty
  --   and the anchor will be pointing to the tip of the immutable DB.
  --
  -- POSTCONDITION: The Chain DB will be able to switch to any fork starting
  -- from the anchor of the returned fragment or any subsequent block
  -- (provided the new fork is at least of the same length as the old).
  --
  -- NOTE: A direct consequence of this guarantee is that the anchor of the
  -- fragment will move as the chain grows.
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (HeaderWithTime blk))
getCurrentChainWithTime ::
      STM m (AnchoredFragment (HeaderWithTime blk))
  -- ^ Exact same as 'getCurrentChain', except each header is annotated
  -- with the 'RelativeTime' of the onset of its slot (translated according
  -- to the chain it is on)
  --
  -- INVARIANT @'hwtHeader' <$> 'getCurrentChainWithTime' = 'getCurrentChain'@
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (ExtLedgerState blk EmptyMK)
getCurrentLedger :: STM m (ExtLedgerState blk EmptyMK)
  -- ^ Get current ledger
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (ExtLedgerState blk EmptyMK)
getImmutableLedger :: STM m (ExtLedgerState blk EmptyMK)
  -- ^ Get the immutable ledger, i.e., typically @k@ blocks back.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> Point blk -> STM m (Maybe (ExtLedgerState blk EmptyMK))
getPastLedger :: Point blk -> STM m (Maybe (ExtLedgerState blk EmptyMK))
  -- ^ Get the ledger for the given point.
  --
  -- When the given point is not among the last @k@ blocks of the current
  -- chain (i.e., older than @k@ or not on the current chain), 'Nothing' is
  -- returned.
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (HeaderStateHistory blk)
getHeaderStateHistory :: STM m (HeaderStateHistory blk)
  -- ^ Get a 'HeaderStateHistory' populated with the 'HeaderState's of the
  -- last @k@ blocks of the current chain.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> ResourceRegistry m
-> Target (Point blk)
-> m (Either GetForkerError (ReadOnlyForker' m blk))
getReadOnlyForkerAtPoint ::
      ResourceRegistry m ->
      Target (Point blk) ->
      m (Either GetForkerError (ReadOnlyForker' m blk))
  -- ^ Acquire a read-only forker at a specific point if that point exists
  -- on the db.
  --
  -- Note that the forker should be closed by the caller of this function.
  --
  -- The forker is read-only becase a read-write forker could be used to
  -- change the internal state of the LedgerDB.
  , forall (m :: * -> *) blk. ChainDB m blk -> m (Maybe blk)
getTipBlock :: m (Maybe blk)
  -- ^ Get block at the tip of the chain, if one exists
  --
  -- Returns 'Nothing' if the database is empty.
  , forall (m :: * -> *) blk. ChainDB m blk -> m (Maybe (Header blk))
getTipHeader :: m (Maybe (Header blk))
  -- ^ Get header at the tip of the chain
  --
  -- NOTE: Calling 'getTipHeader' is cheaper than 'getTipBlock' and then
  -- extracting the header: most of the time the header at the tip is
  -- actually in memory, whereas the block never is.
  --
  -- Returns 'Nothing' if the database is empty.
  , forall (m :: * -> *) blk. ChainDB m blk -> STM m (Point blk)
getTipPoint :: STM m (Point blk)
  -- ^ Get point of the tip of the chain
  --
  -- Will return 'genesisPoint' if the database is empty; if the
  -- current chain fragment is empty due to data loss in the volatile DB,
  -- 'getTipPoint' will return the tip of the immutable DB.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> forall b. BlockComponent blk b -> RealPoint blk -> m (Maybe b)
getBlockComponent ::
      forall b.
      BlockComponent blk b ->
      RealPoint blk ->
      m (Maybe b)
  -- ^ Get the given component(s) of the block at the specified point. If
  -- there is no block at the given point, 'Nothing' is returned.
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (Point blk -> Bool)
getIsFetched :: STM m (Point blk -> Bool)
  -- ^ Return membership check function for recent blocks. This includes
  -- blocks in the VolatileDB and blocks that are currently being processed
  -- or are waiting in a queue to be processed.
  --
  -- This check is only reliable for blocks up to @k@ away from the tip.
  -- For blocks older than that the results should be regarded as
  -- non-deterministic.
  , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (RealPoint blk -> Maybe Bool)
getIsValid :: STM m (RealPoint blk -> Maybe Bool)
  -- ^ Return a function that tells whether a block is known to be valid
  -- or invalid.
  --
  -- The function will return:
  --
  -- * @Just True@: for blocks in the volatile DB that have been validated
  --   and were found to be valid. All blocks in the current chain
  --   fragment (i.e., 'getCurrentChain') are valid.
  --
  -- * @Just False@: for blocks in the volatile DB that have been
  --   validated and were found to be invalid.
  --
  -- * @Nothing@: for blocks not or no longer in the volatile DB, whether
  --   they are valid or not, including blocks in the immutable DB. Also
  --   for blocks in the volatile DB that haven't been validated (yet),
  --   e.g., because they are disconnected from the current chain or they
  --   are part of a shorter fork.
  , forall (m :: * -> *) blk. ChainDB m blk -> STM m MaxSlotNo
getMaxSlotNo :: STM m MaxSlotNo
  -- ^ Get the highest slot number stored in the ChainDB (this includes
  -- blocks that are waiting in the background queue to be processed).
  --
  -- Note that the corresponding block doesn't have to be part of the
  -- current chain, it could be part of some fork, or even be a
  -- disconnected block.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> BlockComponent blk b
   -> StreamFrom blk
   -> StreamTo blk
   -> m (Either (UnknownRange blk) (Iterator m blk b))
stream ::
      forall b.
      ResourceRegistry m ->
      BlockComponent blk b ->
      StreamFrom blk ->
      StreamTo blk ->
      m (Either (UnknownRange blk) (Iterator m blk b))
  -- ^ Stream blocks
  --
  -- Streaming is not restricted to the current fork, but there must be an
  -- unbroken path from the starting point to the end point /at the time
  -- of initialization/ of the iterator. Once the iterator has been
  -- initialized, it will not be affected by subsequent calls to
  -- 'addBlock'. To track the current chain, use a 'Follower' instead.
  --
  -- Streaming blocks older than @k@ is permitted, but only when they are
  -- part of the current fork (at the time of initialization). Streaming a
  -- fork that forks off more than @k@ blocks in the past is not permitted
  -- and an 'UnknownRange' error will be returned in that case.
  --
  -- The iterator /does/ have a limited lifetime, however. The chain DB
  -- internally partitions the chain into an " immutable " part and a
  -- " volatile " part, moving blocks from the volatile DB to the immutable
  -- DB when they become more than @k@ deep into the chain. When a block
  -- with slot number @n@ is added to the immutble DB, a time delay @t@
  -- kicks in; after that time delay expires, all blocks older than @n@ may
  -- be removed from the volatile DB, /including any blocks that happen to
  -- live on other forks/ (since those forks must now, by definition, be too
  -- distant). This time delay @t@ also provides a worst-case bound for the
  -- lifetime of the iterator: if the iterator traverses a chain that
  -- forks off from our current chain at the tip of the immutable DB,
  -- then the first block on that fork will become unavailable as soon as
  -- another block is pushed to the current chain and the subsequent
  -- time delay expires.
  --
  -- Note: although blocks are moved from the volatile DB to the immutable
  -- DB after they have become @k@ deep into the chain, due to data
  -- corruption the suffix of the chain in the volatile DB might be
  -- shorter than @k@. The immutable DB /always/ determines the maximum
  -- rollback, which may therefore be shorter than @k@ under such
  -- circumstances. In addition, streaming blocks which aren't on the
  -- current fork is permitted, but the oldest volatile block must fit on
  -- to the tip of the immutable DB.
  --
  -- When the given bounds are nonsensical, an 'InvalidIteratorRange' is
  -- thrown.
  --
  -- When the given bounds are not part of the chain DB, an 'UnknownRange'
  -- error is returned.
  --
  -- To stream all blocks from the current chain, use 'streamAll', as it
  -- correctly handles an empty ChainDB.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> ChainType -> BlockComponent blk b -> m (Follower m blk b)
newFollower ::
      forall b.
      ResourceRegistry m ->
      ChainType ->
      BlockComponent blk b ->
      m (Follower m blk b)
  -- ^ Chain follower
  --
  -- A chain follower is an iterator that tracks the state of the /current/
  -- chain: calling @next@ on the iterator will either give you the next
  -- block header, or (if we have switched to a fork) the instruction to
  -- rollback.
  --
  -- The tracking iterator starts at genesis (see also 'trackForward').
  --
  -- This is intended for use by chain consumers to /reliably/ follow a
  -- chain, desipite the chain being volatile.
  --
  -- Examples of users:
  -- * The server side of the chain sync mini-protocol for the
  --   node-to-node protocol using headers and the block size.
  -- * The server side of the chain sync mini-protocol for the
  --   node-to-client protocol using blocks.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> STM
     m
     (WithFingerprint
        (HeaderHash blk -> Maybe (ExtValidationError blk)))
getIsInvalidBlock :: STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))
  -- ^ Function to check whether a block is known to be invalid.
  --
  -- Blocks unknown to the ChainDB will result in 'Nothing'.
  --
  -- If the hash corresponds to a block that is known to be invalid, but
  -- is now older than @k@, this function may return 'Nothing'.
  --
  -- Whenever a new invalid block is added, the 'Fingerprint' will be
  -- changed. This is useful when \"watching\" this function in a
  -- transaction.
  --
  -- Note that when invalid blocks are garbage collected and thus no
  -- longer detected by this function, the 'Fingerprint' doesn't have to
  -- change, since the function will not detect new invalid blocks.
  --
  -- It might seem natural to have this function also return whether the
  -- ChainDB knows that a block is valid, thereby subsuming the 'getIsValid'
  -- function and simplifying the API. However, this adds the overhead of
  -- checking whether the block is valid for blocks that are not known to be
  -- invalid that does not give useful information to current clients
  -- (ChainSync), since they are only interested in whether a block is known
  -- to be invalid. The extra information of whether a block is valid is
  -- only used for testing.
  --
  -- In particular, this affects the watcher in 'bracketChainSyncClient',
  -- which rechecks the blocks in all candidate chains whenever a new
  -- invalid block is detected. These blocks are likely to be valid.
  , forall (m :: * -> *) blk. ChainDB m blk -> STM m ChainSelStarvation
getChainSelStarvation :: STM m ChainSelStarvation
  -- ^ Whether ChainSel is currently starved, or when was last time it
  -- stopped being starved.
  , forall (m :: * -> *) blk.
ChainDB m blk
-> Point blk
-> LedgerTables (ExtLedgerState blk) KeysMK
-> m (Maybe (LedgerTables (ExtLedgerState blk) ValuesMK))
getLedgerTablesAtFor ::
      Point blk ->
      LedgerTables (ExtLedgerState blk) KeysMK ->
      m (Maybe (LedgerTables (ExtLedgerState blk) ValuesMK))
  -- ^ Read ledger tables at a given point on the chain, if it exists.
  --
  -- This is intended to be used by the mempool to hydrate a ledger state at
  -- a specific point.
  , forall (m :: * -> *) blk. ChainDB m blk -> m (Maybe Statistics)
getStatistics :: m (Maybe Statistics)
  -- ^ Get statistics from the LedgerDB, in particular the number of entries
  -- in the tables.
  , forall (m :: * -> *) blk. ChainDB m blk -> m ()
closeDB :: m ()
  -- ^ Close the ChainDB
  --
  -- Idempotent.
  --
  -- Should only be called on shutdown.
  , forall (m :: * -> *) blk. ChainDB m blk -> STM m Bool
isOpen :: STM m Bool
  -- ^ Return 'True' when the database is open.
  --
  -- 'False' when the database is closed.
  }

getCurrentTip ::
  (Monad (STM m), HasHeader (Header blk)) =>
  ChainDB m blk -> STM m (Network.Tip blk)
getCurrentTip :: forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (Tip blk)
getCurrentTip = (AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
 -> Tip blk)
-> STM
     m
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
-> STM m (Tip blk)
forall a b. (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Anchor (Header blk) -> Tip blk
forall a b. (HeaderHash a ~ HeaderHash b) => Anchor a -> Tip b
AF.anchorToTip (Anchor (Header blk) -> Tip blk)
-> (AnchoredSeq
      (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
    -> Anchor (Header blk))
-> AnchoredSeq
     (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> Tip blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnchoredSeq (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)
-> Anchor (Header blk)
forall v a b. Anchorable v a b => AnchoredSeq v a b -> a
AF.headAnchor) (STM
   m
   (AnchoredSeq
      (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
 -> STM m (Tip blk))
-> (ChainDB m blk
    -> STM
         m
         (AnchoredSeq
            (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk)))
-> ChainDB m blk
-> STM m (Tip blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDB m blk
-> STM
     m
     (AnchoredSeq
        (WithOrigin SlotNo) (Anchor (Header blk)) (Header blk))
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (AnchoredFragment (Header blk))
getCurrentChain

getTipBlockNo ::
  (Monad (STM m), HasHeader (Header blk)) =>
  ChainDB m blk -> STM m (WithOrigin BlockNo)
getTipBlockNo :: forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (WithOrigin BlockNo)
getTipBlockNo = (Tip blk -> WithOrigin BlockNo)
-> STM m (Tip blk) -> STM m (WithOrigin BlockNo)
forall a b. (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tip blk -> WithOrigin BlockNo
forall {k} (b :: k). Tip b -> WithOrigin BlockNo
Network.getTipBlockNo (STM m (Tip blk) -> STM m (WithOrigin BlockNo))
-> (ChainDB m blk -> STM m (Tip blk))
-> ChainDB m blk
-> STM m (WithOrigin BlockNo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDB m blk -> STM m (Tip blk)
forall (m :: * -> *) blk.
(Monad (STM m), HasHeader (Header blk)) =>
ChainDB m blk -> STM m (Tip blk)
getCurrentTip

{-------------------------------------------------------------------------------
  Adding a block
-------------------------------------------------------------------------------}

data AddBlockPromise m blk = AddBlockPromise
  { forall (m :: * -> *) blk. AddBlockPromise m blk -> STM m Bool
blockWrittenToDisk :: STM m Bool
  -- ^ Use this 'STM' transaction to wait until the block has been written
  -- to disk.
  --
  -- Returns 'True' when the block was written to disk or 'False' when it
  -- was ignored, e.g., because it was older than @k@.
  --
  -- If the 'STM' transaction has returned 'True' then 'getIsFetched' will
  -- return 'True' for the added block.
  --
  -- NOTE: Even when the result is 'False', 'getIsFetched' might still
  -- return 'True', e.g., the block was older than @k@, but it has been
  -- downloaded and stored on disk before.
  , forall (m :: * -> *) blk.
AddBlockPromise m blk -> STM m (AddBlockResult blk)
blockProcessed :: STM m (AddBlockResult blk)
  -- ^ Use this 'STM' transaction to wait until the block has been
  -- processed: the block has been written to disk and chain selection has
  -- been performed for the block, /unless/ the block is from the future.
  --
  -- The ChainDB's tip after chain selection is returned. When this tip
  -- doesn't match the added block, it doesn't necessarily mean the block
  -- wasn't adopted. We might have adopted a longer chain of which the
  -- added block is a part, but not the tip.
  --
  -- It returns 'FailedToAddBlock' if the thread adding the block died.
  --
  -- NOTE: When the block is from the future, chain selection for the
  -- block won't be performed until the block is no longer in the future,
  -- which might take some time. For that reason, this transaction will
  -- not wait for chain selection of a block from the future. It will
  -- return the current tip of the ChainDB after writing the block to
  -- disk.
  }

-- | This is a wrapper type for 'blockProcessed' function above.
--
-- As it is mentioned the 'SuccessfullyAddedBlock' constructor will containt
-- the ChainDB's tip after chain selection is returned.
--
-- The 'FailedToAddBlock' case will be returned if the thread adding the block
-- died.
data AddBlockResult blk
  = SuccesfullyAddedBlock (Point blk)
  | FailedToAddBlock String
  deriving (AddBlockResult blk -> AddBlockResult blk -> Bool
(AddBlockResult blk -> AddBlockResult blk -> Bool)
-> (AddBlockResult blk -> AddBlockResult blk -> Bool)
-> Eq (AddBlockResult blk)
forall blk.
StandardHash blk =>
AddBlockResult blk -> AddBlockResult blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk.
StandardHash blk =>
AddBlockResult blk -> AddBlockResult blk -> Bool
== :: AddBlockResult blk -> AddBlockResult blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
AddBlockResult blk -> AddBlockResult blk -> Bool
/= :: AddBlockResult blk -> AddBlockResult blk -> Bool
Eq, Int -> AddBlockResult blk -> ShowS
[AddBlockResult blk] -> ShowS
AddBlockResult blk -> String
(Int -> AddBlockResult blk -> ShowS)
-> (AddBlockResult blk -> String)
-> ([AddBlockResult blk] -> ShowS)
-> Show (AddBlockResult blk)
forall blk. StandardHash blk => Int -> AddBlockResult blk -> ShowS
forall blk. StandardHash blk => [AddBlockResult blk] -> ShowS
forall blk. StandardHash blk => AddBlockResult blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. StandardHash blk => Int -> AddBlockResult blk -> ShowS
showsPrec :: Int -> AddBlockResult blk -> ShowS
$cshow :: forall blk. StandardHash blk => AddBlockResult blk -> String
show :: AddBlockResult blk -> String
$cshowList :: forall blk. StandardHash blk => [AddBlockResult blk] -> ShowS
showList :: [AddBlockResult blk] -> ShowS
Show)

-- | Add a block synchronously: wait until the block has been written to disk
-- (see 'blockWrittenToDisk').
addBlockWaitWrittenToDisk :: IOLike m => ChainDB m blk -> InvalidBlockPunishment m -> blk -> m Bool
addBlockWaitWrittenToDisk :: forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk -> InvalidBlockPunishment m -> blk -> m Bool
addBlockWaitWrittenToDisk ChainDB m blk
chainDB InvalidBlockPunishment m
punish blk
blk = do
  promise <- ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
forall (m :: * -> *) blk.
ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
addBlockAsync ChainDB m blk
chainDB InvalidBlockPunishment m
punish blk
blk
  atomically $ blockWrittenToDisk promise

-- | Add a block synchronously: wait until the block has been processed (see
-- 'blockProcessed'). The new tip of the ChainDB is returned unless the thread adding the
-- block died, in that case 'FailedToAddBlock' will be returned.
--
-- Note: this is a partial function, only to support tests.
--
-- PRECONDITION: the block to be added must not be from the future. See 'addBlockAsync'.
addBlock :: IOLike m => ChainDB m blk -> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
addBlock :: forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
addBlock ChainDB m blk
chainDB InvalidBlockPunishment m
punish blk
blk = do
  promise <- ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
forall (m :: * -> *) blk.
ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
addBlockAsync ChainDB m blk
chainDB InvalidBlockPunishment m
punish blk
blk
  atomically $ blockProcessed promise

-- | Add a block synchronously. Variant of 'addBlock' that doesn't return the
-- new tip of the ChainDB.
--
-- Note: this is a partial function, only to support tests.
addBlock_ :: IOLike m => ChainDB m blk -> InvalidBlockPunishment m -> blk -> m ()
addBlock_ :: forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk -> InvalidBlockPunishment m -> blk -> m ()
addBlock_ = m (AddBlockResult blk) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (AddBlockResult blk) -> m ())
-> (ChainDB m blk
    -> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk))
-> ChainDB m blk
-> InvalidBlockPunishment m
-> blk
-> m ()
forall y z x0 x1 x2.
(y -> z) -> (x0 -> x1 -> x2 -> y) -> x0 -> x1 -> x2 -> z
..: ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk
-> InvalidBlockPunishment m -> blk -> m (AddBlockResult blk)
addBlock

-- | Alias for naming consistency.
-- The short name was chosen to avoid a larger diff from alignment changes.
triggerChainSelectionAsync :: ChainDB m blk -> m (ChainSelectionPromise m)
triggerChainSelectionAsync :: forall (m :: * -> *) blk.
ChainDB m blk -> m (ChainSelectionPromise m)
triggerChainSelectionAsync = ChainDB m blk -> m (ChainSelectionPromise m)
forall (m :: * -> *) blk.
ChainDB m blk -> m (ChainSelectionPromise m)
chainSelAsync

-- | A promise that the chain selection will be performed. It is returned by
-- 'triggerChainSelectionAsync' and contains a monadic action that waits until
-- the corresponding run of Chain Selection is done.
newtype ChainSelectionPromise m = ChainSelectionPromise
  { -- NOTE: We might want a mechanism similar to 'AddBlockPromise' and
    -- 'AddBlockResult', in case the background ChainDB thread dies; but we
    -- currently only use the synchronous variant in tests.
    forall (m :: * -> *). ChainSelectionPromise m -> m ()
waitChainSelectionPromise :: m ()
  }

-- | Trigger selection synchronously: wait until the chain selection has been
-- performed. This is a partial function, only to support tests.
triggerChainSelection :: IOLike m => ChainDB m blk -> m ()
triggerChainSelection :: forall (m :: * -> *) blk. IOLike m => ChainDB m blk -> m ()
triggerChainSelection ChainDB m blk
chainDB =
  ChainSelectionPromise m -> m ()
forall (m :: * -> *). ChainSelectionPromise m -> m ()
waitChainSelectionPromise (ChainSelectionPromise m -> m ())
-> m (ChainSelectionPromise m) -> m ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ChainDB m blk -> m (ChainSelectionPromise m)
forall (m :: * -> *) blk.
ChainDB m blk -> m (ChainSelectionPromise m)
chainSelAsync ChainDB m blk
chainDB

{-------------------------------------------------------------------------------
  Serialised block/header with its point
-------------------------------------------------------------------------------}

-- | A @b@ together with its 'Point'.
--
-- The 'Point' is needed because we often need to know the hash, slot, or
-- point itself of the block or header in question, and we don't want to
-- deserialise the block to obtain it.
data WithPoint blk b = WithPoint
  { forall blk b. WithPoint blk b -> b
withoutPoint :: !b
  , forall blk b. WithPoint blk b -> Point blk
point :: !(Point blk)
  }

type instance HeaderHash (WithPoint blk b) = HeaderHash blk
instance StandardHash blk => StandardHash (WithPoint blk b)

getPoint :: BlockComponent blk (Point blk)
getPoint :: forall blk. BlockComponent blk (Point blk)
getPoint = SlotNo -> HeaderHash blk -> Point blk
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint (SlotNo -> HeaderHash blk -> Point blk)
-> BlockComponent blk SlotNo
-> BlockComponent blk (HeaderHash blk -> Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockComponent blk SlotNo
forall blk. BlockComponent blk SlotNo
GetSlot BlockComponent blk (HeaderHash blk -> Point blk)
-> BlockComponent blk (HeaderHash blk)
-> BlockComponent blk (Point blk)
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk (HeaderHash blk)
forall blk. BlockComponent blk (HeaderHash blk)
GetHash

getSerialisedBlockWithPoint ::
  BlockComponent blk (WithPoint blk (Serialised blk))
getSerialisedBlockWithPoint :: forall blk. BlockComponent blk (WithPoint blk (Serialised blk))
getSerialisedBlockWithPoint =
  Serialised blk -> Point blk -> WithPoint blk (Serialised blk)
forall blk b. b -> Point blk -> WithPoint blk b
WithPoint (Serialised blk -> Point blk -> WithPoint blk (Serialised blk))
-> BlockComponent blk (Serialised blk)
-> BlockComponent blk (Point blk -> WithPoint blk (Serialised blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Serialised blk
forall {k} (a :: k). ByteString -> Serialised a
Serialised (ByteString -> Serialised blk)
-> BlockComponent blk ByteString
-> BlockComponent blk (Serialised blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockComponent blk ByteString
forall blk. BlockComponent blk ByteString
GetRawBlock) BlockComponent blk (Point blk -> WithPoint blk (Serialised blk))
-> BlockComponent blk (Point blk)
-> BlockComponent blk (WithPoint blk (Serialised blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk (Point blk)
forall blk. BlockComponent blk (Point blk)
getPoint

getSerialisedHeader :: BlockComponent blk (SerialisedHeader blk)
getSerialisedHeader :: forall blk. BlockComponent blk (SerialisedHeader blk)
getSerialisedHeader =
  ((SomeSecond (NestedCtxt Header) blk, ByteString)
 -> SerialisedHeader blk)
-> SomeSecond (NestedCtxt Header) blk
-> ByteString
-> SerialisedHeader blk
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (SomeSecond (NestedCtxt Header) blk, ByteString)
-> SerialisedHeader blk
forall blk.
(SomeSecond (NestedCtxt Header) blk, ByteString)
-> SerialisedHeader blk
serialisedHeaderFromPair
    (SomeSecond (NestedCtxt Header) blk
 -> ByteString -> SerialisedHeader blk)
-> BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
-> BlockComponent blk (ByteString -> SerialisedHeader blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
forall blk. BlockComponent blk (SomeSecond (NestedCtxt Header) blk)
GetNestedCtxt
    BlockComponent blk (ByteString -> SerialisedHeader blk)
-> BlockComponent blk ByteString
-> BlockComponent blk (SerialisedHeader blk)
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk ByteString
forall blk. BlockComponent blk ByteString
GetRawHeader

getSerialisedHeaderWithPoint ::
  BlockComponent blk (WithPoint blk (SerialisedHeader blk))
getSerialisedHeaderWithPoint :: forall blk.
BlockComponent blk (WithPoint blk (SerialisedHeader blk))
getSerialisedHeaderWithPoint =
  SerialisedHeader blk
-> Point blk -> WithPoint blk (SerialisedHeader blk)
forall blk b. b -> Point blk -> WithPoint blk b
WithPoint (SerialisedHeader blk
 -> Point blk -> WithPoint blk (SerialisedHeader blk))
-> BlockComponent blk (SerialisedHeader blk)
-> BlockComponent
     blk (Point blk -> WithPoint blk (SerialisedHeader blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BlockComponent blk (SerialisedHeader blk)
forall blk. BlockComponent blk (SerialisedHeader blk)
getSerialisedHeader BlockComponent
  blk (Point blk -> WithPoint blk (SerialisedHeader blk))
-> BlockComponent blk (Point blk)
-> BlockComponent blk (WithPoint blk (SerialisedHeader blk))
forall a b.
BlockComponent blk (a -> b)
-> BlockComponent blk a -> BlockComponent blk b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BlockComponent blk (Point blk)
forall blk. BlockComponent blk (Point blk)
getPoint

{-------------------------------------------------------------------------------
  Support for tests
-------------------------------------------------------------------------------}

toChain ::
  forall m blk.
  (HasCallStack, IOLike m, HasHeader blk) =>
  ChainDB m blk -> m (Chain blk)
toChain :: forall (m :: * -> *) blk.
(HasCallStack, IOLike m, HasHeader blk) =>
ChainDB m blk -> m (Chain blk)
toChain ChainDB m blk
chainDB = (ResourceRegistry m -> m (Chain blk)) -> m (Chain blk)
forall (m :: * -> *) a.
(MonadSTM m, MonadMask m, MonadThread m, HasCallStack) =>
(ResourceRegistry m -> m a) -> m a
withRegistry ((ResourceRegistry m -> m (Chain blk)) -> m (Chain blk))
-> (ResourceRegistry m -> m (Chain blk)) -> m (Chain blk)
forall a b. (a -> b) -> a -> b
$ \ResourceRegistry m
registry ->
  ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk blk
-> m (Iterator m blk blk)
forall (m :: * -> *) blk b.
(MonadSTM m, HasHeader blk, HasCallStack) =>
ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> m (Iterator m blk b)
streamAll ChainDB m blk
chainDB ResourceRegistry m
registry BlockComponent blk blk
forall blk. BlockComponent blk blk
GetBlock m (Iterator m blk blk)
-> (Iterator m blk blk -> m (Chain blk)) -> m (Chain blk)
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Chain blk -> Iterator m blk blk -> m (Chain blk)
go Chain blk
forall block. Chain block
Genesis
 where
  go :: Chain blk -> Iterator m blk blk -> m (Chain blk)
  go :: Chain blk -> Iterator m blk blk -> m (Chain blk)
go Chain blk
chain Iterator m blk blk
it = do
    next <- Iterator m blk blk -> m (IteratorResult blk blk)
forall (m :: * -> *) blk b.
Iterator m blk b -> m (IteratorResult blk b)
iteratorNext Iterator m blk blk
it
    case next of
      IteratorResult blk
blk -> Chain blk -> Iterator m blk blk -> m (Chain blk)
go (blk -> Chain blk -> Chain blk
forall block.
HasHeader block =>
block -> Chain block -> Chain block
Chain.addBlock blk
blk Chain blk
chain) Iterator m blk blk
it
      IteratorResult blk blk
IteratorExhausted -> Chain blk -> m (Chain blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Chain blk
chain
      IteratorBlockGCed RealPoint blk
_ ->
        String -> m (Chain blk)
forall a. HasCallStack => String -> a
error String
"block on the current chain was garbage-collected"

fromChain ::
  forall m blk.
  IOLike m =>
  m (ChainDB m blk) ->
  Chain blk ->
  m (ChainDB m blk)
fromChain :: forall (m :: * -> *) blk.
IOLike m =>
m (ChainDB m blk) -> Chain blk -> m (ChainDB m blk)
fromChain m (ChainDB m blk)
openDB Chain blk
chain = do
  chainDB <- m (ChainDB m blk)
openDB
  mapM_ (addBlock_ chainDB noPunishment) $ Chain.toOldestFirst chain
  return chainDB

{-------------------------------------------------------------------------------
  Iterator API
-------------------------------------------------------------------------------}

data Iterator m blk b = Iterator
  { forall (m :: * -> *) blk b.
Iterator m blk b -> m (IteratorResult blk b)
iteratorNext :: m (IteratorResult blk b)
  , forall (m :: * -> *) blk b. Iterator m blk b -> m ()
iteratorClose :: m ()
  -- ^ When 'fmap'-ing or 'traverse'-ing (or using 'traverseIterator') an
  -- 'Iterator', the resulting iterator will still refer to and use the
  -- original one. This means that when either of them is closed, both
  -- will be closed in practice.
  }
  deriving ((forall a b. (a -> b) -> Iterator m blk a -> Iterator m blk b)
-> (forall a b. a -> Iterator m blk b -> Iterator m blk a)
-> Functor (Iterator m blk)
forall a b. a -> Iterator m blk b -> Iterator m blk a
forall a b. (a -> b) -> Iterator m blk a -> Iterator m blk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) blk a b.
Functor m =>
a -> Iterator m blk b -> Iterator m blk a
forall (m :: * -> *) blk a b.
Functor m =>
(a -> b) -> Iterator m blk a -> Iterator m blk b
$cfmap :: forall (m :: * -> *) blk a b.
Functor m =>
(a -> b) -> Iterator m blk a -> Iterator m blk b
fmap :: forall a b. (a -> b) -> Iterator m blk a -> Iterator m blk b
$c<$ :: forall (m :: * -> *) blk a b.
Functor m =>
a -> Iterator m blk b -> Iterator m blk a
<$ :: forall a b. a -> Iterator m blk b -> Iterator m blk a
Functor, (forall m. Monoid m => Iterator m blk m -> m)
-> (forall m a. Monoid m => (a -> m) -> Iterator m blk a -> m)
-> (forall m a. Monoid m => (a -> m) -> Iterator m blk a -> m)
-> (forall a b. (a -> b -> b) -> b -> Iterator m blk a -> b)
-> (forall a b. (a -> b -> b) -> b -> Iterator m blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> Iterator m blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> Iterator m blk a -> b)
-> (forall a. (a -> a -> a) -> Iterator m blk a -> a)
-> (forall a. (a -> a -> a) -> Iterator m blk a -> a)
-> (forall a. Iterator m blk a -> [a])
-> (forall a. Iterator m blk a -> Bool)
-> (forall a. Iterator m blk a -> Int)
-> (forall a. Eq a => a -> Iterator m blk a -> Bool)
-> (forall a. Ord a => Iterator m blk a -> a)
-> (forall a. Ord a => Iterator m blk a -> a)
-> (forall a. Num a => Iterator m blk a -> a)
-> (forall a. Num a => Iterator m blk a -> a)
-> Foldable (Iterator m blk)
forall a. Eq a => a -> Iterator m blk a -> Bool
forall a. Num a => Iterator m blk a -> a
forall a. Ord a => Iterator m blk a -> a
forall m. Monoid m => Iterator m blk m -> m
forall a. Iterator m blk a -> Bool
forall a. Iterator m blk a -> Int
forall a. Iterator m blk a -> [a]
forall a. (a -> a -> a) -> Iterator m blk a -> a
forall m a. Monoid m => (a -> m) -> Iterator m blk a -> m
forall b a. (b -> a -> b) -> b -> Iterator m blk a -> b
forall a b. (a -> b -> b) -> b -> Iterator m blk a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
forall (m :: * -> *) blk a.
(Foldable m, Eq a) =>
a -> Iterator m blk a -> Bool
forall (m :: * -> *) blk a.
(Foldable m, Num a) =>
Iterator m blk a -> a
forall (m :: * -> *) blk a.
(Foldable m, Ord a) =>
Iterator m blk a -> a
forall (m :: * -> *) blk m.
(Foldable m, Monoid m) =>
Iterator m blk m -> m
forall (m :: * -> *) blk a. Foldable m => Iterator m blk a -> Bool
forall (m :: * -> *) blk a. Foldable m => Iterator m blk a -> Int
forall (m :: * -> *) blk a. Foldable m => Iterator m blk a -> [a]
forall (m :: * -> *) blk a.
Foldable m =>
(a -> a -> a) -> Iterator m blk a -> a
forall (m :: * -> *) blk m a.
(Foldable m, Monoid m) =>
(a -> m) -> Iterator m blk a -> m
forall (m :: * -> *) blk b a.
Foldable m =>
(b -> a -> b) -> b -> Iterator m blk a -> b
forall (m :: * -> *) blk a b.
Foldable m =>
(a -> b -> b) -> b -> Iterator m blk a -> b
$cfold :: forall (m :: * -> *) blk m.
(Foldable m, Monoid m) =>
Iterator m blk m -> m
fold :: forall m. Monoid m => Iterator m blk m -> m
$cfoldMap :: forall (m :: * -> *) blk m a.
(Foldable m, Monoid m) =>
(a -> m) -> Iterator m blk a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Iterator m blk a -> m
$cfoldMap' :: forall (m :: * -> *) blk m a.
(Foldable m, Monoid m) =>
(a -> m) -> Iterator m blk a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Iterator m blk a -> m
$cfoldr :: forall (m :: * -> *) blk a b.
Foldable m =>
(a -> b -> b) -> b -> Iterator m blk a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Iterator m blk a -> b
$cfoldr' :: forall (m :: * -> *) blk a b.
Foldable m =>
(a -> b -> b) -> b -> Iterator m blk a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Iterator m blk a -> b
$cfoldl :: forall (m :: * -> *) blk b a.
Foldable m =>
(b -> a -> b) -> b -> Iterator m blk a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Iterator m blk a -> b
$cfoldl' :: forall (m :: * -> *) blk b a.
Foldable m =>
(b -> a -> b) -> b -> Iterator m blk a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Iterator m blk a -> b
$cfoldr1 :: forall (m :: * -> *) blk a.
Foldable m =>
(a -> a -> a) -> Iterator m blk a -> a
foldr1 :: forall a. (a -> a -> a) -> Iterator m blk a -> a
$cfoldl1 :: forall (m :: * -> *) blk a.
Foldable m =>
(a -> a -> a) -> Iterator m blk a -> a
foldl1 :: forall a. (a -> a -> a) -> Iterator m blk a -> a
$ctoList :: forall (m :: * -> *) blk a. Foldable m => Iterator m blk a -> [a]
toList :: forall a. Iterator m blk a -> [a]
$cnull :: forall (m :: * -> *) blk a. Foldable m => Iterator m blk a -> Bool
null :: forall a. Iterator m blk a -> Bool
$clength :: forall (m :: * -> *) blk a. Foldable m => Iterator m blk a -> Int
length :: forall a. Iterator m blk a -> Int
$celem :: forall (m :: * -> *) blk a.
(Foldable m, Eq a) =>
a -> Iterator m blk a -> Bool
elem :: forall a. Eq a => a -> Iterator m blk a -> Bool
$cmaximum :: forall (m :: * -> *) blk a.
(Foldable m, Ord a) =>
Iterator m blk a -> a
maximum :: forall a. Ord a => Iterator m blk a -> a
$cminimum :: forall (m :: * -> *) blk a.
(Foldable m, Ord a) =>
Iterator m blk a -> a
minimum :: forall a. Ord a => Iterator m blk a -> a
$csum :: forall (m :: * -> *) blk a.
(Foldable m, Num a) =>
Iterator m blk a -> a
sum :: forall a. Num a => Iterator m blk a -> a
$cproduct :: forall (m :: * -> *) blk a.
(Foldable m, Num a) =>
Iterator m blk a -> a
product :: forall a. Num a => Iterator m blk a -> a
Foldable, Functor (Iterator m blk)
Foldable (Iterator m blk)
(Functor (Iterator m blk), Foldable (Iterator m blk)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Iterator m blk a -> f (Iterator m blk b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Iterator m blk (f a) -> f (Iterator m blk a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Iterator m blk a -> m (Iterator m blk b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Iterator m blk (m a) -> m (Iterator m blk a))
-> Traversable (Iterator m blk)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
Iterator m blk (m a) -> m (Iterator m blk a)
forall (f :: * -> *) a.
Applicative f =>
Iterator m blk (f a) -> f (Iterator m blk a)
forall (m :: * -> *) blk. Traversable m => Functor (Iterator m blk)
forall (m :: * -> *) blk.
Traversable m =>
Foldable (Iterator m blk)
forall (m :: * -> *) blk (m :: * -> *) a.
(Traversable m, Monad m) =>
Iterator m blk (m a) -> m (Iterator m blk a)
forall (m :: * -> *) blk (f :: * -> *) a.
(Traversable m, Applicative f) =>
Iterator m blk (f a) -> f (Iterator m blk a)
forall (m :: * -> *) blk (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> Iterator m blk a -> m (Iterator m blk b)
forall (m :: * -> *) blk (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> Iterator m blk a -> f (Iterator m blk b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Iterator m blk a -> m (Iterator m blk b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Iterator m blk a -> f (Iterator m blk b)
$ctraverse :: forall (m :: * -> *) blk (f :: * -> *) a b.
(Traversable m, Applicative f) =>
(a -> f b) -> Iterator m blk a -> f (Iterator m blk b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Iterator m blk a -> f (Iterator m blk b)
$csequenceA :: forall (m :: * -> *) blk (f :: * -> *) a.
(Traversable m, Applicative f) =>
Iterator m blk (f a) -> f (Iterator m blk a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Iterator m blk (f a) -> f (Iterator m blk a)
$cmapM :: forall (m :: * -> *) blk (m :: * -> *) a b.
(Traversable m, Monad m) =>
(a -> m b) -> Iterator m blk a -> m (Iterator m blk b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Iterator m blk a -> m (Iterator m blk b)
$csequence :: forall (m :: * -> *) blk (m :: * -> *) a.
(Traversable m, Monad m) =>
Iterator m blk (m a) -> m (Iterator m blk a)
sequence :: forall (m :: * -> *) a.
Monad m =>
Iterator m blk (m a) -> m (Iterator m blk a)
Traversable)

-- | An iterator that is immediately exhausted.
emptyIterator :: Monad m => Iterator m blk b
emptyIterator :: forall (m :: * -> *) blk b. Monad m => Iterator m blk b
emptyIterator =
  Iterator
    { iteratorNext :: m (IteratorResult blk b)
iteratorNext = IteratorResult blk b -> m (IteratorResult blk b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return IteratorResult blk b
forall blk b. IteratorResult blk b
IteratorExhausted
    , iteratorClose :: m ()
iteratorClose = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    }

-- | Variant of 'traverse' instantiated to @'Iterator' m blk@ that executes
-- the monadic function when calling 'iteratorNext'.
traverseIterator ::
  Monad m =>
  (b -> m b') ->
  Iterator m blk b ->
  Iterator m blk b'
traverseIterator :: forall (m :: * -> *) b b' blk.
Monad m =>
(b -> m b') -> Iterator m blk b -> Iterator m blk b'
traverseIterator b -> m b'
f Iterator m blk b
it =
  Iterator m blk b
it
    { iteratorNext = iteratorNext it >>= traverse f
    }

data IteratorResult blk b
  = IteratorExhausted
  | IteratorResult b
  | -- | The block that was supposed to be streamed was garbage-collected from
    -- the VolatileDB, but not added to the ImmutableDB.
    --
    -- This will only happen when streaming very old forks very slowly.
    --
    -- The following example illustrates a situation in which an iterator result
    -- could be a 'IteratorBlockGCed' value. Suppose we start with an iterator
    -- positioned at block @c@, where @[[ x ]]@ denotes a block in the
    -- immutable DB:
    --
    -- @
    --                           iterator i
    --                             ↓
    -- ... ⟶ [[ a ]] → [[ b ]] → [ c ] -> [ d ]
    -- ──────────────────────╯   ╰────────────╯
    --   Immutable DB             Current chain
    -- @
    --
    -- Suppose we switch to a longer fork that branches off from the immutable
    -- tip ('[[b]]').
    --
    -- @
    --                            iterator i
    --                             ↓
    -- ... ⟶ [[ a ]] → [[ b ]] → [ c ] -> [ d ]
    -- ──────────────────────╯│
    --    Immutable DB        │
    --                        ╰-→ [ e ] -> [ f ] -> [ g ]
    --                            ╰─────────────────────╯
    --                                  Current chain
    -- @
    --
    -- Assume @k=2@. This means that block @e@ is the new immutable tip. If we
    -- would call 'iteratorNext' on @i@ __after__ block @e@ is copied to the
    -- immutable DB and @c@ and @d@ are garbage collected, then we will get
    -- 'IteratorBlockGCed'.
    IteratorBlockGCed (RealPoint blk)
  deriving ((forall a b.
 (a -> b) -> IteratorResult blk a -> IteratorResult blk b)
-> (forall a b. a -> IteratorResult blk b -> IteratorResult blk a)
-> Functor (IteratorResult blk)
forall a b. a -> IteratorResult blk b -> IteratorResult blk a
forall a b.
(a -> b) -> IteratorResult blk a -> IteratorResult blk b
forall blk a b. a -> IteratorResult blk b -> IteratorResult blk a
forall blk a b.
(a -> b) -> IteratorResult blk a -> IteratorResult blk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall blk a b.
(a -> b) -> IteratorResult blk a -> IteratorResult blk b
fmap :: forall a b.
(a -> b) -> IteratorResult blk a -> IteratorResult blk b
$c<$ :: forall blk a b. a -> IteratorResult blk b -> IteratorResult blk a
<$ :: forall a b. a -> IteratorResult blk b -> IteratorResult blk a
Functor, (forall m. Monoid m => IteratorResult blk m -> m)
-> (forall m a. Monoid m => (a -> m) -> IteratorResult blk a -> m)
-> (forall m a. Monoid m => (a -> m) -> IteratorResult blk a -> m)
-> (forall a b. (a -> b -> b) -> b -> IteratorResult blk a -> b)
-> (forall a b. (a -> b -> b) -> b -> IteratorResult blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> IteratorResult blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> IteratorResult blk a -> b)
-> (forall a. (a -> a -> a) -> IteratorResult blk a -> a)
-> (forall a. (a -> a -> a) -> IteratorResult blk a -> a)
-> (forall a. IteratorResult blk a -> [a])
-> (forall a. IteratorResult blk a -> Bool)
-> (forall a. IteratorResult blk a -> Int)
-> (forall a. Eq a => a -> IteratorResult blk a -> Bool)
-> (forall a. Ord a => IteratorResult blk a -> a)
-> (forall a. Ord a => IteratorResult blk a -> a)
-> (forall a. Num a => IteratorResult blk a -> a)
-> (forall a. Num a => IteratorResult blk a -> a)
-> Foldable (IteratorResult blk)
forall a. Eq a => a -> IteratorResult blk a -> Bool
forall a. Num a => IteratorResult blk a -> a
forall a. Ord a => IteratorResult blk a -> a
forall m. Monoid m => IteratorResult blk m -> m
forall a. IteratorResult blk a -> Bool
forall a. IteratorResult blk a -> Int
forall a. IteratorResult blk a -> [a]
forall a. (a -> a -> a) -> IteratorResult blk a -> a
forall blk a. Eq a => a -> IteratorResult blk a -> Bool
forall blk a. Num a => IteratorResult blk a -> a
forall blk a. Ord a => IteratorResult blk a -> a
forall m a. Monoid m => (a -> m) -> IteratorResult blk a -> m
forall blk m. Monoid m => IteratorResult blk m -> m
forall blk a. IteratorResult blk a -> Bool
forall blk a. IteratorResult blk a -> Int
forall blk a. IteratorResult blk a -> [a]
forall b a. (b -> a -> b) -> b -> IteratorResult blk a -> b
forall a b. (a -> b -> b) -> b -> IteratorResult blk a -> b
forall blk a. (a -> a -> a) -> IteratorResult blk a -> a
forall blk m a. Monoid m => (a -> m) -> IteratorResult blk a -> m
forall blk b a. (b -> a -> b) -> b -> IteratorResult blk a -> b
forall blk a b. (a -> b -> b) -> b -> IteratorResult blk a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall blk m. Monoid m => IteratorResult blk m -> m
fold :: forall m. Monoid m => IteratorResult blk m -> m
$cfoldMap :: forall blk m a. Monoid m => (a -> m) -> IteratorResult blk a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> IteratorResult blk a -> m
$cfoldMap' :: forall blk m a. Monoid m => (a -> m) -> IteratorResult blk a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> IteratorResult blk a -> m
$cfoldr :: forall blk a b. (a -> b -> b) -> b -> IteratorResult blk a -> b
foldr :: forall a b. (a -> b -> b) -> b -> IteratorResult blk a -> b
$cfoldr' :: forall blk a b. (a -> b -> b) -> b -> IteratorResult blk a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> IteratorResult blk a -> b
$cfoldl :: forall blk b a. (b -> a -> b) -> b -> IteratorResult blk a -> b
foldl :: forall b a. (b -> a -> b) -> b -> IteratorResult blk a -> b
$cfoldl' :: forall blk b a. (b -> a -> b) -> b -> IteratorResult blk a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> IteratorResult blk a -> b
$cfoldr1 :: forall blk a. (a -> a -> a) -> IteratorResult blk a -> a
foldr1 :: forall a. (a -> a -> a) -> IteratorResult blk a -> a
$cfoldl1 :: forall blk a. (a -> a -> a) -> IteratorResult blk a -> a
foldl1 :: forall a. (a -> a -> a) -> IteratorResult blk a -> a
$ctoList :: forall blk a. IteratorResult blk a -> [a]
toList :: forall a. IteratorResult blk a -> [a]
$cnull :: forall blk a. IteratorResult blk a -> Bool
null :: forall a. IteratorResult blk a -> Bool
$clength :: forall blk a. IteratorResult blk a -> Int
length :: forall a. IteratorResult blk a -> Int
$celem :: forall blk a. Eq a => a -> IteratorResult blk a -> Bool
elem :: forall a. Eq a => a -> IteratorResult blk a -> Bool
$cmaximum :: forall blk a. Ord a => IteratorResult blk a -> a
maximum :: forall a. Ord a => IteratorResult blk a -> a
$cminimum :: forall blk a. Ord a => IteratorResult blk a -> a
minimum :: forall a. Ord a => IteratorResult blk a -> a
$csum :: forall blk a. Num a => IteratorResult blk a -> a
sum :: forall a. Num a => IteratorResult blk a -> a
$cproduct :: forall blk a. Num a => IteratorResult blk a -> a
product :: forall a. Num a => IteratorResult blk a -> a
Foldable, Functor (IteratorResult blk)
Foldable (IteratorResult blk)
(Functor (IteratorResult blk), Foldable (IteratorResult blk)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> IteratorResult blk a -> f (IteratorResult blk b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    IteratorResult blk (f a) -> f (IteratorResult blk a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> IteratorResult blk a -> m (IteratorResult blk b))
-> (forall (m :: * -> *) a.
    Monad m =>
    IteratorResult blk (m a) -> m (IteratorResult blk a))
-> Traversable (IteratorResult blk)
forall blk. Functor (IteratorResult blk)
forall blk. Foldable (IteratorResult blk)
forall blk (m :: * -> *) a.
Monad m =>
IteratorResult blk (m a) -> m (IteratorResult blk a)
forall blk (f :: * -> *) a.
Applicative f =>
IteratorResult blk (f a) -> f (IteratorResult blk a)
forall blk (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IteratorResult blk a -> m (IteratorResult blk b)
forall blk (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IteratorResult blk a -> f (IteratorResult blk b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
IteratorResult blk (m a) -> m (IteratorResult blk a)
forall (f :: * -> *) a.
Applicative f =>
IteratorResult blk (f a) -> f (IteratorResult blk a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IteratorResult blk a -> m (IteratorResult blk b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IteratorResult blk a -> f (IteratorResult blk b)
$ctraverse :: forall blk (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IteratorResult blk a -> f (IteratorResult blk b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> IteratorResult blk a -> f (IteratorResult blk b)
$csequenceA :: forall blk (f :: * -> *) a.
Applicative f =>
IteratorResult blk (f a) -> f (IteratorResult blk a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
IteratorResult blk (f a) -> f (IteratorResult blk a)
$cmapM :: forall blk (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IteratorResult blk a -> m (IteratorResult blk b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> IteratorResult blk a -> m (IteratorResult blk b)
$csequence :: forall blk (m :: * -> *) a.
Monad m =>
IteratorResult blk (m a) -> m (IteratorResult blk a)
sequence :: forall (m :: * -> *) a.
Monad m =>
IteratorResult blk (m a) -> m (IteratorResult blk a)
Traversable)

deriving instance
  (Eq blk, Eq b, StandardHash blk) =>
  Eq (IteratorResult blk b)
deriving instance
  (Show blk, Show b, StandardHash blk) =>
  Show (IteratorResult blk b)

data UnknownRange blk
  = -- | The block at the given point was not found in the ChainDB.
    MissingBlock (RealPoint blk)
  | -- | The requested range forks off too far in the past, i.e. it doesn't
    -- fit on the tip of the ImmutableDB.
    ForkTooOld (StreamFrom blk)
  deriving (UnknownRange blk -> UnknownRange blk -> Bool
(UnknownRange blk -> UnknownRange blk -> Bool)
-> (UnknownRange blk -> UnknownRange blk -> Bool)
-> Eq (UnknownRange blk)
forall blk.
StandardHash blk =>
UnknownRange blk -> UnknownRange blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk.
StandardHash blk =>
UnknownRange blk -> UnknownRange blk -> Bool
== :: UnknownRange blk -> UnknownRange blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
UnknownRange blk -> UnknownRange blk -> Bool
/= :: UnknownRange blk -> UnknownRange blk -> Bool
Eq, Int -> UnknownRange blk -> ShowS
[UnknownRange blk] -> ShowS
UnknownRange blk -> String
(Int -> UnknownRange blk -> ShowS)
-> (UnknownRange blk -> String)
-> ([UnknownRange blk] -> ShowS)
-> Show (UnknownRange blk)
forall blk. StandardHash blk => Int -> UnknownRange blk -> ShowS
forall blk. StandardHash blk => [UnknownRange blk] -> ShowS
forall blk. StandardHash blk => UnknownRange blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. StandardHash blk => Int -> UnknownRange blk -> ShowS
showsPrec :: Int -> UnknownRange blk -> ShowS
$cshow :: forall blk. StandardHash blk => UnknownRange blk -> String
show :: UnknownRange blk -> String
$cshowList :: forall blk. StandardHash blk => [UnknownRange blk] -> ShowS
showList :: [UnknownRange blk] -> ShowS
Show)

-- | Stream all blocks from the current chain.
streamAll ::
  (MonadSTM m, HasHeader blk, HasCallStack) =>
  ChainDB m blk ->
  ResourceRegistry m ->
  BlockComponent blk b ->
  m (Iterator m blk b)
streamAll :: forall (m :: * -> *) blk b.
(MonadSTM m, HasHeader blk, HasCallStack) =>
ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> m (Iterator m blk b)
streamAll = StreamFrom blk
-> ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> m (Iterator m blk b)
forall (m :: * -> *) blk b.
(MonadSTM m, HasHeader blk, HasCallStack) =>
StreamFrom blk
-> ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> m (Iterator m blk b)
streamFrom (Point blk -> StreamFrom blk
forall blk. Point blk -> StreamFrom blk
StreamFromExclusive Point blk
forall {k} (block :: k). Point block
GenesisPoint)

-- | Stream blocks from the given point up to the tip from the current chain.
--
-- To stream all blocks from the current chain from the ChainDB, one would use
-- @'StreamFromExclusive' 'genesisPoint'@ as the lower bound and
-- @'StreamToInclusive' tip@ as the upper bound where @tip@ is retrieved with
-- 'getTipPoint'.
--
-- However, when the ChainDB is empty, @tip@ will be 'genesisPoint' too, in
-- which case the bounds don't make sense. This function correctly handles
-- this case.
--
-- Note that this is not a 'Follower', so the stream will not include blocks
-- that are added to the current chain after starting the stream.
streamFrom ::
  (MonadSTM m, HasHeader blk, HasCallStack) =>
  StreamFrom blk ->
  ChainDB m blk ->
  ResourceRegistry m ->
  BlockComponent blk b ->
  m (Iterator m blk b)
streamFrom :: forall (m :: * -> *) blk b.
(MonadSTM m, HasHeader blk, HasCallStack) =>
StreamFrom blk
-> ChainDB m blk
-> ResourceRegistry m
-> BlockComponent blk b
-> m (Iterator m blk b)
streamFrom StreamFrom blk
from ChainDB m blk
db ResourceRegistry m
registry BlockComponent blk b
blockComponent = do
  tip <- STM m (Point blk) -> m (Point blk)
forall a. HasCallStack => STM m a -> m a
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
$ ChainDB m blk -> STM m (Point blk)
forall (m :: * -> *) blk. ChainDB m blk -> STM m (Point blk)
getTipPoint ChainDB m blk
db
  case pointToWithOriginRealPoint tip of
    WithOrigin (RealPoint blk)
Origin -> Iterator m blk b -> m (Iterator m blk b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator m blk b
forall (m :: * -> *) blk b. Monad m => Iterator m blk b
emptyIterator
    NotOrigin RealPoint blk
tip' -> do
      errIt <-
        ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> BlockComponent blk b
   -> StreamFrom blk
   -> StreamTo blk
   -> m (Either (UnknownRange blk) (Iterator m blk b))
forall (m :: * -> *) blk.
ChainDB m blk
-> forall b.
   ResourceRegistry m
   -> BlockComponent blk b
   -> StreamFrom blk
   -> StreamTo blk
   -> m (Either (UnknownRange blk) (Iterator m blk b))
stream
          ChainDB m blk
db
          ResourceRegistry m
registry
          BlockComponent blk b
blockComponent
          StreamFrom blk
from
          (RealPoint blk -> StreamTo blk
forall blk. RealPoint blk -> StreamTo blk
StreamToInclusive RealPoint blk
tip')
      case errIt of
        Right Iterator m blk b
it -> Iterator m blk b -> m (Iterator m blk b)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Iterator m blk b
it
        Left UnknownRange blk
e -> String -> m (Iterator m blk b)
forall a. HasCallStack => String -> a
error (String -> m (Iterator m blk b)) -> String -> m (Iterator m blk b)
forall a b. (a -> b) -> a -> b
$ String
"failed to stream from genesis to tip: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> UnknownRange blk -> String
forall a. Show a => a -> String
show UnknownRange blk
e

{-------------------------------------------------------------------------------
  Followers
-------------------------------------------------------------------------------}

-- | Chain type
--
-- 'Follower's can choose to track changes to the "normal" 'SelectedChain', or
-- track the 'TentativeChain', which might contain a pipelineable header at the
-- tip.
data ChainType = SelectedChain | TentativeChain
  deriving (ChainType -> ChainType -> Bool
(ChainType -> ChainType -> Bool)
-> (ChainType -> ChainType -> Bool) -> Eq ChainType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChainType -> ChainType -> Bool
== :: ChainType -> ChainType -> Bool
$c/= :: ChainType -> ChainType -> Bool
/= :: ChainType -> ChainType -> Bool
Eq, Int -> ChainType -> ShowS
[ChainType] -> ShowS
ChainType -> String
(Int -> ChainType -> ShowS)
-> (ChainType -> String)
-> ([ChainType] -> ShowS)
-> Show ChainType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChainType -> ShowS
showsPrec :: Int -> ChainType -> ShowS
$cshow :: ChainType -> String
show :: ChainType -> String
$cshowList :: [ChainType] -> ShowS
showList :: [ChainType] -> ShowS
Show, (forall x. ChainType -> Rep ChainType x)
-> (forall x. Rep ChainType x -> ChainType) -> Generic ChainType
forall x. Rep ChainType x -> ChainType
forall x. ChainType -> Rep ChainType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ChainType -> Rep ChainType x
from :: forall x. ChainType -> Rep ChainType x
$cto :: forall x. Rep ChainType x -> ChainType
to :: forall x. Rep ChainType x -> ChainType
Generic)

-- | Follower
--
-- Unlike an 'Iterator', which is used to request a static segment of the
-- current chain or a recent fork, a follower is used to __follow__ the
-- __current chain__ either from the start or from a given point.
--
-- Unlike an 'Iterator', a 'Follower' is __dynamic__, that is, it will follow
-- the chain when it grows or forks.
--
-- A follower is __pull-based__, which avoids the neeed to have a growing queue
-- of changes to the chain on the server side in case the client is slower.
--
-- A follower always has an __implicit position__ associated with it. The
-- 'followerInstruction' and 'followerInstructionBlocking' operations request
-- the next 'ChainUpdate' wrt the follower's implicit position.
--
-- The type parameter @a@ will be instantiated with @blk@ or @'Header' blk@.
data Follower m blk a = Follower
  { forall (m :: * -> *) blk a.
Follower m blk a -> m (Maybe (ChainUpdate blk a))
followerInstruction :: m (Maybe (ChainUpdate blk a))
  -- ^ The next chain update (if one exists)
  --
  -- The 'AddBlock' instruction (see 'ChainUpdate') indicates that, to
  -- follow the current chain, the follower should extend its chain with the
  -- given block component (which will be a value of type 'a').
  --
  -- The 'RollBack' instruction indicates that the follower should perform a
  -- rollback by first backtracking to a certain point.
  --
  -- If a follower should switch to a fork, then it will first receive a
  -- 'RollBack' instruction followed by as many 'AddBlock' as necessary to
  -- reach the tip of the new chain.
  --
  -- When the follower's (implicit) position is in the immutable part of the
  -- chain, no rollback instructions will be encountered.
  --
  -- Not in @STM@ because might have to read the blocks or headers from
  -- disk.
  --
  -- We may roll back more than @k@, but only in case of data loss.
  , forall (m :: * -> *) blk a.
Follower m blk a -> m (ChainUpdate blk a)
followerInstructionBlocking :: m (ChainUpdate blk a)
  -- ^ Blocking version of 'followerInstruction'
  , forall (m :: * -> *) blk a.
Follower m blk a -> [Point blk] -> m (Maybe (Point blk))
followerForward :: [Point blk] -> m (Maybe (Point blk))
  -- ^ Move the follower forward
  --
  -- Must be given a list of points in order of preference; the iterator
  -- will move forward to the first point on the list that is on the current
  -- chain. Returns 'Nothing' if the iterator did not move, or the new point
  -- otherwise.
  --
  -- When successful, the first call to 'followerInstruction' after
  -- 'followerForward' will be a 'RollBack' to the point returned by
  -- 'followerForward'.
  --
  -- Cannot live in @STM@ because the points specified might live in the
  -- immutable DB.
  , forall (m :: * -> *) blk a. Follower m blk a -> m ()
followerClose :: m ()
  -- ^ Close the follower.
  --
  -- Idempotent.
  --
  -- After closing, all other operations on the follower will throw
  -- 'ClosedFollowerError'.
  }
  deriving (forall a b. (a -> b) -> Follower m blk a -> Follower m blk b)
-> (forall a b. a -> Follower m blk b -> Follower m blk a)
-> Functor (Follower m blk)
forall a b. a -> Follower m blk b -> Follower m blk a
forall a b. (a -> b) -> Follower m blk a -> Follower m blk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
forall (m :: * -> *) blk a b.
Functor m =>
a -> Follower m blk b -> Follower m blk a
forall (m :: * -> *) blk a b.
Functor m =>
(a -> b) -> Follower m blk a -> Follower m blk b
$cfmap :: forall (m :: * -> *) blk a b.
Functor m =>
(a -> b) -> Follower m blk a -> Follower m blk b
fmap :: forall a b. (a -> b) -> Follower m blk a -> Follower m blk b
$c<$ :: forall (m :: * -> *) blk a b.
Functor m =>
a -> Follower m blk b -> Follower m blk a
<$ :: forall a b. a -> Follower m blk b -> Follower m blk a
Functor

-- | Variant of 'traverse' instantiated to @'Follower' m blk@ that executes the
-- monadic function when calling 'followerInstruction' and
-- 'followerInstructionBlocking'.
traverseFollower ::
  Monad m =>
  (b -> m b') ->
  Follower m blk b ->
  Follower m blk b'
traverseFollower :: forall (m :: * -> *) b b' blk.
Monad m =>
(b -> m b') -> Follower m blk b -> Follower m blk b'
traverseFollower b -> m b'
f Follower m blk b
flr =
  Follower
    { followerInstruction :: m (Maybe (ChainUpdate blk b'))
followerInstruction = Follower m blk b -> m (Maybe (ChainUpdate blk b))
forall (m :: * -> *) blk a.
Follower m blk a -> m (Maybe (ChainUpdate blk a))
followerInstruction Follower m blk b
flr m (Maybe (ChainUpdate blk b))
-> (Maybe (ChainUpdate blk b) -> m (Maybe (ChainUpdate blk b')))
-> m (Maybe (ChainUpdate blk b'))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ChainUpdate blk b -> m (ChainUpdate blk b'))
-> Maybe (ChainUpdate blk b) -> m (Maybe (ChainUpdate blk b'))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse ((b -> m b') -> ChainUpdate blk b -> m (ChainUpdate blk b')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ChainUpdate blk a -> f (ChainUpdate blk b)
traverse b -> m b'
f)
    , followerInstructionBlocking :: m (ChainUpdate blk b')
followerInstructionBlocking = Follower m blk b -> m (ChainUpdate blk b)
forall (m :: * -> *) blk a.
Follower m blk a -> m (ChainUpdate blk a)
followerInstructionBlocking Follower m blk b
flr m (ChainUpdate blk b)
-> (ChainUpdate blk b -> m (ChainUpdate blk b'))
-> m (ChainUpdate blk b')
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (b -> m b') -> ChainUpdate blk b -> m (ChainUpdate blk b')
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ChainUpdate blk a -> f (ChainUpdate blk b)
traverse b -> m b'
f
    , followerForward :: [Point blk] -> m (Maybe (Point blk))
followerForward = Follower m blk b -> [Point blk] -> m (Maybe (Point blk))
forall (m :: * -> *) blk a.
Follower m blk a -> [Point blk] -> m (Maybe (Point blk))
followerForward Follower m blk b
flr
    , followerClose :: m ()
followerClose = Follower m blk b -> m ()
forall (m :: * -> *) blk a. Follower m blk a -> m ()
followerClose Follower m blk b
flr
    }

{-------------------------------------------------------------------------------
  Recovery
-------------------------------------------------------------------------------}

-- | Database failure
--
-- This exception wraps any kind of unexpected problem with the on-disk
-- storage of the chain.
--
-- The various constructors only serve to give more detailed information about
-- what went wrong, in case sysadmins want to investigate the disk failure.
-- The Chain DB itself does not differentiate; all disk failures are treated
-- equal and all trigger the same recovery procedure.
data ChainDbFailure blk
  = -- | The ledger DB threw a file-system error
    LgrDbFailure FsError
  | -- | Block missing from the chain DB
    --
    -- Thrown when we are not sure in which DB the block /should/ have been.
    ChainDbMissingBlock (RealPoint blk)

deriving instance StandardHash blk => Show (ChainDbFailure blk)

instance (Typeable blk, StandardHash blk) => Exception (ChainDbFailure blk) where
  displayException :: ChainDbFailure blk -> String
displayException = \case
    LgrDbFailure FsError
fse -> FsError -> String
fsError FsError
fse
    ChainDbMissingBlock{} -> String
corruption
   where
    corruption :: String
corruption =
      String
"The database got corrupted, full validation will be enabled for the next startup"

    -- The output will be a bit too detailed, but it will be quite clear.
    fsError :: FsError -> String
    fsError :: FsError -> String
fsError = FsError -> String
forall e. Exception e => e -> String
displayException

{-------------------------------------------------------------------------------
  Exceptions
-------------------------------------------------------------------------------}

-- | Database error
--
-- Thrown upon incorrect use: invalid input.
data ChainDbError blk
  = -- | The ChainDB is closed.
    --
    -- This will be thrown when performing any operation on the ChainDB except
    -- for 'isOpen' and 'closeDB'. The 'CallStack' of the operation on the
    -- ChainDB is included in the error.
    ClosedDBError PrettyCallStack
  | -- | The follower is closed.
    --
    -- This will be thrown when performing any operation on a closed followers,
    -- except for 'followerClose'.
    ClosedFollowerError
  | -- | When there is no chain/fork that satisfies the bounds passed to
    -- 'streamBlocks'.
    --
    -- * The lower and upper bound are not on the same chain.
    -- * The bounds don't make sense, e.g., the lower bound starts after the
    --   upper bound, or the lower bound starts from genesis, /inclusive/.
    InvalidIteratorRange (StreamFrom blk) (StreamTo blk)

deriving instance (Typeable blk, StandardHash blk) => Show (ChainDbError blk)

instance (Typeable blk, StandardHash blk) => Exception (ChainDbError blk) where
  displayException :: ChainDbError blk -> String
displayException = \case
    -- The user should not see the exception below, a fatal exception with
    -- more information about the specific will have been thrown. This
    -- exception will only be thrown if some thread still tries to use the
    -- ChainDB afterwards, which should not happen.
    ClosedDBError{} ->
      String
"The database was used after it was closed because it encountered an unrecoverable error"
    -- The user won't see the exceptions below, they are not fatal.
    ClosedFollowerError{} ->
      String
"The block/header follower was used after it was closed"
    InvalidIteratorRange{} ->
      String
"An invalid range of blocks was requested"

-- | The Limit on Eagerness (LoE) is a mechanism for keeping ChainSel from
-- advancing the current selection in the case of competing chains.
--
-- The LoE tip is the youngest header that is present on all candidate
-- fragments. Thus, after the LoE tip, peers either disagree on how the chain
-- follows, or they do not offer more headers.
--
-- The LoE restrains the current selection of the node to be on the same chain
-- as the LoE tip, and to not extend more than k blocks from it.
--
-- It requires a resolution mechanism to prevent indefinite stalling, which
-- is implemented by the Genesis Density Disconnection governor, a component
-- that disconnects from peers with forks it considers inferior.
-- See "Ouroboros.Consensus.Genesis.Governor" for details.
--
-- This type indicates whether LoE is enabled, and contains a value if it is.
-- There is no a priori meaning assigned to the type parameter @a@.
-- @LoE a@ is isomorphic to @Maybe a@, with the added meaning that
-- @Just/LoEEnabled@ is only used when the LoE is enabled.
data LoE a
  = -- | The LoE is disabled, so ChainSel will not keep the selection from
    -- advancing.
    LoEDisabled
  | -- | The LoE is enabled.
    LoEEnabled !a
  deriving (LoE a -> LoE a -> Bool
(LoE a -> LoE a -> Bool) -> (LoE a -> LoE a -> Bool) -> Eq (LoE a)
forall a. Eq a => LoE a -> LoE a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => LoE a -> LoE a -> Bool
== :: LoE a -> LoE a -> Bool
$c/= :: forall a. Eq a => LoE a -> LoE a -> Bool
/= :: LoE a -> LoE a -> Bool
Eq, Int -> LoE a -> ShowS
[LoE a] -> ShowS
LoE a -> String
(Int -> LoE a -> ShowS)
-> (LoE a -> String) -> ([LoE a] -> ShowS) -> Show (LoE a)
forall a. Show a => Int -> LoE a -> ShowS
forall a. Show a => [LoE a] -> ShowS
forall a. Show a => LoE a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> LoE a -> ShowS
showsPrec :: Int -> LoE a -> ShowS
$cshow :: forall a. Show a => LoE a -> String
show :: LoE a -> String
$cshowList :: forall a. Show a => [LoE a] -> ShowS
showList :: [LoE a] -> ShowS
Show, (forall x. LoE a -> Rep (LoE a) x)
-> (forall x. Rep (LoE a) x -> LoE a) -> Generic (LoE a)
forall x. Rep (LoE a) x -> LoE a
forall x. LoE a -> Rep (LoE a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (LoE a) x -> LoE a
forall a x. LoE a -> Rep (LoE a) x
$cfrom :: forall a x. LoE a -> Rep (LoE a) x
from :: forall x. LoE a -> Rep (LoE a) x
$cto :: forall a x. Rep (LoE a) x -> LoE a
to :: forall x. Rep (LoE a) x -> LoE a
Generic, Context -> LoE a -> IO (Maybe ThunkInfo)
Proxy (LoE a) -> String
(Context -> LoE a -> IO (Maybe ThunkInfo))
-> (Context -> LoE a -> IO (Maybe ThunkInfo))
-> (Proxy (LoE a) -> String)
-> NoThunks (LoE a)
forall a. NoThunks a => Context -> LoE a -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Proxy (LoE a) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: forall a. NoThunks a => Context -> LoE a -> IO (Maybe ThunkInfo)
noThunks :: Context -> LoE a -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall a. NoThunks a => Context -> LoE a -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> LoE a -> IO (Maybe ThunkInfo)
$cshowTypeOf :: forall a. NoThunks a => Proxy (LoE a) -> String
showTypeOf :: Proxy (LoE a) -> String
NoThunks, (forall a b. (a -> b) -> LoE a -> LoE b)
-> (forall a b. a -> LoE b -> LoE a) -> Functor LoE
forall a b. a -> LoE b -> LoE a
forall a b. (a -> b) -> LoE a -> LoE b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LoE a -> LoE b
fmap :: forall a b. (a -> b) -> LoE a -> LoE b
$c<$ :: forall a b. a -> LoE b -> LoE a
<$ :: forall a b. a -> LoE b -> LoE a
Functor, (forall m. Monoid m => LoE m -> m)
-> (forall m a. Monoid m => (a -> m) -> LoE a -> m)
-> (forall m a. Monoid m => (a -> m) -> LoE a -> m)
-> (forall a b. (a -> b -> b) -> b -> LoE a -> b)
-> (forall a b. (a -> b -> b) -> b -> LoE a -> b)
-> (forall b a. (b -> a -> b) -> b -> LoE a -> b)
-> (forall b a. (b -> a -> b) -> b -> LoE a -> b)
-> (forall a. (a -> a -> a) -> LoE a -> a)
-> (forall a. (a -> a -> a) -> LoE a -> a)
-> (forall a. LoE a -> [a])
-> (forall a. LoE a -> Bool)
-> (forall a. LoE a -> Int)
-> (forall a. Eq a => a -> LoE a -> Bool)
-> (forall a. Ord a => LoE a -> a)
-> (forall a. Ord a => LoE a -> a)
-> (forall a. Num a => LoE a -> a)
-> (forall a. Num a => LoE a -> a)
-> Foldable LoE
forall a. Eq a => a -> LoE a -> Bool
forall a. Num a => LoE a -> a
forall a. Ord a => LoE a -> a
forall m. Monoid m => LoE m -> m
forall a. LoE a -> Bool
forall a. LoE a -> Int
forall a. LoE a -> [a]
forall a. (a -> a -> a) -> LoE a -> a
forall m a. Monoid m => (a -> m) -> LoE a -> m
forall b a. (b -> a -> b) -> b -> LoE a -> b
forall a b. (a -> b -> b) -> b -> LoE a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => LoE m -> m
fold :: forall m. Monoid m => LoE m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LoE a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LoE a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LoE a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> LoE a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> LoE a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LoE a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LoE a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LoE a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LoE a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LoE a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LoE a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> LoE a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> LoE a -> a
foldr1 :: forall a. (a -> a -> a) -> LoE a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LoE a -> a
foldl1 :: forall a. (a -> a -> a) -> LoE a -> a
$ctoList :: forall a. LoE a -> [a]
toList :: forall a. LoE a -> [a]
$cnull :: forall a. LoE a -> Bool
null :: forall a. LoE a -> Bool
$clength :: forall a. LoE a -> Int
length :: forall a. LoE a -> Int
$celem :: forall a. Eq a => a -> LoE a -> Bool
elem :: forall a. Eq a => a -> LoE a -> Bool
$cmaximum :: forall a. Ord a => LoE a -> a
maximum :: forall a. Ord a => LoE a -> a
$cminimum :: forall a. Ord a => LoE a -> a
minimum :: forall a. Ord a => LoE a -> a
$csum :: forall a. Num a => LoE a -> a
sum :: forall a. Num a => LoE a -> a
$cproduct :: forall a. Num a => LoE a -> a
product :: forall a. Num a => LoE a -> a
Foldable, Functor LoE
Foldable LoE
(Functor LoE, Foldable LoE) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> LoE a -> f (LoE b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LoE (f a) -> f (LoE a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LoE a -> m (LoE b))
-> (forall (m :: * -> *) a. Monad m => LoE (m a) -> m (LoE a))
-> Traversable LoE
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => LoE (m a) -> m (LoE a)
forall (f :: * -> *) a. Applicative f => LoE (f a) -> f (LoE a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LoE a -> m (LoE b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LoE a -> f (LoE b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LoE a -> f (LoE b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LoE a -> f (LoE b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => LoE (f a) -> f (LoE a)
sequenceA :: forall (f :: * -> *) a. Applicative f => LoE (f a) -> f (LoE a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LoE a -> m (LoE b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LoE a -> m (LoE b)
$csequence :: forall (m :: * -> *) a. Monad m => LoE (m a) -> m (LoE a)
sequence :: forall (m :: * -> *) a. Monad m => LoE (m a) -> m (LoE a)
Traversable)

-- | Get the current LoE fragment (if the LoE is enabled), see 'LoE' for more
-- details. This fragment must be anchored in a (recent) point on the immutable
-- chain, just like candidate fragments.
type GetLoEFragment m blk = m (LoE (AnchoredFragment (HeaderWithTime blk)))