{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE KindSignatures      #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE MultiWayIf          #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE RecordWildCards     #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module Ouroboros.Consensus.Storage.LedgerDB.OnDisk (
    -- * Opening the database
    initLedgerDB
  , InitLog(..)
  , InitFailure(..)
    -- ** Instantiate in-memory to @blk@
  , LedgerDB'
  , ledgerDbTip'
  , ChainSummary'
  , csTip'
  , AnnLedgerError'
    -- ** Abstraction over the stream API
  , NextBlock(..)
  , StreamAPI(..)
    -- * Write to disk
  , takeSnapshot
  , trimSnapshots
    -- * Low-level API (primarily exposed for testing)
  , DiskSnapshot -- opaque
  , deleteSnapshot
  , snapshotToPath
    -- * Trace events
  , TraceEvent(..)
  , TraceReplayEvent(..)
  ) where

import qualified Codec.CBOR.Write as CBOR
import           Codec.Serialise.Decoding (Decoder)
import           Codec.Serialise.Encoding (Encoding)
import           Control.Monad.Except
import           Control.Tracer
import qualified Data.List as List
import           Data.Maybe (mapMaybe)
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Word
import           GHC.Generics (Generic)
import           GHC.Stack
import           Text.Read (readMaybe)

import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Ledger.Extended
import           Ouroboros.Consensus.Ledger.Inspect
import           Ouroboros.Consensus.Ledger.SupportsProtocol
import           Ouroboros.Consensus.Util.CBOR (ReadIncrementalErr,
                     readIncremental)
import           Ouroboros.Consensus.Util.IOLike

import           Ouroboros.Consensus.Storage.FS.API
import           Ouroboros.Consensus.Storage.FS.API.Types

import           Ouroboros.Consensus.Storage.LedgerDB.DiskPolicy
import           Ouroboros.Consensus.Storage.LedgerDB.InMemory

{-------------------------------------------------------------------------------
  Instantiate the in-memory DB to @blk@
-------------------------------------------------------------------------------}

type LedgerDB'       blk = LedgerDB       (ExtLedgerState blk) (RealPoint blk)
type ChainSummary'   blk = ChainSummary   (ExtLedgerState blk) (RealPoint blk)
type AnnLedgerError' blk = AnnLedgerError (ExtLedgerState blk) (RealPoint blk)

