{-# 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 (..)
  , getCurrentLedger
  , getCurrentTip
  , getImmutableLedger
  , getPastLedger
  , 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.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment
                     (InvalidBlockPunishment)
import qualified Ouroboros.Consensus.Storage.ChainDB.API.Types.InvalidBlockPunishment as InvalidBlockPunishment
import           Ouroboros.Consensus.Storage.Common
import           Ouroboros.Consensus.Storage.LedgerDB (LedgerDB')
import qualified Ouroboros.Consensus.Storage.LedgerDB as LedgerDB
import           Ouroboros.Consensus.Storage.Serialisation
import           Ouroboros.Consensus.Util ((..:))
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.Mock.Chain (Chain (..))
import qualified Ouroboros.Network.Mock.Chain as Chain
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 {
      -- | 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
-> InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)
addBlockAsync      :: InvalidBlockPunishment m -> blk -> m (AddBlockPromise m blk)

      -- | Trigger reprocessing of blocks postponed by the LoE.
    , forall (m :: * -> *) blk.
ChainDB m blk -> m (ChainSelectionPromise m)
chainSelAsync      :: m (ChainSelectionPromise m)

      -- | 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 (Header blk))
getCurrentChain    :: STM m (AnchoredFragment (Header blk))

      -- | Return the LedgerDB containing the last @k@ ledger states.
    , forall (m :: * -> *) blk. ChainDB m blk -> STM m (LedgerDB' blk)
getLedgerDB        :: STM m (LedgerDB' blk)

      -- | Get a 'HeaderStateHistory' populated with the 'HeaderState's and slot
      -- times of the last @k@ blocks of the current chain.
    , forall (m :: * -> *) blk.
ChainDB m blk -> STM m (HeaderStateHistory blk)
getHeaderStateHistory :: STM m (HeaderStateHistory 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 blk)
getTipBlock        :: m (Maybe 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 -> m (Maybe (Header blk))
getTipHeader       :: m (Maybe (Header 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 -> STM m (Point blk)
getTipPoint        :: STM m (Point blk)

      -- | 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
-> forall b. BlockComponent blk b -> RealPoint blk -> m (Maybe b)
getBlockComponent  :: forall b. BlockComponent blk b
                         -> RealPoint blk -> m (Maybe b)

      -- | Return membership check function for recent blocks
      --
      -- 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 (Point blk -> Bool)
getIsFetched       :: STM m (Point blk -> 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 (RealPoint blk -> Maybe Bool)
getIsValid         :: STM m (RealPoint blk -> Maybe Bool)

      -- | Get the highest slot number stored in the ChainDB.
      --
      -- 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 -> STM m MaxSlotNo
getMaxSlotNo       :: STM m MaxSlotNo

      -- | 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
   -> 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))

      -- | 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
-> 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)

      -- | 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
     (WithFingerprint
        (HeaderHash blk -> Maybe (ExtValidationError blk)))
getIsInvalidBlock :: STM m (WithFingerprint (HeaderHash blk -> Maybe (ExtValidationError blk)))

    , forall (m :: * -> *) blk. ChainDB m blk -> m ()
closeDB            :: m ()

      -- | Return 'True' when the database is open.
      --
      -- 'False' when the database is closed.
    , forall (m :: * -> *) blk. ChainDB m blk -> STM m Bool
isOpen             :: STM m Bool
    }

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

-- | Get current ledger
getCurrentLedger ::
     (Monad (STM m), IsLedger (LedgerState blk))
  => ChainDB m blk -> STM m (ExtLedgerState blk)
getCurrentLedger :: forall (m :: * -> *) blk.
(Monad (STM m), IsLedger (LedgerState blk)) =>
ChainDB m blk -> STM m (ExtLedgerState blk)
getCurrentLedger = (LedgerDB (ExtLedgerState blk) -> ExtLedgerState blk)
-> STM m (LedgerDB (ExtLedgerState blk))
-> STM m (ExtLedgerState 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 LedgerDB (ExtLedgerState blk) -> ExtLedgerState blk
forall l. GetTip l => LedgerDB l -> l
LedgerDB.ledgerDbCurrent (STM m (LedgerDB (ExtLedgerState blk))
 -> STM m (ExtLedgerState blk))
-> (ChainDB m blk -> STM m (LedgerDB (ExtLedgerState blk)))
-> ChainDB m blk
-> STM m (ExtLedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDB m blk -> STM m (LedgerDB (ExtLedgerState blk))
forall (m :: * -> *) blk. ChainDB m blk -> STM m (LedgerDB' blk)
getLedgerDB

-- | Get the immutable ledger, i.e., typically @k@ blocks back.
getImmutableLedger ::
     Monad (STM m)
  => ChainDB m blk -> STM m (ExtLedgerState blk)
getImmutableLedger :: forall (m :: * -> *) blk.
Monad (STM m) =>
ChainDB m blk -> STM m (ExtLedgerState blk)
getImmutableLedger = (LedgerDB (ExtLedgerState blk) -> ExtLedgerState blk)
-> STM m (LedgerDB (ExtLedgerState blk))
-> STM m (ExtLedgerState 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 LedgerDB (ExtLedgerState blk) -> ExtLedgerState blk
forall l. LedgerDB l -> l
LedgerDB.ledgerDbAnchor (STM m (LedgerDB (ExtLedgerState blk))
 -> STM m (ExtLedgerState blk))
-> (ChainDB m blk -> STM m (LedgerDB (ExtLedgerState blk)))
-> ChainDB m blk
-> STM m (ExtLedgerState blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainDB m blk -> STM m (LedgerDB (ExtLedgerState blk))
forall (m :: * -> *) blk. ChainDB m blk -> STM m (LedgerDB' blk)
getLedgerDB

-- | 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.
getPastLedger ::
     (Monad (STM m), LedgerSupportsProtocol blk)
  => ChainDB m blk -> Point blk -> STM m (Maybe (ExtLedgerState blk))
getPastLedger :: forall (m :: * -> *) blk.
(Monad (STM m), LedgerSupportsProtocol blk) =>
ChainDB m blk -> Point blk -> STM m (Maybe (ExtLedgerState blk))
getPastLedger ChainDB m blk
db Point blk
pt = Point blk
-> LedgerDB (ExtLedgerState blk) -> Maybe (ExtLedgerState blk)
forall blk l.
(HasHeader blk, IsLedger l, HeaderHash l ~ HeaderHash blk) =>
Point blk -> LedgerDB l -> Maybe l
LedgerDB.ledgerDbPast Point blk
pt (LedgerDB (ExtLedgerState blk) -> Maybe (ExtLedgerState blk))
-> STM m (LedgerDB (ExtLedgerState blk))
-> STM m (Maybe (ExtLedgerState blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB m blk -> STM m (LedgerDB (ExtLedgerState blk))
forall (m :: * -> *) blk. ChainDB m blk -> STM m (LedgerDB' blk)
getLedgerDB ChainDB m blk
db

{-------------------------------------------------------------------------------
  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
    AddBlockPromise m blk
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
    STM m Bool -> m Bool
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m Bool -> m Bool) -> STM m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ AddBlockPromise m blk -> STM m Bool
forall (m :: * -> *) blk. AddBlockPromise m blk -> STM m Bool
blockWrittenToDisk AddBlockPromise m blk
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
    AddBlockPromise m blk
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
    STM m (AddBlockResult blk) -> m (AddBlockResult blk)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (AddBlockResult blk) -> m (AddBlockResult blk))
-> STM m (AddBlockResult blk) -> m (AddBlockResult blk)
forall a b. (a -> b) -> a -> b
$ AddBlockPromise m blk -> STM m (AddBlockResult blk)
forall (m :: * -> *) blk.
AddBlockPromise m blk -> STM m (AddBlockResult blk)
blockProcessed AddBlockPromise m blk
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
      IteratorResult blk blk
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 IteratorResult blk blk
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 blk
chainDB <- m (ChainDB m blk)
openDB
    (blk -> m ()) -> [blk] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (ChainDB m blk -> InvalidBlockPunishment m -> blk -> m ()
forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk -> InvalidBlockPunishment m -> blk -> m ()
addBlock_ ChainDB m blk
chainDB InvalidBlockPunishment m
forall (m :: * -> *). Applicative m => InvalidBlockPunishment m
InvalidBlockPunishment.noPunishment) ([blk] -> m ()) -> [blk] -> m ()
forall a b. (a -> b) -> a -> b
$ Chain blk -> [blk]
forall block. Chain block -> [block]
Chain.toOldestFirst Chain blk
chain
    ChainDB m blk -> m (ChainDB m blk)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ChainDB m blk
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
  | IteratorBlockGCed (RealPoint blk)
    -- ^ 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'.
    --
  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
    Point blk
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 Point blk -> WithOrigin (RealPoint blk)
forall blk. Point blk -> WithOrigin (RealPoint blk)
pointToWithOriginRealPoint Point blk
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
        Either (UnknownRange blk) (Iterator m blk b)
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 Either (UnknownRange blk) (Iterator m blk b)
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 {
      -- | 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 (Maybe (ChainUpdate blk a))
followerInstruction         :: m (Maybe (ChainUpdate blk a))

      -- | Blocking version of 'followerInstruction'
    , forall (m :: * -> *) blk a.
Follower m blk a -> m (ChainUpdate blk a)
followerInstructionBlocking :: m (ChainUpdate blk a)

      -- | 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 -> [Point blk] -> m (Maybe (Point blk))
followerForward             :: [Point blk] -> m (Maybe (Point blk))

      -- | Close the follower.
      --
      -- Idempotent.
      --
      -- After closing, all other operations on the follower will throw
      -- 'ClosedFollowerError'.
    , forall (m :: * -> *) blk a. Follower m blk a -> m ()
followerClose               :: m ()
    }
  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 (Typeable)

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 (Typeable)

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 (Header blk)))