csTip' :: ChainSummary' blk -> Point blk
csTip' :: ChainSummary' blk -> Point blk
csTip' = WithOrigin (RealPoint blk) -> Point blk
forall blk. WithOrigin (RealPoint blk) -> Point blk
withOriginRealPointToPoint (WithOrigin (RealPoint blk) -> Point blk)
-> (ChainSummary' blk -> WithOrigin (RealPoint blk))
-> ChainSummary' blk
-> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ChainSummary' blk -> WithOrigin (RealPoint blk)
forall l r. ChainSummary l r -> WithOrigin r
csTip

ledgerDbTip' :: LedgerDB' blk -> Point blk
ledgerDbTip' :: LedgerDB' blk -> Point blk
ledgerDbTip' = WithOrigin (RealPoint blk) -> Point blk
forall blk. WithOrigin (RealPoint blk) -> Point blk
withOriginRealPointToPoint (WithOrigin (RealPoint blk) -> Point blk)
-> (LedgerDB' blk -> WithOrigin (RealPoint blk))
-> LedgerDB' blk
-> Point blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LedgerDB' blk -> WithOrigin (RealPoint blk)
forall l r. LedgerDB l r -> WithOrigin r
ledgerDbTip

{-------------------------------------------------------------------------------
  Abstraction over the streaming API provided by the Chain DB
-------------------------------------------------------------------------------}

-- | Next block returned during streaming
data NextBlock blk = NoMoreBlocks | NextBlock blk

-- | Stream blocks from the immutable DB
--
-- When we initialize the ledger DB, we try to find a snapshot close to the
-- tip of the immutable DB, and then stream blocks from the immutable DB to its
-- tip to bring the ledger up to date with the tip of the immutable DB.
--
-- In CPS form to enable the use of 'withXYZ' style iterator init functions.
data StreamAPI m blk = StreamAPI {
      -- | Start streaming after the specified block
      StreamAPI m blk
-> forall a.
   HasCallStack =>
   Point blk -> (Maybe (m (NextBlock blk)) -> m a) -> m a
streamAfter :: forall a. HasCallStack
        => Point blk
        -- Reference to the block corresponding to the snapshot we found
        -- (or 'TipGen' if we didn't find any)

        -> (Maybe (m (NextBlock blk)) -> m a)
        -- Get the next block (by value)
        --
        -- Should be 'Nothing' if the snapshot we found is more recent than
        -- the tip of the immutable DB; since we only store snapshots to disk
        -- for blocks in the immutable DB, this can only happen if the
        -- immutable DB got truncated due to disk corruption.
        -> m a
    }

-- | Stream all blocks
streamAll ::
     forall m blk e a. (Monad m, HasCallStack)
  => StreamAPI m blk
  -> Point blk         -- ^ Starting point for streaming
  -> (Point blk -> e)  -- ^ Error when tip not found
  -> a                 -- ^ Starting point when tip /is/ found
  -> (blk -> a -> m a) -- ^ Update function for each block
  -> ExceptT e m a
streamAll :: StreamAPI m blk
-> Point blk
-> (Point blk -> e)
-> a
-> (blk -> a -> m a)
-> ExceptT e m a
streamAll StreamAPI{forall a.
HasCallStack =>
Point blk -> (Maybe (m (NextBlock blk)) -> m a) -> m a
streamAfter :: forall a.
HasCallStack =>
Point blk -> (Maybe (m (NextBlock blk)) -> m a) -> m a
streamAfter :: forall (m :: * -> *) blk.
StreamAPI m blk
-> forall a.
   HasCallStack =>
   Point blk -> (Maybe (m (NextBlock blk)) -> m a) -> m a
..} Point blk
tip Point blk -> e
notFound a
e blk -> a -> m a
f = m (Either e a) -> ExceptT e m a
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (m (Either e a) -> ExceptT e m a)
-> m (Either e a) -> ExceptT e m a
forall a b. (a -> b) -> a -> b
$
    Point blk
-> (Maybe (m (NextBlock blk)) -> m (Either e a)) -> m (Either e a)
forall a.
HasCallStack =>
Point blk -> (Maybe (m (NextBlock blk)) -> m a) -> m a
streamAfter Point blk
tip ((Maybe (m (NextBlock blk)) -> m (Either e a)) -> m (Either e a))
-> (Maybe (m (NextBlock blk)) -> m (Either e a)) -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ \case
      Maybe (m (NextBlock blk))
Nothing      -> Either e a -> m (Either e a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either e a -> m (Either e a)) -> Either e a -> m (Either e a)
forall a b. (a -> b) -> a -> b
$ e -> Either e a
forall a b. a -> Either a b
Left (Point blk -> e
notFound Point blk
tip)
      Just m (NextBlock blk)
getNext -> do
        let go :: a -> m a
            go :: a -> m a
go a
a = do NextBlock blk
mNext <- m (NextBlock blk)
getNext
                      case NextBlock blk
mNext of
                        NextBlock blk
NoMoreBlocks -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
                        NextBlock blk
b  -> a -> m a
go (a -> m a) -> m a -> m a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< blk -> a -> m a
f blk
b a
a
        a -> Either e a
forall a b. b -> Either a b
Right (a -> Either e a) -> m a -> m (Either e a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> m a
go a
e

{-------------------------------------------------------------------------------
  Initialize the DB
-------------------------------------------------------------------------------}

-- | Initialization log
--
-- The initialization log records which snapshots from disk were considered,
-- in which order, and why some snapshots were rejected. It is primarily useful
-- for monitoring purposes.
data InitLog blk =
    -- | Defaulted to initialization from genesis
    --
    -- NOTE: Unless the blockchain is near genesis, we should see this /only/
    -- if data corrupted occurred.
    InitFromGenesis

    -- | Used a snapshot corresponding to the specified tip
  | InitFromSnapshot DiskSnapshot (Point blk)

    -- | Initialization skipped a snapshot
    --
    -- We record the reason why it was skipped.
    --
    -- NOTE: We should /only/ see this if data corrupted occurred.
  | InitFailure DiskSnapshot (InitFailure blk) (InitLog blk)
  deriving (Int -> InitLog blk -> ShowS
[InitLog blk] -> ShowS
InitLog blk -> String
(Int -> InitLog blk -> ShowS)
-> (InitLog blk -> String)
-> ([InitLog blk] -> ShowS)
-> Show (InitLog blk)
forall blk. StandardHash blk => Int -> InitLog blk -> ShowS
forall blk. StandardHash blk => [InitLog blk] -> ShowS
forall blk. StandardHash blk => InitLog blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitLog blk] -> ShowS
$cshowList :: forall blk. StandardHash blk => [InitLog blk] -> ShowS
show :: InitLog blk -> String
$cshow :: forall blk. StandardHash blk => InitLog blk -> String
showsPrec :: Int -> InitLog blk -> ShowS
$cshowsPrec :: forall blk. StandardHash blk => Int -> InitLog blk -> ShowS
Show, InitLog blk -> InitLog blk -> Bool
(InitLog blk -> InitLog blk -> Bool)
-> (InitLog blk -> InitLog blk -> Bool) -> Eq (InitLog blk)
forall blk. StandardHash blk => InitLog blk -> InitLog blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitLog blk -> InitLog blk -> Bool
$c/= :: forall blk. StandardHash blk => InitLog blk -> InitLog blk -> Bool
== :: InitLog blk -> InitLog blk -> Bool
$c== :: forall blk. StandardHash blk => InitLog blk -> InitLog blk -> Bool
Eq, (forall x. InitLog blk -> Rep (InitLog blk) x)
-> (forall x. Rep (InitLog blk) x -> InitLog blk)
-> Generic (InitLog blk)
forall x. Rep (InitLog blk) x -> InitLog blk
forall x. InitLog blk -> Rep (InitLog blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (InitLog blk) x -> InitLog blk
forall blk x. InitLog blk -> Rep (InitLog blk) x
$cto :: forall blk x. Rep (InitLog blk) x -> InitLog blk
$cfrom :: forall blk x. InitLog blk -> Rep (InitLog blk) x
Generic)

-- | Initialize the ledger DB from the most recent snapshot on disk
--
-- If no such snapshot can be found, use the genesis ledger DB. Returns the
-- initialized DB as well as the block reference corresponding to the snapshot
-- we found on disk (the latter primarily for testing/monitoring purposes).
--
-- We do /not/ catch any exceptions thrown during streaming; should any be
-- thrown, it is the responsibility of the 'ChainDB' to catch these
-- and trigger (further) validation. We only discard snapshots if
--
-- * We cannot deserialise them, or
-- * they are /ahead/ of the chain
--
-- It is possible that the Ledger DB will not be able to roll back @k@ blocks
-- after initialization if the chain has been truncated (data corruption).

-- We do /not/ attempt to use multiple ledger states from disk to construct the
-- ledger DB. Instead we load only a /single/ ledger state from disk, and
-- /compute/ all subsequent ones. This is important, because the ledger states
-- obtained in this way will (hopefully) share much of their memory footprint
-- with their predecessors.
initLedgerDB ::
     forall m blk. (
         IOLike m
       , LedgerSupportsProtocol blk
       , InspectLedger blk
       , HasCallStack
       )
  => Tracer m (TraceReplayEvent blk ())
  -> Tracer m (TraceEvent blk)
  -> SomeHasFS m
  -> (forall s. Decoder s (ExtLedgerState blk))
  -> (forall s. Decoder s (RealPoint blk))
  -> LedgerDbParams
  -> ExtLedgerCfg blk
  -> m (ExtLedgerState blk) -- ^ Genesis ledger state
  -> StreamAPI m blk
  -> m (InitLog blk, LedgerDB' blk, Word64)
initLedgerDB :: Tracer m (TraceReplayEvent blk ())
-> Tracer m (TraceEvent blk)
-> SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> LedgerDbParams
-> ExtLedgerCfg blk
-> m (ExtLedgerState blk)
-> StreamAPI m blk
-> m (InitLog blk, LedgerDB' blk, Word64)
initLedgerDB Tracer m (TraceReplayEvent blk ())
replayTracer
             Tracer m (TraceEvent blk)
tracer
             SomeHasFS m
hasFS
             forall s. Decoder s (ExtLedgerState blk)
decLedger
             forall s. Decoder s (RealPoint blk)
decRef
             LedgerDbParams
params
             ExtLedgerCfg blk
conf
             m (ExtLedgerState blk)
getGenesisLedger
             StreamAPI m blk
streamAPI = do
    [DiskSnapshot]
snapshots <- SomeHasFS m -> m [DiskSnapshot]
forall (m :: * -> *). Monad m => SomeHasFS m -> m [DiskSnapshot]
listSnapshots SomeHasFS m
hasFS
    (InitLog blk -> InitLog blk)
-> [DiskSnapshot] -> m (InitLog blk, LedgerDB' blk, Word64)
tryNewestFirst InitLog blk -> InitLog blk
forall a. a -> a
id [DiskSnapshot]
snapshots
  where
    tryNewestFirst :: (InitLog blk -> InitLog blk)
                   -> [DiskSnapshot]
                   -> m (InitLog blk, LedgerDB' blk, Word64)
    tryNewestFirst :: (InitLog blk -> InitLog blk)
-> [DiskSnapshot] -> m (InitLog blk, LedgerDB' blk, Word64)
tryNewestFirst InitLog blk -> InitLog blk
acc [] = do
        -- We're out of snapshots. Start at genesis
        Tracer m (TraceReplayEvent blk ())
-> TraceReplayEvent blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceReplayEvent blk ())
replayTracer (TraceReplayEvent blk () -> m ())
-> TraceReplayEvent blk () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> TraceReplayEvent blk ()
forall blk replayTo. replayTo -> TraceReplayEvent blk replayTo
ReplayFromGenesis ()
        LedgerDB' blk
initDb <- LedgerDbParams -> ExtLedgerState blk -> LedgerDB' blk
forall l r. LedgerDbParams -> l -> LedgerDB l r
ledgerDbFromGenesis LedgerDbParams
params (ExtLedgerState blk -> LedgerDB' blk)
-> m (ExtLedgerState blk) -> m (LedgerDB' blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ExtLedgerState blk)
getGenesisLedger
        Either (InitFailure blk) (LedgerDB' blk, Word64)
ml     <- ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
-> m (Either (InitFailure blk) (LedgerDB' blk, Word64))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
 -> m (Either (InitFailure blk) (LedgerDB' blk, Word64)))
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
-> m (Either (InitFailure blk) (LedgerDB' blk, Word64))
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceReplayEvent blk ())
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> LedgerDB' blk
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
forall (m :: * -> *) blk.
(Monad m, LedgerSupportsProtocol blk, InspectLedger blk,
 HasCallStack) =>
Tracer m (TraceReplayEvent blk ())
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> LedgerDB' blk
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
initStartingWith Tracer m (TraceReplayEvent blk ())
replayTracer ExtLedgerCfg blk
conf StreamAPI m blk
streamAPI LedgerDB' blk
initDb
        case Either (InitFailure blk) (LedgerDB' blk, Word64)
ml of
          Left InitFailure blk
_  -> String -> m (InitLog blk, LedgerDB' blk, Word64)
forall a. HasCallStack => String -> a
error String
"invariant violation: invalid current chain"
          Right (LedgerDB' blk
l, Word64
replayed) -> (InitLog blk, LedgerDB' blk, Word64)
-> m (InitLog blk, LedgerDB' blk, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (InitLog blk -> InitLog blk
acc InitLog blk
forall blk. InitLog blk
InitFromGenesis, LedgerDB' blk
l, Word64
replayed)
    tryNewestFirst InitLog blk -> InitLog blk
acc (DiskSnapshot
s:[DiskSnapshot]
ss) = do
        -- If we fail to use this snapshot, delete it and try an older one
        Either (InitFailure blk) (Point blk, LedgerDB' blk, Word64)
ml <- ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
-> m (Either (InitFailure blk) (Point blk, LedgerDB' blk, Word64))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
 -> m (Either (InitFailure blk) (Point blk, LedgerDB' blk, Word64)))
-> ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
-> m (Either (InitFailure blk) (Point blk, LedgerDB' blk, Word64))
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceReplayEvent blk ())
-> SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> LedgerDbParams
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> DiskSnapshot
-> ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsProtocol blk, InspectLedger blk,
 HasCallStack) =>
Tracer m (TraceReplayEvent blk ())
-> SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> LedgerDbParams
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> DiskSnapshot
-> ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
initFromSnapshot
                             Tracer m (TraceReplayEvent blk ())
replayTracer
                             SomeHasFS m
hasFS
                             forall s. Decoder s (ExtLedgerState blk)
decLedger
                             forall s. Decoder s (RealPoint blk)
decRef
                             LedgerDbParams
params
                             ExtLedgerCfg blk
conf
                             StreamAPI m blk
streamAPI
                             DiskSnapshot
s
        case Either (InitFailure blk) (Point blk, LedgerDB' blk, Word64)
ml of
          Left InitFailure blk
err -> do
            SomeHasFS m -> DiskSnapshot -> m ()
forall (m :: * -> *).
HasCallStack =>
SomeHasFS m -> DiskSnapshot -> m ()
deleteSnapshot SomeHasFS m
hasFS DiskSnapshot
s
            Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
tracer (TraceEvent blk -> m ()) -> TraceEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$ DiskSnapshot -> InitFailure blk -> TraceEvent blk
forall blk. DiskSnapshot -> InitFailure blk -> TraceEvent blk
InvalidSnapshot DiskSnapshot
s InitFailure blk
err
            (InitLog blk -> InitLog blk)
-> [DiskSnapshot] -> m (InitLog blk, LedgerDB' blk, Word64)
tryNewestFirst (InitLog blk -> InitLog blk
acc (InitLog blk -> InitLog blk)
-> (InitLog blk -> InitLog blk) -> InitLog blk -> InitLog blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiskSnapshot -> InitFailure blk -> InitLog blk -> InitLog blk
forall blk.
DiskSnapshot -> InitFailure blk -> InitLog blk -> InitLog blk
InitFailure DiskSnapshot
s InitFailure blk
err) [DiskSnapshot]
ss
          Right (Point blk
r, LedgerDB' blk
l, Word64
replayed) ->
            (InitLog blk, LedgerDB' blk, Word64)
-> m (InitLog blk, LedgerDB' blk, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (InitLog blk -> InitLog blk
acc (DiskSnapshot -> Point blk -> InitLog blk
forall blk. DiskSnapshot -> Point blk -> InitLog blk
InitFromSnapshot DiskSnapshot
s Point blk
r), LedgerDB' blk
l, Word64
replayed)

{-------------------------------------------------------------------------------
  Internal: initialize using the given snapshot
-------------------------------------------------------------------------------}

data InitFailure blk =
    -- | We failed to deserialise the snapshot
    --
    -- This can happen due to data corruption in the ledger DB.
    InitFailureRead ReadIncrementalErr

    -- | This snapshot is too recent (ahead of the tip of the chain)
  | InitFailureTooRecent (Point blk)
  deriving (Int -> InitFailure blk -> ShowS
[InitFailure blk] -> ShowS
InitFailure blk -> String
(Int -> InitFailure blk -> ShowS)
-> (InitFailure blk -> String)
-> ([InitFailure blk] -> ShowS)
-> Show (InitFailure blk)
forall blk. StandardHash blk => Int -> InitFailure blk -> ShowS
forall blk. StandardHash blk => [InitFailure blk] -> ShowS
forall blk. StandardHash blk => InitFailure blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InitFailure blk] -> ShowS
$cshowList :: forall blk. StandardHash blk => [InitFailure blk] -> ShowS
show :: InitFailure blk -> String
$cshow :: forall blk. StandardHash blk => InitFailure blk -> String
showsPrec :: Int -> InitFailure blk -> ShowS
$cshowsPrec :: forall blk. StandardHash blk => Int -> InitFailure blk -> ShowS
Show, InitFailure blk -> InitFailure blk -> Bool
(InitFailure blk -> InitFailure blk -> Bool)
-> (InitFailure blk -> InitFailure blk -> Bool)
-> Eq (InitFailure blk)
forall blk.
StandardHash blk =>
InitFailure blk -> InitFailure blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InitFailure blk -> InitFailure blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
InitFailure blk -> InitFailure blk -> Bool
== :: InitFailure blk -> InitFailure blk -> Bool
$c== :: forall blk.
StandardHash blk =>
InitFailure blk -> InitFailure blk -> Bool
Eq, (forall x. InitFailure blk -> Rep (InitFailure blk) x)
-> (forall x. Rep (InitFailure blk) x -> InitFailure blk)
-> Generic (InitFailure blk)
forall x. Rep (InitFailure blk) x -> InitFailure blk
forall x. InitFailure blk -> Rep (InitFailure blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (InitFailure blk) x -> InitFailure blk
forall blk x. InitFailure blk -> Rep (InitFailure blk) x
$cto :: forall blk x. Rep (InitFailure blk) x -> InitFailure blk
$cfrom :: forall blk x. InitFailure blk -> Rep (InitFailure blk) x
Generic)

-- | Attempt to initialize the ledger DB from the given snapshot
--
-- If the chain DB or ledger layer reports an error, the whole thing is aborted
-- and an error is returned. This should not throw any errors itself (ignoring
-- unexpected exceptions such as asynchronous exceptions, of course).
initFromSnapshot ::
     forall m blk. (
         IOLike m
       , LedgerSupportsProtocol blk
       , InspectLedger blk
       , HasCallStack
       )
  => Tracer m (TraceReplayEvent blk ())
  -> SomeHasFS m
  -> (forall s. Decoder s (ExtLedgerState blk))
  -> (forall s. Decoder s (RealPoint blk))
  -> LedgerDbParams
  -> ExtLedgerCfg blk
  -> StreamAPI m blk
  -> DiskSnapshot
  -> ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
initFromSnapshot :: Tracer m (TraceReplayEvent blk ())
-> SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> LedgerDbParams
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> DiskSnapshot
-> ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
initFromSnapshot Tracer m (TraceReplayEvent blk ())
tracer SomeHasFS m
hasFS forall s. Decoder s (ExtLedgerState blk)
decLedger forall s. Decoder s (RealPoint blk)
decRef LedgerDbParams
params ExtLedgerCfg blk
conf StreamAPI m blk
streamAPI DiskSnapshot
ss = do
    ChainSummary' blk
initSS <- (ReadIncrementalErr -> InitFailure blk)
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
-> ExceptT (InitFailure blk) m (ChainSummary' blk)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ReadIncrementalErr -> InitFailure blk
forall blk. ReadIncrementalErr -> InitFailure blk
InitFailureRead (ExceptT ReadIncrementalErr m (ChainSummary' blk)
 -> ExceptT (InitFailure blk) m (ChainSummary' blk))
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
-> ExceptT (InitFailure blk) m (ChainSummary' blk)
forall a b. (a -> b) -> a -> b
$
                SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> DiskSnapshot
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
forall (m :: * -> *) blk.
IOLike m =>
SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> DiskSnapshot
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
readSnapshot SomeHasFS m
hasFS forall s. Decoder s (ExtLedgerState blk)
decLedger forall s. Decoder s (RealPoint blk)
decRef DiskSnapshot
ss
    m () -> ExceptT (InitFailure blk) m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ExceptT (InitFailure blk) m ())
-> m () -> ExceptT (InitFailure blk) m ()
forall a b. (a -> b) -> a -> b
$ Tracer m (TraceReplayEvent blk ())
-> TraceReplayEvent blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceReplayEvent blk ())
tracer (TraceReplayEvent blk () -> m ())
-> TraceReplayEvent blk () -> m ()
forall a b. (a -> b) -> a -> b
$ DiskSnapshot -> Point blk -> () -> TraceReplayEvent blk ()
forall blk replayTo.
DiskSnapshot
-> Point blk -> replayTo -> TraceReplayEvent blk replayTo
ReplayFromSnapshot DiskSnapshot
ss (ChainSummary' blk -> Point blk
forall blk. ChainSummary' blk -> Point blk
csTip' ChainSummary' blk
initSS) ()
    (LedgerDB' blk
initDB, Word64
replayed) <- Tracer m (TraceReplayEvent blk ())
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> LedgerDB' blk
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
forall (m :: * -> *) blk.
(Monad m, LedgerSupportsProtocol blk, InspectLedger blk,
 HasCallStack) =>
Tracer m (TraceReplayEvent blk ())
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> LedgerDB' blk
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
initStartingWith Tracer m (TraceReplayEvent blk ())
tracer ExtLedgerCfg blk
conf StreamAPI m blk
streamAPI (LedgerDbParams -> ChainSummary' blk -> LedgerDB' blk
forall l r. LedgerDbParams -> ChainSummary l r -> LedgerDB l r
ledgerDbWithAnchor LedgerDbParams
params ChainSummary' blk
initSS)
    (Point blk, LedgerDB' blk, Word64)
-> ExceptT (InitFailure blk) m (Point blk, LedgerDB' blk, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (ChainSummary' blk -> Point blk
forall blk. ChainSummary' blk -> Point blk
csTip' ChainSummary' blk
initSS, LedgerDB' blk
initDB, Word64
replayed)

-- | Attempt to initialize the ledger DB starting from the given ledger DB
initStartingWith ::
     forall m blk. (
         Monad m
       , LedgerSupportsProtocol blk
       , InspectLedger blk
       , HasCallStack
       )
  => Tracer m (TraceReplayEvent blk ())
  -> ExtLedgerCfg blk
  -> StreamAPI m blk
  -> LedgerDB' blk
  -> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
initStartingWith :: Tracer m (TraceReplayEvent blk ())
-> ExtLedgerCfg blk
-> StreamAPI m blk
-> LedgerDB' blk
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
initStartingWith Tracer m (TraceReplayEvent blk ())
tracer ExtLedgerCfg blk
conf StreamAPI m blk
streamAPI LedgerDB' blk
initDb = do
    StreamAPI m blk
-> Point blk
-> (Point blk -> InitFailure blk)
-> (LedgerDB' blk, Word64)
-> (blk -> (LedgerDB' blk, Word64) -> m (LedgerDB' blk, Word64))
-> ExceptT (InitFailure blk) m (LedgerDB' blk, Word64)
forall (m :: * -> *) blk e a.
(Monad m, HasCallStack) =>
StreamAPI m blk
-> Point blk
-> (Point blk -> e)
-> a
-> (blk -> a -> m a)
-> ExceptT e m a
streamAll StreamAPI m blk
streamAPI (LedgerDB' blk -> Point blk
forall blk. LedgerDB' blk -> Point blk
ledgerDbTip' LedgerDB' blk
initDb)
      Point blk -> InitFailure blk
forall blk. Point blk -> InitFailure blk
InitFailureTooRecent
      (LedgerDB' blk
initDb, Word64
0)
      blk -> (LedgerDB' blk, Word64) -> m (LedgerDB' blk, Word64)
push
  where
    push :: blk -> (LedgerDB' blk, Word64) -> m (LedgerDB' blk, Word64)
    push :: blk -> (LedgerDB' blk, Word64) -> m (LedgerDB' blk, Word64)
push blk
blk !(!LedgerDB' blk
db, !Word64
replayed) = do
        !LedgerDB' blk
db' <- LedgerCfg (ExtLedgerState blk)
-> Ap m (ExtLedgerState blk) (RealPoint blk) blk (() :: Constraint)
-> LedgerDB' blk
-> m (LedgerDB' blk)
forall (m :: * -> *) (c :: Constraint) l r b.
(ApplyBlock l b, Monad m, c) =>
LedgerCfg l -> Ap m l r b c -> LedgerDB l r -> m (LedgerDB l r)
ledgerDbPush LedgerCfg (ExtLedgerState blk)
ExtLedgerCfg blk
conf (RealPoint blk
-> blk
-> Ap m (ExtLedgerState blk) (RealPoint blk) blk (() :: Constraint)
forall r b (m :: * -> *) l. r -> b -> Ap m l r b (() :: Constraint)
ReapplyVal (blk -> RealPoint blk
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint blk
blk) blk
blk) LedgerDB' blk
db

        let replayed' :: Word64
            !replayed' :: Word64
replayed' = Word64
replayed Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1

            events :: [LedgerEvent blk]
            events :: [LedgerEvent blk]
events = TopLevelConfig blk
-> LedgerState blk -> LedgerState blk -> [LedgerEvent blk]
forall blk.
InspectLedger blk =>
TopLevelConfig blk
-> LedgerState blk -> LedgerState blk -> [LedgerEvent blk]
inspectLedger
                       (ExtLedgerCfg blk -> TopLevelConfig blk
forall blk. ExtLedgerCfg blk -> TopLevelConfig blk
getExtLedgerCfg ExtLedgerCfg blk
conf)
                       (ExtLedgerState blk -> LedgerState blk
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState (LedgerDB' blk -> ExtLedgerState blk
forall l r. LedgerDB l r -> l
ledgerDbCurrent LedgerDB' blk
db))
                       (ExtLedgerState blk -> LedgerState blk
forall blk. ExtLedgerState blk -> LedgerState blk
ledgerState (LedgerDB' blk -> ExtLedgerState blk
forall l r. LedgerDB l r -> l
ledgerDbCurrent LedgerDB' blk
db'))

        Tracer m (TraceReplayEvent blk ())
-> TraceReplayEvent blk () -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceReplayEvent blk ())
tracer (RealPoint blk -> [LedgerEvent blk] -> () -> TraceReplayEvent blk ()
forall blk replayTo.
RealPoint blk
-> [LedgerEvent blk] -> replayTo -> TraceReplayEvent blk replayTo
ReplayedBlock (blk -> RealPoint blk
forall blk. HasHeader blk => blk -> RealPoint blk
blockRealPoint blk
blk) [LedgerEvent blk]
events ())
        (LedgerDB' blk, Word64) -> m (LedgerDB' blk, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerDB' blk
db', Word64
replayed')

{-------------------------------------------------------------------------------
  Write to disk
-------------------------------------------------------------------------------}

-- | Take a snapshot of the /oldest ledger state/ in the ledger DB
--
-- We write the /oldest/ ledger state to disk because the intention is to only
-- write ledger states to disk that we know to be immutable. Primarily for
-- testing purposes, 'takeSnapshot' returns the block reference corresponding
-- to the snapshot that we wrote.
--
-- NOTE: This is a lower-level API that unconditionally takes a snapshot
-- (i.e., independent from whether this snapshot corresponds to a state that
-- is more than @k@ back).
--
-- TODO: Should we delete the file if an error occurs during writing?
takeSnapshot ::
     forall m blk. MonadThrow m
  => Tracer m (TraceEvent blk)
  -> SomeHasFS m
  -> (ExtLedgerState blk -> Encoding)
  -> (RealPoint blk -> Encoding)
  -> LedgerDB' blk -> m (DiskSnapshot, Point blk)
takeSnapshot :: Tracer m (TraceEvent blk)
-> SomeHasFS m
-> (ExtLedgerState blk -> Encoding)
-> (RealPoint blk -> Encoding)
-> LedgerDB' blk
-> m (DiskSnapshot, Point blk)
takeSnapshot Tracer m (TraceEvent blk)
tracer SomeHasFS m
hasFS ExtLedgerState blk -> Encoding
encLedger RealPoint blk -> Encoding
encRef LedgerDB' blk
db = do
    DiskSnapshot
ss <- [DiskSnapshot] -> DiskSnapshot
nextAvailable ([DiskSnapshot] -> DiskSnapshot)
-> m [DiskSnapshot] -> m DiskSnapshot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SomeHasFS m -> m [DiskSnapshot]
forall (m :: * -> *). Monad m => SomeHasFS m -> m [DiskSnapshot]
listSnapshots SomeHasFS m
hasFS
    SomeHasFS m
-> (ExtLedgerState blk -> Encoding)
-> (RealPoint blk -> Encoding)
-> DiskSnapshot
-> ChainSummary (ExtLedgerState blk) (RealPoint blk)
-> m ()
forall (m :: * -> *) l r.
MonadThrow m =>
SomeHasFS m
-> (l -> Encoding)
-> (r -> Encoding)
-> DiskSnapshot
-> ChainSummary l r
-> m ()
writeSnapshot SomeHasFS m
hasFS ExtLedgerState blk -> Encoding
encLedger RealPoint blk -> Encoding
encRef DiskSnapshot
ss ChainSummary (ExtLedgerState blk) (RealPoint blk)
oldest
    Tracer m (TraceEvent blk) -> TraceEvent blk -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent blk)
tracer (TraceEvent blk -> m ()) -> TraceEvent blk -> m ()
forall a b. (a -> b) -> a -> b
$ DiskSnapshot -> Point blk -> TraceEvent blk
forall blk. DiskSnapshot -> Point blk -> TraceEvent blk
TookSnapshot DiskSnapshot
ss (ChainSummary (ExtLedgerState blk) (RealPoint blk) -> Point blk
forall blk. ChainSummary' blk -> Point blk
csTip' ChainSummary (ExtLedgerState blk) (RealPoint blk)
oldest)
    (DiskSnapshot, Point blk) -> m (DiskSnapshot, Point blk)
forall (m :: * -> *) a. Monad m => a -> m a
return (DiskSnapshot
ss, ChainSummary (ExtLedgerState blk) (RealPoint blk) -> Point blk
forall blk. ChainSummary' blk -> Point blk
csTip' ChainSummary (ExtLedgerState blk) (RealPoint blk)
oldest)
  where
    oldest :: ChainSummary' blk
    oldest :: ChainSummary (ExtLedgerState blk) (RealPoint blk)
oldest = LedgerDB' blk -> ChainSummary (ExtLedgerState blk) (RealPoint blk)
forall l r. LedgerDB l r -> ChainSummary l r
ledgerDbAnchor LedgerDB' blk
db

-- | Trim the number of on disk snapshots so that at most 'onDiskNumSnapshots'
-- snapshots are stored on disk. The oldest snapshots are deleted.
--
-- The deleted snapshots are returned.
trimSnapshots ::
     Monad m
  => Tracer m (TraceEvent r)
  -> SomeHasFS m
  -> DiskPolicy
  -> m [DiskSnapshot]
trimSnapshots :: Tracer m (TraceEvent r)
-> SomeHasFS m -> DiskPolicy -> m [DiskSnapshot]
trimSnapshots Tracer m (TraceEvent r)
tracer SomeHasFS m
hasFS DiskPolicy{Word
Maybe DiffTime -> Word64 -> Bool
onDiskShouldTakeSnapshot :: DiskPolicy -> Maybe DiffTime -> Word64 -> Bool
onDiskNumSnapshots :: DiskPolicy -> Word
onDiskShouldTakeSnapshot :: Maybe DiffTime -> Word64 -> Bool
onDiskNumSnapshots :: Word
..} = do
    [DiskSnapshot]
snapshots <- SomeHasFS m -> m [DiskSnapshot]
forall (m :: * -> *). Monad m => SomeHasFS m -> m [DiskSnapshot]
listSnapshots SomeHasFS m
hasFS
    -- The snapshot are most recent first, so we can simply drop from the
    -- front to get the snapshots that are "too" old.
    [DiskSnapshot]
-> (DiskSnapshot -> m DiskSnapshot) -> m [DiskSnapshot]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (Int -> [DiskSnapshot] -> [DiskSnapshot]
forall a. Int -> [a] -> [a]
drop (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
onDiskNumSnapshots) [DiskSnapshot]
snapshots) ((DiskSnapshot -> m DiskSnapshot) -> m [DiskSnapshot])
-> (DiskSnapshot -> m DiskSnapshot) -> m [DiskSnapshot]
forall a b. (a -> b) -> a -> b
$ \DiskSnapshot
snapshot -> do
      SomeHasFS m -> DiskSnapshot -> m ()
forall (m :: * -> *).
HasCallStack =>
SomeHasFS m -> DiskSnapshot -> m ()
deleteSnapshot SomeHasFS m
hasFS DiskSnapshot
snapshot
      Tracer m (TraceEvent r) -> TraceEvent r -> m ()
forall (m :: * -> *) a. Tracer m a -> a -> m ()
traceWith Tracer m (TraceEvent r)
tracer (TraceEvent r -> m ()) -> TraceEvent r -> m ()
forall a b. (a -> b) -> a -> b
$ DiskSnapshot -> TraceEvent r
forall blk. DiskSnapshot -> TraceEvent blk
DeletedSnapshot DiskSnapshot
snapshot
      DiskSnapshot -> m DiskSnapshot
forall (m :: * -> *) a. Monad m => a -> m a
return DiskSnapshot
snapshot

{-------------------------------------------------------------------------------
  Internal: reading from disk
-------------------------------------------------------------------------------}

-- | On disk snapshots are numbered monotonically
newtype DiskSnapshot = DiskSnapshot Int
  deriving (Int -> DiskSnapshot -> ShowS
[DiskSnapshot] -> ShowS
DiskSnapshot -> String
(Int -> DiskSnapshot -> ShowS)
-> (DiskSnapshot -> String)
-> ([DiskSnapshot] -> ShowS)
-> Show DiskSnapshot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiskSnapshot] -> ShowS
$cshowList :: [DiskSnapshot] -> ShowS
show :: DiskSnapshot -> String
$cshow :: DiskSnapshot -> String
showsPrec :: Int -> DiskSnapshot -> ShowS
$cshowsPrec :: Int -> DiskSnapshot -> ShowS
Show, DiskSnapshot -> DiskSnapshot -> Bool
(DiskSnapshot -> DiskSnapshot -> Bool)
-> (DiskSnapshot -> DiskSnapshot -> Bool) -> Eq DiskSnapshot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiskSnapshot -> DiskSnapshot -> Bool
$c/= :: DiskSnapshot -> DiskSnapshot -> Bool
== :: DiskSnapshot -> DiskSnapshot -> Bool
$c== :: DiskSnapshot -> DiskSnapshot -> Bool
Eq, Eq DiskSnapshot
Eq DiskSnapshot
-> (DiskSnapshot -> DiskSnapshot -> Ordering)
-> (DiskSnapshot -> DiskSnapshot -> Bool)
-> (DiskSnapshot -> DiskSnapshot -> Bool)
-> (DiskSnapshot -> DiskSnapshot -> Bool)
-> (DiskSnapshot -> DiskSnapshot -> Bool)
-> (DiskSnapshot -> DiskSnapshot -> DiskSnapshot)
-> (DiskSnapshot -> DiskSnapshot -> DiskSnapshot)
-> Ord DiskSnapshot
DiskSnapshot -> DiskSnapshot -> Bool
DiskSnapshot -> DiskSnapshot -> Ordering
DiskSnapshot -> DiskSnapshot -> DiskSnapshot
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DiskSnapshot -> DiskSnapshot -> DiskSnapshot
$cmin :: DiskSnapshot -> DiskSnapshot -> DiskSnapshot
max :: DiskSnapshot -> DiskSnapshot -> DiskSnapshot
$cmax :: DiskSnapshot -> DiskSnapshot -> DiskSnapshot
>= :: DiskSnapshot -> DiskSnapshot -> Bool
$c>= :: DiskSnapshot -> DiskSnapshot -> Bool
> :: DiskSnapshot -> DiskSnapshot -> Bool
$c> :: DiskSnapshot -> DiskSnapshot -> Bool
<= :: DiskSnapshot -> DiskSnapshot -> Bool
$c<= :: DiskSnapshot -> DiskSnapshot -> Bool
< :: DiskSnapshot -> DiskSnapshot -> Bool
$c< :: DiskSnapshot -> DiskSnapshot -> Bool
compare :: DiskSnapshot -> DiskSnapshot -> Ordering
$ccompare :: DiskSnapshot -> DiskSnapshot -> Ordering
$cp1Ord :: Eq DiskSnapshot
Ord, (forall x. DiskSnapshot -> Rep DiskSnapshot x)
-> (forall x. Rep DiskSnapshot x -> DiskSnapshot)
-> Generic DiskSnapshot
forall x. Rep DiskSnapshot x -> DiskSnapshot
forall x. DiskSnapshot -> Rep DiskSnapshot x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DiskSnapshot x -> DiskSnapshot
$cfrom :: forall x. DiskSnapshot -> Rep DiskSnapshot x
Generic)

-- | Number of the next snapshot, given snapshots currently on disk
nextAvailable :: [DiskSnapshot] -> DiskSnapshot
nextAvailable :: [DiskSnapshot] -> DiskSnapshot
nextAvailable [] = Int -> DiskSnapshot
DiskSnapshot Int
1
nextAvailable [DiskSnapshot]
ss = let DiskSnapshot Int
n = [DiskSnapshot] -> DiskSnapshot
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [DiskSnapshot]
ss in Int -> DiskSnapshot
DiskSnapshot (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

-- | Read snapshot from disk
readSnapshot ::
     forall m blk. IOLike m
  => SomeHasFS m
  -> (forall s. Decoder s (ExtLedgerState blk))
  -> (forall s. Decoder s (RealPoint blk))
  -> DiskSnapshot
  -> ExceptT ReadIncrementalErr m (ChainSummary' blk)
readSnapshot :: SomeHasFS m
-> (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> DiskSnapshot
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
readSnapshot SomeHasFS m
hasFS forall s. Decoder s (ExtLedgerState blk)
decLedger forall s. Decoder s (RealPoint blk)
decRef =
      m (Either ReadIncrementalErr (ChainSummary' blk))
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT
    (m (Either ReadIncrementalErr (ChainSummary' blk))
 -> ExceptT ReadIncrementalErr m (ChainSummary' blk))
-> (DiskSnapshot
    -> m (Either ReadIncrementalErr (ChainSummary' blk)))
-> DiskSnapshot
-> ExceptT ReadIncrementalErr m (ChainSummary' blk)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeHasFS m
-> (forall s. Decoder s (ChainSummary' blk))
-> FsPath
-> m (Either ReadIncrementalErr (ChainSummary' blk))
forall (m :: * -> *) a.
IOLike m =>
SomeHasFS m
-> (forall s. Decoder s a)
-> FsPath
-> m (Either ReadIncrementalErr a)
readIncremental SomeHasFS m
hasFS forall s. Decoder s (ChainSummary' blk)
decoder
    (FsPath -> m (Either ReadIncrementalErr (ChainSummary' blk)))
-> (DiskSnapshot -> FsPath)
-> DiskSnapshot
-> m (Either ReadIncrementalErr (ChainSummary' blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiskSnapshot -> FsPath
snapshotToPath
  where
    decoder :: Decoder s (ChainSummary' blk)
    decoder :: Decoder s (ChainSummary' blk)
decoder = (forall s. Decoder s (ExtLedgerState blk))
-> (forall s. Decoder s (RealPoint blk))
-> forall s. Decoder s (ChainSummary' blk)
forall l r.
(forall s. Decoder s l)
-> (forall s. Decoder s r)
-> forall s. Decoder s (ChainSummary l r)
decodeChainSummary forall s. Decoder s (ExtLedgerState blk)
decLedger forall s. Decoder s (RealPoint blk)
decRef

-- | Write snapshot to disk
writeSnapshot ::
     forall m l r. MonadThrow m
  => SomeHasFS m
  -> (l -> Encoding)
  -> (r -> Encoding)
  -> DiskSnapshot -> ChainSummary l r -> m ()
writeSnapshot :: SomeHasFS m
-> (l -> Encoding)
-> (r -> Encoding)
-> DiskSnapshot
-> ChainSummary l r
-> m ()
writeSnapshot (SomeHasFS HasFS m h
hasFS) l -> Encoding
encLedger r -> Encoding
encRef DiskSnapshot
ss ChainSummary l r
cs = do
    HasFS m h -> FsPath -> OpenMode -> (Handle h -> m ()) -> m ()
forall (m :: * -> *) h a.
(HasCallStack, MonadThrow m) =>
HasFS m h -> FsPath -> OpenMode -> (Handle h -> m a) -> m a
withFile HasFS m h
hasFS (DiskSnapshot -> FsPath
snapshotToPath DiskSnapshot
ss) (AllowExisting -> OpenMode
WriteMode AllowExisting
MustBeNew) ((Handle h -> m ()) -> m ()) -> (Handle h -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Handle h
h ->
      m Word64 -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Word64 -> m ()) -> m Word64 -> m ()
forall a b. (a -> b) -> a -> b
$ HasFS m h -> Handle h -> Builder -> m Word64
forall (m :: * -> *) h.
(HasCallStack, Monad m) =>
HasFS m h -> Handle h -> Builder -> m Word64
hPut HasFS m h
hasFS Handle h
h (Builder -> m Word64) -> Builder -> m Word64
forall a b. (a -> b) -> a -> b
$ Encoding -> Builder
CBOR.toBuilder (ChainSummary l r -> Encoding
encode ChainSummary l r
cs)
  where
    encode :: ChainSummary l r -> Encoding
    encode :: ChainSummary l r -> Encoding
encode = (l -> Encoding) -> (r -> Encoding) -> ChainSummary l r -> Encoding
forall l r.
(l -> Encoding) -> (r -> Encoding) -> ChainSummary l r -> Encoding
encodeChainSummary l -> Encoding
encLedger r -> Encoding
encRef

-- | Delete snapshot from disk
deleteSnapshot :: HasCallStack => SomeHasFS m -> DiskSnapshot -> m ()
deleteSnapshot :: SomeHasFS m -> DiskSnapshot -> m ()
deleteSnapshot (SomeHasFS HasFS{m String
HasCallStack => Bool -> FsPath -> m ()
HasCallStack => Handle h -> m Bool
HasCallStack => Handle h -> m Word64
HasCallStack => Handle h -> m ()
HasCallStack => Handle h -> Word64 -> m ()
HasCallStack => Handle h -> Word64 -> m ByteString
HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
HasCallStack => Handle h -> ByteString -> m Word64
HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
HasCallStack => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
doesFileExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
listDirectory :: HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectory :: HasCallStack => FsPath -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hClose :: HasCallStack => Handle h -> m ()
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
..}) = HasCallStack => FsPath -> m ()
FsPath -> m ()
removeFile (FsPath -> m ())
-> (DiskSnapshot -> FsPath) -> DiskSnapshot -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiskSnapshot -> FsPath
snapshotToPath

-- | List on-disk snapshots, most recent first
listSnapshots :: Monad m => SomeHasFS m -> m [DiskSnapshot]
listSnapshots :: SomeHasFS m -> m [DiskSnapshot]
listSnapshots (SomeHasFS HasFS{m String
HasCallStack => Bool -> FsPath -> m ()
HasCallStack => Handle h -> m Bool
HasCallStack => Handle h -> m Word64
HasCallStack => Handle h -> m ()
HasCallStack => Handle h -> Word64 -> m ()
HasCallStack => Handle h -> Word64 -> m ByteString
HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
HasCallStack => Handle h -> ByteString -> m Word64
HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
HasCallStack => FsPath -> m Bool
HasCallStack => FsPath -> m ()
HasCallStack => FsPath -> m (Set String)
HasCallStack => FsPath -> FsPath -> m ()
HasCallStack => FsPath -> OpenMode -> m (Handle h)
FsPath -> FsErrorPath
mkFsErrorPath :: FsPath -> FsErrorPath
renameFile :: HasCallStack => FsPath -> FsPath -> m ()
removeFile :: HasCallStack => FsPath -> m ()
doesFileExist :: HasCallStack => FsPath -> m Bool
doesDirectoryExist :: HasCallStack => FsPath -> m Bool
listDirectory :: HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: HasCallStack => Bool -> FsPath -> m ()
createDirectory :: HasCallStack => FsPath -> m ()
hGetSize :: HasCallStack => Handle h -> m Word64
hTruncate :: HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: HasCallStack => Handle h -> m Bool
hClose :: HasCallStack => Handle h -> m ()
hOpen :: HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: m String
mkFsErrorPath :: forall (m :: * -> *) h. HasFS m h -> FsPath -> FsErrorPath
renameFile :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> FsPath -> m ()
removeFile :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
doesFileExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
doesDirectoryExist :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m Bool
listDirectory :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> m (Set String)
createDirectoryIfMissing :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Bool -> FsPath -> m ()
createDirectory :: forall (m :: * -> *) h. HasFS m h -> HasCallStack => FsPath -> m ()
hGetSize :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Word64
hTruncate :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ()
hPutSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> ByteString -> m Word64
hGetSomeAt :: forall (m :: * -> *) h.
HasFS m h
-> HasCallStack => Handle h -> Word64 -> AbsOffset -> m ByteString
hGetSome :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> Word64 -> m ByteString
hSeek :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> SeekMode -> Int64 -> m ()
hIsOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m Bool
hClose :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => Handle h -> m ()
hOpen :: forall (m :: * -> *) h.
HasFS m h -> HasCallStack => FsPath -> OpenMode -> m (Handle h)
dumpState :: forall (m :: * -> *) h. HasFS m h -> m String
..}) =
    Set String -> [DiskSnapshot]
aux (Set String -> [DiskSnapshot])
-> m (Set String) -> m [DiskSnapshot]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => FsPath -> m (Set String)
FsPath -> m (Set String)
listDirectory ([String] -> FsPath
mkFsPath [])
  where
    aux :: Set String -> [DiskSnapshot]
    aux :: Set String -> [DiskSnapshot]
aux = (DiskSnapshot -> DiskSnapshot -> Ordering)
-> [DiskSnapshot] -> [DiskSnapshot]
forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy ((DiskSnapshot -> DiskSnapshot -> Ordering)
-> DiskSnapshot -> DiskSnapshot -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip DiskSnapshot -> DiskSnapshot -> Ordering
forall a. Ord a => a -> a -> Ordering
compare) ([DiskSnapshot] -> [DiskSnapshot])
-> (Set String -> [DiskSnapshot]) -> Set String -> [DiskSnapshot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> Maybe DiskSnapshot) -> [String] -> [DiskSnapshot]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe DiskSnapshot
snapshotFromPath ([String] -> [DiskSnapshot])
-> (Set String -> [String]) -> Set String -> [DiskSnapshot]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set String -> [String]
forall a. Set a -> [a]
Set.toList

snapshotToPath :: DiskSnapshot -> FsPath
snapshotToPath :: DiskSnapshot -> FsPath
snapshotToPath (DiskSnapshot Int
ss) = [String] -> FsPath
mkFsPath [Int -> String
forall a. Show a => a -> String
show Int
ss]

snapshotFromPath :: String -> Maybe DiskSnapshot
snapshotFromPath :: String -> Maybe DiskSnapshot
snapshotFromPath = (Int -> DiskSnapshot) -> Maybe Int -> Maybe DiskSnapshot
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> DiskSnapshot
DiskSnapshot (Maybe Int -> Maybe DiskSnapshot)
-> (String -> Maybe Int) -> String -> Maybe DiskSnapshot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe

{-------------------------------------------------------------------------------
  Trace events
-------------------------------------------------------------------------------}

data TraceEvent blk
  = InvalidSnapshot DiskSnapshot (InitFailure blk)
    -- ^ An on disk snapshot was skipped because it was invalid.
  | TookSnapshot DiskSnapshot (Point blk)
    -- ^ A snapshot was written to disk.
  | DeletedSnapshot DiskSnapshot
    -- ^ An old or invalid on-disk snapshot was deleted
  deriving ((forall x. TraceEvent blk -> Rep (TraceEvent blk) x)
-> (forall x. Rep (TraceEvent blk) x -> TraceEvent blk)
-> Generic (TraceEvent blk)
forall x. Rep (TraceEvent blk) x -> TraceEvent blk
forall x. TraceEvent blk -> Rep (TraceEvent blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (TraceEvent blk) x -> TraceEvent blk
forall blk x. TraceEvent blk -> Rep (TraceEvent blk) x
$cto :: forall blk x. Rep (TraceEvent blk) x -> TraceEvent blk
$cfrom :: forall blk x. TraceEvent blk -> Rep (TraceEvent blk) x
Generic, TraceEvent blk -> TraceEvent blk -> Bool
(TraceEvent blk -> TraceEvent blk -> Bool)
-> (TraceEvent blk -> TraceEvent blk -> Bool)
-> Eq (TraceEvent blk)
forall blk.
StandardHash blk =>
TraceEvent blk -> TraceEvent blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TraceEvent blk -> TraceEvent blk -> Bool
$c/= :: forall blk.
StandardHash blk =>
TraceEvent blk -> TraceEvent blk -> Bool
== :: TraceEvent blk -> TraceEvent blk -> Bool
$c== :: forall blk.
StandardHash blk =>
TraceEvent blk -> TraceEvent blk -> Bool
Eq, Int -> TraceEvent blk -> ShowS
[TraceEvent blk] -> ShowS
TraceEvent blk -> String
(Int -> TraceEvent blk -> ShowS)
-> (TraceEvent blk -> String)
-> ([TraceEvent blk] -> ShowS)
-> Show (TraceEvent blk)
forall blk. StandardHash blk => Int -> TraceEvent blk -> ShowS
forall blk. StandardHash blk => [TraceEvent blk] -> ShowS
forall blk. StandardHash blk => TraceEvent blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TraceEvent blk] -> ShowS
$cshowList :: forall blk. StandardHash blk => [TraceEvent blk] -> ShowS
show :: TraceEvent blk -> String
$cshow :: forall blk. StandardHash blk => TraceEvent blk -> String
showsPrec :: Int -> TraceEvent blk -> ShowS
$cshowsPrec :: forall blk. StandardHash blk => Int -> TraceEvent blk -> ShowS
Show)

-- | Events traced while replaying blocks against the ledger to bring it up to
-- date w.r.t. the tip of the ImmutableDB during initialisation. As this
-- process takes a while, we trace events to inform higher layers of our
-- progress.
--
-- The @replayTo@ parameter is meant to be filled in by a higher layer,
-- i.e., the ChainDB.
data TraceReplayEvent blk replayTo
  = ReplayFromGenesis replayTo
    -- ^ There were no LedgerDB snapshots on disk, so we're replaying all
    -- blocks starting from Genesis against the initial ledger.
    --
    -- The @replayTo@ parameter corresponds to the block at the tip of the
    -- ImmutableDB, i.e., the last block to replay.
  | ReplayFromSnapshot DiskSnapshot (Point blk) replayTo
    -- ^ There was a LedgerDB snapshot on disk corresponding to the given tip.
    -- We're replaying more recent blocks against it.
    --
    -- The @replayTo@ parameter corresponds to the block at the tip of the
    -- ImmutableDB, i.e., the last block to replay.
  | ReplayedBlock (RealPoint blk) [LedgerEvent blk] replayTo
    -- ^ We replayed the given block (reference) on the genesis snapshot
    -- during the initialisation of the LedgerDB.
    --
    -- The @blockInfo@ parameter corresponds replayed block and the @replayTo@
    -- parameter corresponds to the block at the tip of the ImmutableDB, i.e.,
    -- the last block to replay.
  deriving ((forall x.
 TraceReplayEvent blk replayTo
 -> Rep (TraceReplayEvent blk replayTo) x)
-> (forall x.
    Rep (TraceReplayEvent blk replayTo) x
    -> TraceReplayEvent blk replayTo)
-> Generic (TraceReplayEvent blk replayTo)
forall x.
Rep (TraceReplayEvent blk replayTo) x
-> TraceReplayEvent blk replayTo
forall x.
TraceReplayEvent blk replayTo
-> Rep (TraceReplayEvent blk replayTo) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk replayTo x.
Rep (TraceReplayEvent blk replayTo) x
-> TraceReplayEvent blk replayTo
forall blk replayTo x.
TraceReplayEvent blk replayTo
-> Rep (TraceReplayEvent blk replayTo) x
$cto :: forall blk replayTo x.
Rep (TraceReplayEvent blk replayTo) x
-> TraceReplayEvent blk replayTo
$cfrom :: forall blk replayTo x.
TraceReplayEvent blk replayTo
-> Rep (TraceReplayEvent blk replayTo) x
Generic, TraceReplayEvent blk replayTo
-> TraceReplayEvent blk replayTo -> Bool
(TraceReplayEvent blk replayTo
 -> TraceReplayEvent blk replayTo -> Bool)
-> (TraceReplayEvent blk replayTo
    -> TraceReplayEvent blk replayTo -> Bool)
-> Eq (TraceReplayEvent blk replayTo)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall blk replayTo.
(StandardHash blk, InspectLedger blk, Eq replayTo) =>
TraceReplayEvent blk replayTo
-> TraceReplayEvent blk replayTo -> Bool
/= :: TraceReplayEvent blk replayTo
-> TraceReplayEvent blk replayTo -> Bool
$c/= :: forall blk replayTo.
(StandardHash blk, InspectLedger blk, Eq replayTo) =>
TraceReplayEvent blk replayTo
-> TraceReplayEvent blk replayTo -> Bool
== :: TraceReplayEvent blk replayTo
-> TraceReplayEvent blk replayTo -> Bool
$c== :: forall blk replayTo.
(StandardHash blk, InspectLedger blk, Eq replayTo) =>
TraceReplayEvent blk replayTo
-> TraceReplayEvent blk replayTo -> Bool
Eq, Int -> TraceReplayEvent blk replayTo -> ShowS
[TraceReplayEvent blk replayTo] -> ShowS
TraceReplayEvent blk replayTo -> String
(Int -> TraceReplayEvent blk replayTo -> ShowS)
-> (TraceReplayEvent blk replayTo -> String)
-> ([TraceReplayEvent blk replayTo] -> ShowS)
-> Show (TraceReplayEvent blk replayTo)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall blk replayTo.
(StandardHash blk, InspectLedger blk, Show replayTo) =>
Int -> TraceReplayEvent blk replayTo -> ShowS
forall blk replayTo.
(StandardHash blk, InspectLedger blk, Show replayTo) =>
[TraceReplayEvent blk replayTo] -> ShowS
forall blk replayTo.
(StandardHash blk, InspectLedger blk, Show replayTo) =>
TraceReplayEvent blk replayTo -> String
showList :: [TraceReplayEvent blk replayTo] -> ShowS
$cshowList :: forall blk replayTo.
(StandardHash blk, InspectLedger blk, Show replayTo) =>
[TraceReplayEvent blk replayTo] -> ShowS
show :: TraceReplayEvent blk replayTo -> String
$cshow :: forall blk replayTo.
(StandardHash blk, InspectLedger blk, Show replayTo) =>
TraceReplayEvent blk replayTo -> String
showsPrec :: Int -> TraceReplayEvent blk replayTo -> ShowS
$cshowsPrec :: forall blk replayTo.
(StandardHash blk, InspectLedger blk, Show replayTo) =>
Int -> TraceReplayEvent blk replayTo -> ShowS
Show, a -> TraceReplayEvent blk b -> TraceReplayEvent blk a
(a -> b) -> TraceReplayEvent blk a -> TraceReplayEvent blk b
(forall a b.
 (a -> b) -> TraceReplayEvent blk a -> TraceReplayEvent blk b)
-> (forall a b.
    a -> TraceReplayEvent blk b -> TraceReplayEvent blk a)
-> Functor (TraceReplayEvent blk)
forall a b. a -> TraceReplayEvent blk b -> TraceReplayEvent blk a
forall a b.
(a -> b) -> TraceReplayEvent blk a -> TraceReplayEvent blk b
forall blk a b.
a -> TraceReplayEvent blk b -> TraceReplayEvent blk a
forall blk a b.
(a -> b) -> TraceReplayEvent blk a -> TraceReplayEvent blk b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TraceReplayEvent blk b -> TraceReplayEvent blk a
$c<$ :: forall blk a b.
a -> TraceReplayEvent blk b -> TraceReplayEvent blk a
fmap :: (a -> b) -> TraceReplayEvent blk a -> TraceReplayEvent blk b
$cfmap :: forall blk a b.
(a -> b) -> TraceReplayEvent blk a -> TraceReplayEvent blk b
Functor, TraceReplayEvent blk a -> Bool
(a -> m) -> TraceReplayEvent blk a -> m
(a -> b -> b) -> b -> TraceReplayEvent blk a -> b
(forall m. Monoid m => TraceReplayEvent blk m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> TraceReplayEvent blk a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> TraceReplayEvent blk a -> m)
-> (forall a b. (a -> b -> b) -> b -> TraceReplayEvent blk a -> b)
-> (forall a b. (a -> b -> b) -> b -> TraceReplayEvent blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> TraceReplayEvent blk a -> b)
-> (forall b a. (b -> a -> b) -> b -> TraceReplayEvent blk a -> b)
-> (forall a. (a -> a -> a) -> TraceReplayEvent blk a -> a)
-> (forall a. (a -> a -> a) -> TraceReplayEvent blk a -> a)
-> (forall a. TraceReplayEvent blk a -> [a])
-> (forall a. TraceReplayEvent blk a -> Bool)
-> (forall a. TraceReplayEvent blk a -> Int)
-> (forall a. Eq a => a -> TraceReplayEvent blk a -> Bool)
-> (forall a. Ord a => TraceReplayEvent blk a -> a)
-> (forall a. Ord a => TraceReplayEvent blk a -> a)
-> (forall a. Num a => TraceReplayEvent blk a -> a)
-> (forall a. Num a => TraceReplayEvent blk a -> a)
-> Foldable (TraceReplayEvent blk)
forall a. Eq a => a -> TraceReplayEvent blk a -> Bool
forall a. Num a => TraceReplayEvent blk a -> a
forall a. Ord a => TraceReplayEvent blk a -> a
forall m. Monoid m => TraceReplayEvent blk m -> m
forall a. TraceReplayEvent blk a -> Bool
forall a. TraceReplayEvent blk a -> Int
forall a. TraceReplayEvent blk a -> [a]
forall a. (a -> a -> a) -> TraceReplayEvent blk a -> a
forall blk a. Eq a => a -> TraceReplayEvent blk a -> Bool
forall blk a. Num a => TraceReplayEvent blk a -> a
forall blk a. Ord a => TraceReplayEvent blk a -> a
forall m a. Monoid m => (a -> m) -> TraceReplayEvent blk a -> m
forall blk m. Monoid m => TraceReplayEvent blk m -> m
forall blk a. TraceReplayEvent blk a -> Bool
forall blk a. TraceReplayEvent blk a -> Int
forall blk a. TraceReplayEvent blk a -> [a]
forall b a. (b -> a -> b) -> b -> TraceReplayEvent blk a -> b
forall a b. (a -> b -> b) -> b -> TraceReplayEvent blk a -> b
forall blk a. (a -> a -> a) -> TraceReplayEvent blk a -> a
forall blk m a. Monoid m => (a -> m) -> TraceReplayEvent blk a -> m
forall blk b a. (b -> a -> b) -> b -> TraceReplayEvent blk a -> b
forall blk a b. (a -> b -> b) -> b -> TraceReplayEvent 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
product :: TraceReplayEvent blk a -> a
$cproduct :: forall blk a. Num a => TraceReplayEvent blk a -> a
sum :: TraceReplayEvent blk a -> a
$csum :: forall blk a. Num a => TraceReplayEvent blk a -> a
minimum :: TraceReplayEvent blk a -> a
$cminimum :: forall blk a. Ord a => TraceReplayEvent blk a -> a
maximum :: TraceReplayEvent blk a -> a
$cmaximum :: forall blk a. Ord a => TraceReplayEvent blk a -> a
elem :: a -> TraceReplayEvent blk a -> Bool
$celem :: forall blk a. Eq a => a -> TraceReplayEvent blk a -> Bool
length :: TraceReplayEvent blk a -> Int
$clength :: forall blk a. TraceReplayEvent blk a -> Int
null :: TraceReplayEvent blk a -> Bool
$cnull :: forall blk a. TraceReplayEvent blk a -> Bool
toList :: TraceReplayEvent blk a -> [a]
$ctoList :: forall blk a. TraceReplayEvent blk a -> [a]
foldl1 :: (a -> a -> a) -> TraceReplayEvent blk a -> a
$cfoldl1 :: forall blk a. (a -> a -> a) -> TraceReplayEvent blk a -> a
foldr1 :: (a -> a -> a) -> TraceReplayEvent blk a -> a
$cfoldr1 :: forall blk a. (a -> a -> a) -> TraceReplayEvent blk a -> a
foldl' :: (b -> a -> b) -> b -> TraceReplayEvent blk a -> b
$cfoldl' :: forall blk b a. (b -> a -> b) -> b -> TraceReplayEvent blk a -> b
foldl :: (b -> a -> b) -> b -> TraceReplayEvent blk a -> b
$cfoldl :: forall blk b a. (b -> a -> b) -> b -> TraceReplayEvent blk a -> b
foldr' :: (a -> b -> b) -> b -> TraceReplayEvent blk a -> b
$cfoldr' :: forall blk a b. (a -> b -> b) -> b -> TraceReplayEvent blk a -> b
foldr :: (a -> b -> b) -> b -> TraceReplayEvent blk a -> b
$cfoldr :: forall blk a b. (a -> b -> b) -> b -> TraceReplayEvent blk a -> b
foldMap' :: (a -> m) -> TraceReplayEvent blk a -> m
$cfoldMap' :: forall blk m a. Monoid m => (a -> m) -> TraceReplayEvent blk a -> m
foldMap :: (a -> m) -> TraceReplayEvent blk a -> m
$cfoldMap :: forall blk m a. Monoid m => (a -> m) -> TraceReplayEvent blk a -> m
fold :: TraceReplayEvent blk m -> m
$cfold :: forall blk m. Monoid m => TraceReplayEvent blk m -> m
Foldable, Functor (TraceReplayEvent blk)
Foldable (TraceReplayEvent blk)
Functor (TraceReplayEvent blk)
-> Foldable (TraceReplayEvent blk)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> TraceReplayEvent blk a -> f (TraceReplayEvent blk b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    TraceReplayEvent blk (f a) -> f (TraceReplayEvent blk a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> TraceReplayEvent blk a -> m (TraceReplayEvent blk b))
-> (forall (m :: * -> *) a.
    Monad m =>
    TraceReplayEvent blk (m a) -> m (TraceReplayEvent blk a))
-> Traversable (TraceReplayEvent blk)
(a -> f b) -> TraceReplayEvent blk a -> f (TraceReplayEvent blk b)
forall blk. Functor (TraceReplayEvent blk)
forall blk. Foldable (TraceReplayEvent blk)
forall blk (m :: * -> *) a.
Monad m =>
TraceReplayEvent blk (m a) -> m (TraceReplayEvent blk a)
forall blk (f :: * -> *) a.
Applicative f =>
TraceReplayEvent blk (f a) -> f (TraceReplayEvent blk a)
forall blk (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TraceReplayEvent blk a -> m (TraceReplayEvent blk b)
forall blk (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TraceReplayEvent blk a -> f (TraceReplayEvent 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 =>
TraceReplayEvent blk (m a) -> m (TraceReplayEvent blk a)
forall (f :: * -> *) a.
Applicative f =>
TraceReplayEvent blk (f a) -> f (TraceReplayEvent blk a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TraceReplayEvent blk a -> m (TraceReplayEvent blk b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TraceReplayEvent blk a -> f (TraceReplayEvent blk b)
sequence :: TraceReplayEvent blk (m a) -> m (TraceReplayEvent blk a)
$csequence :: forall blk (m :: * -> *) a.
Monad m =>
TraceReplayEvent blk (m a) -> m (TraceReplayEvent blk a)
mapM :: (a -> m b) -> TraceReplayEvent blk a -> m (TraceReplayEvent blk b)
$cmapM :: forall blk (m :: * -> *) a b.
Monad m =>
(a -> m b) -> TraceReplayEvent blk a -> m (TraceReplayEvent blk b)
sequenceA :: TraceReplayEvent blk (f a) -> f (TraceReplayEvent blk a)
$csequenceA :: forall blk (f :: * -> *) a.
Applicative f =>
TraceReplayEvent blk (f a) -> f (TraceReplayEvent blk a)
traverse :: (a -> f b) -> TraceReplayEvent blk a -> f (TraceReplayEvent blk b)
$ctraverse :: forall blk (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> TraceReplayEvent blk a -> f (TraceReplayEvent blk b)
$cp2Traversable :: forall blk. Foldable (TraceReplayEvent blk)
$cp1Traversable :: forall blk. Functor (TraceReplayEvent blk)
Traversable)