{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Definition of common types used in "Ouroboros.Consensus.Mempool.Init",
-- "Ouroboros.Consensus.Mempool.Update" and "Ouroboros.Consensus.Mempool.Query".
module Ouroboros.Consensus.Mempool.Impl.Common (
    -- * Internal state
    InternalState (..)
  , isMempoolSize
    -- * Mempool environment
  , MempoolEnv (..)
  , initMempoolEnv
    -- * Ledger interface
  , LedgerInterface (..)
  , chainDBLedgerInterface
    -- * Validation
  , RevalidateTxsResult (..)
  , computeSnapshot
  , revalidateTxsFor
  , validateNewTransaction
    -- * Tracing
  , TraceEventMempool (..)
    -- * Conversions
  , snapshotFromIS
    -- * Ticking a ledger state
  , tickLedgerState
  ) where

import           Control.Concurrent.Class.MonadMVar (MVar, newMVar)
import           Control.Concurrent.Class.MonadSTM.Strict.TMVar (newTMVarIO)
import           Control.Monad.Trans.Except (runExcept)
import           Control.Tracer
import qualified Data.Foldable as Foldable
import qualified Data.List.NonEmpty as NE
import           Data.Set (Set)
import qualified Data.Set as Set
import           Data.Typeable
import           GHC.Generics (Generic)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.HeaderValidation
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Extended (ledgerState)
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.Ledger.Tables.Utils
import           Ouroboros.Consensus.Mempool.API
import           Ouroboros.Consensus.Mempool.Capacity
import           Ouroboros.Consensus.Mempool.TxSeq (TxSeq (..), TxTicket (..))
import qualified Ouroboros.Consensus.Mempool.TxSeq as TxSeq
import           Ouroboros.Consensus.Storage.ChainDB (ChainDB)
import qualified Ouroboros.Consensus.Storage.ChainDB.API as ChainDB
import           Ouroboros.Consensus.Util.Enclose (EnclosingTimed)
import           Ouroboros.Consensus.Util.IOLike hiding (newMVar)

{-------------------------------------------------------------------------------
  Internal State
-------------------------------------------------------------------------------}

-- | Internal state in the mempool
data InternalState blk = IS {
      -- | Transactions currently in the mempool
      --
      -- NOTE: the total size of the transactions in 'isTxs' may exceed the
      -- current capacity ('isCapacity'). When the capacity computed from the
      -- ledger has shrunk, we don't remove transactions from the Mempool to
      -- satisfy the new lower limit. We let the transactions get removed in
      -- the normal way: by becoming invalid w.r.t. the updated ledger state.
      -- We treat a Mempool /over/ capacity in the same way as a Mempool /at/
      -- capacity.
      forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs          :: !(TxSeq (TxMeasure blk) (Validated (GenTx blk)))

      -- | The cached IDs of transactions currently in the mempool.
      --
      -- This allows one to more quickly lookup transactions by ID from a
      -- 'MempoolSnapshot' (see 'snapshotHasTx').
      --
      -- This should always be in-sync with the transactions in 'isTxs'.
    , forall blk. InternalState blk -> Set (GenTxId blk)
isTxIds        :: !(Set (GenTxId blk))

      -- | The cached set of keys needed for the transactions
      -- currently in the mempool.
      --
      -- INVARIANT: @'isTxKeys' == foldMap (getTransactionKeySets . txForgetValidated) $ toList 'isTxs'@
    , forall blk.
InternalState blk -> LedgerTables (LedgerState blk) KeysMK
isTxKeys       :: !(LedgerTables (LedgerState blk) KeysMK)

      -- | The cached values corresponding to reading 'isTxKeys' at
      -- 'isLedgerState'. These values can be used unless we switch to
      -- a different ledger state. It usually happens in the forging
      -- loop that the same ledger state that was in 'isLedgerState'
      -- is used, but ticked to a different slot so we can reuse these
      -- values.
      --
      -- INVARIANT: 'isTxValues' should be equal to @getForkerAtTarget ... 'isLedgerState' >>= \f -> forkerReadTables f isTxKeys@
    , forall blk.
InternalState blk -> LedgerTables (LedgerState blk) ValuesMK
isTxValues     :: !(LedgerTables (LedgerState blk) ValuesMK)
      -- | The cached ledger state after applying the transactions in the
      -- Mempool against the chain's ledger state. New transactions will be
      -- validated against this ledger.
      --
      -- INVARIANT: 'isLedgerState' is the ledger resulting from applying the
      -- transactions in 'isTxs' against the ledger identified 'isTip' as tip.
    , forall blk. InternalState blk -> TickedLedgerState blk DiffMK
isLedgerState  :: !(TickedLedgerState blk DiffMK)

      -- | The tip of the chain that 'isTxs' was validated against
    , forall blk. InternalState blk -> Point blk
isTip          :: !(Point blk)

      -- | The most recent 'SlotNo' that 'isTxs' was validated against
      --
      -- Note in particular that if the mempool is revalidated against a state S
      -- at slot s, then the state will be ticked (for now to the successor
      -- slot, see 'tickLedgerState') and 'isSlotNo' will be set to @succ s@,
      -- which is different from the slot of the original ledger state, which
      -- will remain in 'isTip'.
    , forall blk. InternalState blk -> SlotNo
isSlotNo       :: !SlotNo

      -- | The mempool 'TicketNo' counter.
      --
      -- See 'vrLastTicketNo' for more information.
    , forall blk. InternalState blk -> TicketNo
isLastTicketNo :: !TicketNo

      -- | Current maximum capacity of the Mempool. Result of
      -- 'computeMempoolCapacity' using the current chain's
      -- 'TickedLedgerState'.
      --
      -- NOTE: this does not correspond to 'isLedgerState', which is the
      -- 'TickedLedgerState' /after/ applying the transactions in the Mempool.
      -- There might be a transaction in the Mempool triggering a change in
      -- the maximum transaction capacity of a block, which would change the
      -- Mempool's capacity (unless overridden). We don't want the Mempool's
      -- capacity to depend on its contents. The mempool is assuming /all/ its
      -- transactions will be in the next block. So any changes caused by that
      -- block will take effect after applying it and will only affect the
      -- next block.
    , forall blk. InternalState blk -> TxMeasure blk
isCapacity     :: !(TxMeasure blk)
    }
  deriving ((forall x. InternalState blk -> Rep (InternalState blk) x)
-> (forall x. Rep (InternalState blk) x -> InternalState blk)
-> Generic (InternalState blk)
forall x. Rep (InternalState blk) x -> InternalState blk
forall x. InternalState blk -> Rep (InternalState blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x. Rep (InternalState blk) x -> InternalState blk
forall blk x. InternalState blk -> Rep (InternalState blk) x
$cfrom :: forall blk x. InternalState blk -> Rep (InternalState blk) x
from :: forall x. InternalState blk -> Rep (InternalState blk) x
$cto :: forall blk x. Rep (InternalState blk) x -> InternalState blk
to :: forall x. Rep (InternalState blk) x -> InternalState blk
Generic)

deriving instance ( NoThunks (Validated (GenTx blk))
                  , NoThunks (GenTxId blk)
                  , NoThunks (TickedLedgerState blk DiffMK)
                  , NoThunks (TxIn (LedgerState blk))
                  , NoThunks (TxOut (LedgerState blk))
                  , NoThunks (TxMeasure blk)
                  , StandardHash blk
                  , Typeable blk
                  ) => NoThunks (InternalState blk)

-- | \( O(1) \). Return the number of transactions in the internal state of
-- the Mempool paired with their total size in bytes.
isMempoolSize :: TxLimits blk => InternalState blk -> MempoolSize
isMempoolSize :: forall blk. TxLimits blk => InternalState blk -> MempoolSize
isMempoolSize InternalState blk
is = MempoolSize {
    msNumTxs :: Word32
msNumTxs   = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ TxSeq (TxMeasure blk) (Validated (GenTx blk)) -> Int
forall a. TxSeq (TxMeasure blk) a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (TxSeq (TxMeasure blk) (Validated (GenTx blk)) -> Int)
-> TxSeq (TxMeasure blk) (Validated (GenTx blk)) -> Int
forall a b. (a -> b) -> a -> b
$ InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs InternalState blk
is
  , msNumBytes :: ByteSize32
msNumBytes = TxMeasure blk -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize (TxMeasure blk -> ByteSize32) -> TxMeasure blk -> ByteSize32
forall a b. (a -> b) -> a -> b
$ TxSeq (TxMeasure blk) (Validated (GenTx blk)) -> TxMeasure blk
forall sz tx. Measure sz => TxSeq sz tx -> sz
TxSeq.toSize (TxSeq (TxMeasure blk) (Validated (GenTx blk)) -> TxMeasure blk)
-> TxSeq (TxMeasure blk) (Validated (GenTx blk)) -> TxMeasure blk
forall a b. (a -> b) -> a -> b
$ InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs InternalState blk
is
  }

initInternalState ::
     LedgerSupportsMempool blk
  => MempoolCapacityBytesOverride
  -> TicketNo  -- ^ Used for 'isLastTicketNo'
  -> LedgerConfig blk
  -> SlotNo
  -> TickedLedgerState blk DiffMK
  -> InternalState blk
initInternalState :: forall blk.
LedgerSupportsMempool blk =>
MempoolCapacityBytesOverride
-> TicketNo
-> LedgerConfig blk
-> SlotNo
-> TickedLedgerState blk DiffMK
-> InternalState blk
initInternalState MempoolCapacityBytesOverride
capacityOverride TicketNo
lastTicketNo LedgerConfig blk
cfg SlotNo
slot TickedLedgerState blk DiffMK
st = IS {
      isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs          = TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall sz tx. Measure sz => TxSeq sz tx
TxSeq.Empty
    , isTxIds :: Set (GenTxId blk)
isTxIds        = Set (GenTxId blk)
forall a. Set a
Set.empty
    , isTxKeys :: LedgerTables (LedgerState blk) KeysMK
isTxKeys       = LedgerTables (LedgerState blk) KeysMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
    , isTxValues :: LedgerTables (LedgerState blk) ValuesMK
isTxValues     = LedgerTables (LedgerState blk) ValuesMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
    , isLedgerState :: TickedLedgerState blk DiffMK
isLedgerState  = TickedLedgerState blk DiffMK
st
    , isTip :: Point blk
isTip          = Point (Ticked (LedgerState blk)) -> Point blk
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Ticked (LedgerState blk)) -> Point blk)
-> Point (Ticked (LedgerState blk)) -> Point blk
forall a b. (a -> b) -> a -> b
$ TickedLedgerState blk DiffMK -> Point (Ticked (LedgerState blk))
forall (mk :: * -> * -> *).
Ticked (LedgerState blk) mk -> Point (Ticked (LedgerState blk))
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip TickedLedgerState blk DiffMK
st
    , isSlotNo :: SlotNo
isSlotNo       = SlotNo
slot
    , isLastTicketNo :: TicketNo
isLastTicketNo = TicketNo
lastTicketNo
    , isCapacity :: TxMeasure blk
isCapacity     = LedgerConfig blk
-> TickedLedgerState blk DiffMK
-> MempoolCapacityBytesOverride
-> TxMeasure blk
forall blk (mk :: * -> * -> *).
LedgerSupportsMempool blk =>
LedgerConfig blk
-> TickedLedgerState blk mk
-> MempoolCapacityBytesOverride
-> TxMeasure blk
computeMempoolCapacity LedgerConfig blk
cfg TickedLedgerState blk DiffMK
st MempoolCapacityBytesOverride
capacityOverride
    }

{-------------------------------------------------------------------------------
  Ledger Interface
-------------------------------------------------------------------------------}

-- | Abstract interface needed to run a Mempool.
data LedgerInterface m blk = LedgerInterface
    { -- | Get the current tip of the LedgerDB.
      forall (m :: * -> *) blk.
LedgerInterface m blk -> STM m (LedgerState blk EmptyMK)
getCurrentLedgerState :: STM m (LedgerState blk EmptyMK)
      -- | Get values at the given point on the chain. Returns Nothing if the
      -- anchor moved or if the state is not found on the ledger db.
    , forall (m :: * -> *) blk.
LedgerInterface m blk
-> Point blk
-> LedgerTables (LedgerState blk) KeysMK
-> m (Maybe (LedgerTables (LedgerState blk) ValuesMK))
getLedgerTablesAtFor
        :: Point blk
        -> LedgerTables (LedgerState blk) KeysMK
        -> m (Maybe (LedgerTables (LedgerState blk) ValuesMK))
    }

-- | Create a 'LedgerInterface' from a 'ChainDB'.
chainDBLedgerInterface ::
     IOLike m
  => ChainDB m blk -> LedgerInterface m blk
chainDBLedgerInterface :: forall (m :: * -> *) blk.
IOLike m =>
ChainDB m blk -> LedgerInterface m blk
chainDBLedgerInterface ChainDB m blk
chainDB = LedgerInterface
    { getCurrentLedgerState :: STM m (LedgerState blk EmptyMK)
getCurrentLedgerState =
        ExtLedgerState blk EmptyMK -> LedgerState blk EmptyMK
forall blk (mk :: * -> * -> *).
ExtLedgerState blk mk -> LedgerState blk mk
ledgerState (ExtLedgerState blk EmptyMK -> LedgerState blk EmptyMK)
-> STM m (ExtLedgerState blk EmptyMK)
-> STM m (LedgerState blk EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB m blk -> STM m (ExtLedgerState blk EmptyMK)
forall (m :: * -> *) blk.
ChainDB m blk -> STM m (ExtLedgerState blk EmptyMK)
ChainDB.getCurrentLedger ChainDB m blk
chainDB
    , getLedgerTablesAtFor :: Point blk
-> LedgerTables (LedgerState blk) KeysMK
-> m (Maybe (LedgerTables (LedgerState blk) ValuesMK))
getLedgerTablesAtFor = \Point blk
pt LedgerTables (LedgerState blk) KeysMK
keys ->
        (LedgerTables (ExtLedgerState blk) ValuesMK
 -> LedgerTables (LedgerState blk) ValuesMK)
-> Maybe (LedgerTables (ExtLedgerState blk) ValuesMK)
-> Maybe (LedgerTables (LedgerState blk) ValuesMK)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LedgerTables (ExtLedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) ValuesMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables (Maybe (LedgerTables (ExtLedgerState blk) ValuesMK)
 -> Maybe (LedgerTables (LedgerState blk) ValuesMK))
-> m (Maybe (LedgerTables (ExtLedgerState blk) ValuesMK))
-> m (Maybe (LedgerTables (LedgerState blk) ValuesMK))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDB m blk
-> Point blk
-> LedgerTables (ExtLedgerState blk) KeysMK
-> m (Maybe (LedgerTables (ExtLedgerState blk) ValuesMK))
forall (m :: * -> *) blk.
ChainDB m blk
-> Point blk
-> LedgerTables (ExtLedgerState blk) KeysMK
-> m (Maybe (LedgerTables (ExtLedgerState blk) ValuesMK))
ChainDB.getLedgerTablesAtFor ChainDB m blk
chainDB Point blk
pt (LedgerTables (LedgerState blk) KeysMK
-> LedgerTables (ExtLedgerState blk) KeysMK
forall (l :: LedgerStateKind) (l' :: LedgerStateKind)
       (mk :: * -> * -> *).
SameUtxoTypes l l' =>
LedgerTables l mk -> LedgerTables l' mk
castLedgerTables LedgerTables (LedgerState blk) KeysMK
keys)
    }

{-------------------------------------------------------------------------------
  Mempool environment
-------------------------------------------------------------------------------}

-- | The mempool environment captures all the associated variables wrt the
-- Mempool and is accessed by the Mempool interface on demand to perform the
-- different operations.
data MempoolEnv m blk = MempoolEnv {
      forall (m :: * -> *) blk. MempoolEnv m blk -> LedgerInterface m blk
mpEnvLedger           :: LedgerInterface m blk
    , forall (m :: * -> *) blk. MempoolEnv m blk -> LedgerConfig blk
mpEnvLedgerCfg        :: LedgerConfig blk
    , forall (m :: * -> *) blk.
MempoolEnv m blk -> StrictTMVar m (InternalState blk)
mpEnvStateVar         :: StrictTMVar m (InternalState blk)
    , forall (m :: * -> *) blk. MempoolEnv m blk -> MVar m ()
mpEnvAddTxsRemoteFifo :: MVar m ()
    , forall (m :: * -> *) blk. MempoolEnv m blk -> MVar m ()
mpEnvAddTxsAllFifo    :: MVar m ()
    , forall (m :: * -> *) blk.
MempoolEnv m blk -> Tracer m (TraceEventMempool blk)
mpEnvTracer           :: Tracer m (TraceEventMempool blk)
    , forall (m :: * -> *) blk.
MempoolEnv m blk -> MempoolCapacityBytesOverride
mpEnvCapacityOverride :: MempoolCapacityBytesOverride
    }

initMempoolEnv :: ( IOLike m
                  , LedgerSupportsMempool blk
                  , ValidateEnvelope blk
                  )
               => LedgerInterface m blk
               -> LedgerConfig blk
               -> MempoolCapacityBytesOverride
               -> Tracer m (TraceEventMempool blk)
               -> m (MempoolEnv m blk)
initMempoolEnv :: forall (m :: * -> *) blk.
(IOLike m, LedgerSupportsMempool blk, ValidateEnvelope blk) =>
LedgerInterface m blk
-> LedgerConfig blk
-> MempoolCapacityBytesOverride
-> Tracer m (TraceEventMempool blk)
-> m (MempoolEnv m blk)
initMempoolEnv LedgerInterface m blk
ledgerInterface LedgerCfg (LedgerState blk)
cfg MempoolCapacityBytesOverride
capacityOverride Tracer m (TraceEventMempool blk)
tracer = do
    st <- STM m (LedgerState blk EmptyMK) -> m (LedgerState blk EmptyMK)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (LedgerState blk EmptyMK) -> m (LedgerState blk EmptyMK))
-> STM m (LedgerState blk EmptyMK) -> m (LedgerState blk EmptyMK)
forall a b. (a -> b) -> a -> b
$ LedgerInterface m blk -> STM m (LedgerState blk EmptyMK)
forall (m :: * -> *) blk.
LedgerInterface m blk -> STM m (LedgerState blk EmptyMK)
getCurrentLedgerState LedgerInterface m blk
ledgerInterface
    let (slot, st') = tickLedgerState cfg (ForgeInUnknownSlot st)
    isVar <- newTMVarIO
           $ initInternalState capacityOverride TxSeq.zeroTicketNo cfg slot st'
    addTxRemoteFifo <- newMVar ()
    addTxAllFifo    <- newMVar ()
    return MempoolEnv
      { mpEnvLedger           = ledgerInterface
      , mpEnvLedgerCfg        = cfg
      , mpEnvStateVar         = isVar
      , mpEnvAddTxsRemoteFifo = addTxRemoteFifo
      , mpEnvAddTxsAllFifo    = addTxAllFifo
      , mpEnvTracer           = tracer
      , mpEnvCapacityOverride = capacityOverride
      }

{-------------------------------------------------------------------------------
  Ticking the ledger state
-------------------------------------------------------------------------------}

-- | Tick the 'LedgerState' using the given 'BlockSlot'.
tickLedgerState ::
     forall blk. (UpdateLedger blk, ValidateEnvelope blk)
  => LedgerConfig     blk
  -> ForgeLedgerState blk
  -> (SlotNo, TickedLedgerState blk DiffMK)
tickLedgerState :: forall blk.
(UpdateLedger blk, ValidateEnvelope blk) =>
LedgerConfig blk
-> ForgeLedgerState blk -> (SlotNo, TickedLedgerState blk DiffMK)
tickLedgerState LedgerConfig blk
_cfg (ForgeInKnownSlot SlotNo
slot TickedLedgerState blk DiffMK
st) = (SlotNo
slot, TickedLedgerState blk DiffMK
st)
tickLedgerState LedgerConfig blk
cfg (ForgeInUnknownSlot LedgerState blk EmptyMK
st) =
    (SlotNo
slot, ComputeLedgerEvents
-> LedgerConfig blk
-> SlotNo
-> LedgerState blk EmptyMK
-> TickedLedgerState blk DiffMK
forall (l :: LedgerStateKind).
IsLedger l =>
ComputeLedgerEvents
-> LedgerCfg l -> SlotNo -> l EmptyMK -> Ticked l DiffMK
applyChainTick ComputeLedgerEvents
OmitLedgerEvents LedgerConfig blk
cfg SlotNo
slot LedgerState blk EmptyMK
st)
  where
    -- Optimistically assume that the transactions will be included in a block
    -- in the next available slot
    --
    -- TODO: We should use time here instead
    -- <https://github.com/IntersectMBO/ouroboros-network/issues/1298>
    -- Once we do, the ValidateEnvelope constraint can go.
    slot :: SlotNo
    slot :: SlotNo
slot = case LedgerState blk EmptyMK -> WithOrigin SlotNo
forall blk (mk :: * -> * -> *).
UpdateLedger blk =>
LedgerState blk mk -> WithOrigin SlotNo
ledgerTipSlot LedgerState blk EmptyMK
st of
             WithOrigin SlotNo
Origin      -> Proxy blk -> SlotNo
forall blk. BasicEnvelopeValidation blk => Proxy blk -> SlotNo
minimumPossibleSlotNo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)
             NotOrigin SlotNo
s -> SlotNo -> SlotNo
forall a. Enum a => a -> a
succ SlotNo
s

{-------------------------------------------------------------------------------
  Validation
-------------------------------------------------------------------------------}

-- | Extend 'InternalState' with a new transaction (one which we have not
-- previously validated) that may or may not be valid in this ledger state.
validateNewTransaction
  :: (LedgerSupportsMempool blk, HasTxId (GenTx blk))
  => LedgerConfig blk
  -> WhetherToIntervene
  -> GenTx blk
  -> TxMeasure blk
  -> LedgerTables (LedgerState blk) ValuesMK
     -- ^ Values to cache if success
  -> TickedLedgerState blk ValuesMK
     -- ^ This state is the internal state with the tables for this transaction
     -- advanced through the diffs in the internal state. One could think we can
     -- create this value here, but it is needed for some other uses like calling
     -- 'txMeasure' before this function.
  -> InternalState blk
  -> ( Either (ApplyTxErr blk) (Validated (GenTx blk))
     , InternalState blk
     )
validateNewTransaction :: forall blk.
(LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
LedgerConfig blk
-> WhetherToIntervene
-> GenTx blk
-> TxMeasure blk
-> LedgerTables (LedgerState blk) ValuesMK
-> TickedLedgerState blk ValuesMK
-> InternalState blk
-> (Either (ApplyTxErr blk) (Validated (GenTx blk)),
    InternalState blk)
validateNewTransaction LedgerConfig blk
cfg WhetherToIntervene
wti GenTx blk
tx TxMeasure blk
txsz LedgerTables (LedgerState blk) ValuesMK
origValues TickedLedgerState blk ValuesMK
st InternalState blk
is =
    case Except
  (ApplyTxErr blk)
  (TickedLedgerState blk DiffMK, Validated (GenTx blk))
-> Either
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
forall e a. Except e a -> Either e a
runExcept (LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
forall blk.
LedgerSupportsMempool blk =>
LedgerConfig blk
-> WhetherToIntervene
-> SlotNo
-> GenTx blk
-> TickedLedgerState blk ValuesMK
-> Except
     (ApplyTxErr blk)
     (TickedLedgerState blk DiffMK, Validated (GenTx blk))
applyTx LedgerConfig blk
cfg WhetherToIntervene
wti SlotNo
isSlotNo GenTx blk
tx TickedLedgerState blk ValuesMK
st) of
      Left ApplyTxErr blk
err         -> ( ApplyTxErr blk -> Either (ApplyTxErr blk) (Validated (GenTx blk))
forall a b. a -> Either a b
Left ApplyTxErr blk
err, InternalState blk
is )
      Right (TickedLedgerState blk DiffMK
st', Validated (GenTx blk)
vtx) ->
        ( Validated (GenTx blk)
-> Either (ApplyTxErr blk) (Validated (GenTx blk))
forall a b. b -> Either a b
Right Validated (GenTx blk)
vtx
        , InternalState blk
is { isTxs          = isTxs :> TxTicket vtx nextTicketNo txsz
             , isTxKeys       = isTxKeys <> getTransactionKeySets tx
             , isTxValues     = ltliftA2 unionValues isTxValues origValues
             , isTxIds        = Set.insert (txId tx) isTxIds
             , isLedgerState  = prependMempoolDiffs isLedgerState st'
             , isLastTicketNo = nextTicketNo
             }
        )
  where
    IS {
        TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs
      , Set (GenTxId blk)
isTxIds :: forall blk. InternalState blk -> Set (GenTxId blk)
isTxIds :: Set (GenTxId blk)
isTxIds
      , LedgerTables (LedgerState blk) KeysMK
isTxKeys :: forall blk.
InternalState blk -> LedgerTables (LedgerState blk) KeysMK
isTxKeys :: LedgerTables (LedgerState blk) KeysMK
isTxKeys
      , LedgerTables (LedgerState blk) ValuesMK
isTxValues :: forall blk.
InternalState blk -> LedgerTables (LedgerState blk) ValuesMK
isTxValues :: LedgerTables (LedgerState blk) ValuesMK
isTxValues
      , TickedLedgerState blk DiffMK
isLedgerState :: forall blk. InternalState blk -> TickedLedgerState blk DiffMK
isLedgerState :: TickedLedgerState blk DiffMK
isLedgerState
      , TicketNo
isLastTicketNo :: forall blk. InternalState blk -> TicketNo
isLastTicketNo :: TicketNo
isLastTicketNo
      , SlotNo
isSlotNo :: forall blk. InternalState blk -> SlotNo
isSlotNo :: SlotNo
isSlotNo
      } = InternalState blk
is

    nextTicketNo :: TicketNo
nextTicketNo = TicketNo -> TicketNo
forall a. Enum a => a -> a
succ TicketNo
isLastTicketNo

-- | Revalidate the given transactions against the given ticked ledger state,
-- producing a new 'InternalState'.
--
-- Note that this function will perform revalidation so it is expected that the
-- transactions given to it were previously applied, for example if we are
-- revalidating the whole set of transactions onto a new state, or if we remove
-- some transactions and revalidate the remaining ones.
revalidateTxsFor
  :: (LedgerSupportsMempool blk, HasTxId (GenTx blk))
  => MempoolCapacityBytesOverride
  -> LedgerConfig blk
  -> SlotNo
  -> TickedLedgerState blk DiffMK
     -- ^ The ticked ledger state againt which txs will be revalidated
  -> LedgerTables (LedgerState blk) ValuesMK
     -- ^ The tables with all the inputs for the transactions
  -> TicketNo -- ^ 'isLastTicketNo' and 'vrLastTicketNo'
  -> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
  -> RevalidateTxsResult blk
revalidateTxsFor :: forall blk.
(LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
MempoolCapacityBytesOverride
-> LedgerConfig blk
-> SlotNo
-> TickedLedgerState blk DiffMK
-> LedgerTables (LedgerState blk) ValuesMK
-> TicketNo
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> RevalidateTxsResult blk
revalidateTxsFor MempoolCapacityBytesOverride
capacityOverride LedgerCfg (LedgerState blk)
cfg SlotNo
slot TickedLedgerState blk DiffMK
st LedgerTables (LedgerState blk) ValuesMK
values TicketNo
lastTicketNo [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
txTickets =
  let theTxs :: [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
theTxs = (TxTicket (TxMeasure blk) (Validated (GenTx blk))
 -> (Validated (GenTx blk), (TicketNo, TxMeasure blk)))
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
forall a b. (a -> b) -> [a] -> [b]
map TxTicket (TxMeasure blk) (Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
forall {b} {a}. TxTicket b a -> (a, (TicketNo, b))
wrap [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
txTickets
      wrap :: TxTicket b a -> (a, (TicketNo, b))
wrap = (\(TxTicket a
tx TicketNo
tk b
tz) -> (a
tx, (TicketNo
tk, b
tz)))
      unwrap :: (tx, (TicketNo, sz)) -> TxTicket sz tx
unwrap = (\(tx
tx, (TicketNo
tk, sz
tz)) -> tx -> TicketNo -> sz -> TxTicket sz tx
forall sz tx. tx -> TicketNo -> sz -> TxTicket sz tx
TxTicket tx
tx TicketNo
tk sz
tz)
      ReapplyTxsResult [Invalidated blk]
err [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val TickedLedgerState blk TrackingMK
st' =
        ComputeDiffs
-> LedgerCfg (LedgerState blk)
-> SlotNo
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult (TicketNo, TxMeasure blk) blk
forall blk extra.
LedgerSupportsMempool blk =>
ComputeDiffs
-> LedgerConfig blk
-> SlotNo
-> [(Validated (GenTx blk), extra)]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult extra blk
forall extra.
ComputeDiffs
-> LedgerCfg (LedgerState blk)
-> SlotNo
-> [(Validated (GenTx blk), extra)]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult extra blk
reapplyTxs ComputeDiffs
ComputeDiffs LedgerCfg (LedgerState blk)
cfg SlotNo
slot [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
theTxs
        (TickedLedgerState blk ValuesMK
 -> ReapplyTxsResult (TicketNo, TxMeasure blk) blk)
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult (TicketNo, TxMeasure blk) blk
forall a b. (a -> b) -> a -> b
$ LedgerTables (LedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) KeysMK
-> TickedLedgerState blk DiffMK
-> TickedLedgerState blk ValuesMK
forall blk.
LedgerSupportsMempool blk =>
LedgerTables (LedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) KeysMK
-> TickedLedgerState blk DiffMK
-> TickedLedgerState blk ValuesMK
applyMempoolDiffs
              LedgerTables (LedgerState blk) ValuesMK
values
              (((Validated (GenTx blk), (TicketNo, TxMeasure blk))
 -> LedgerTables (LedgerState blk) KeysMK)
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> LedgerTables (LedgerState blk) KeysMK
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap' (GenTx blk -> LedgerTables (LedgerState blk) KeysMK
forall blk.
LedgerSupportsMempool blk =>
GenTx blk -> LedgerTables (LedgerState blk) KeysMK
getTransactionKeySets (GenTx blk -> LedgerTables (LedgerState blk) KeysMK)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> GenTx blk)
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> LedgerTables (LedgerState blk) KeysMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (Validated (GenTx blk) -> GenTx blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTx blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> Validated (GenTx blk)
forall a b. (a, b) -> a
fst) [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
theTxs)
              TickedLedgerState blk DiffMK
st
      keys :: LedgerTables (LedgerState blk) KeysMK
keys = ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
 -> LedgerTables (LedgerState blk) KeysMK)
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> LedgerTables (LedgerState blk) KeysMK
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap' (GenTx blk -> LedgerTables (LedgerState blk) KeysMK
forall blk.
LedgerSupportsMempool blk =>
GenTx blk -> LedgerTables (LedgerState blk) KeysMK
getTransactionKeySets (GenTx blk -> LedgerTables (LedgerState blk) KeysMK)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> GenTx blk)
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> LedgerTables (LedgerState blk) KeysMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (Validated (GenTx blk) -> GenTx blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTx blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> Validated (GenTx blk)
forall a b. (a, b) -> a
fst) [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val

  in InternalState blk -> [Invalidated blk] -> RevalidateTxsResult blk
forall blk.
InternalState blk -> [Invalidated blk] -> RevalidateTxsResult blk
RevalidateTxsResult
      (IS {
         isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs          = [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall sz tx. Measure sz => [TxTicket sz tx] -> TxSeq sz tx
TxSeq.fromList ([TxTicket (TxMeasure blk) (Validated (GenTx blk))]
 -> TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall a b. (a -> b) -> a -> b
$ ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
 -> TxTicket (TxMeasure blk) (Validated (GenTx blk)))
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
forall a b. (a -> b) -> [a] -> [b]
map (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> TxTicket (TxMeasure blk) (Validated (GenTx blk))
forall {tx} {sz}. (tx, (TicketNo, sz)) -> TxTicket sz tx
unwrap [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val
       , isTxIds :: Set (GenTxId blk)
isTxIds        = [GenTxId blk] -> Set (GenTxId blk)
forall a. Ord a => [a] -> Set a
Set.fromList ([GenTxId blk] -> Set (GenTxId blk))
-> [GenTxId blk] -> Set (GenTxId blk)
forall a b. (a -> b) -> a -> b
$ ((Validated (GenTx blk), (TicketNo, TxMeasure blk)) -> GenTxId blk)
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> [GenTxId blk]
forall a b. (a -> b) -> [a] -> [b]
map (GenTx blk -> GenTxId blk
forall tx. HasTxId tx => tx -> TxId tx
txId (GenTx blk -> GenTxId blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> GenTx blk)
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTxId blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (Validated (GenTx blk) -> GenTx blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTx blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> Validated (GenTx blk)
forall a b. (a, b) -> a
fst) [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val
       , isTxKeys :: LedgerTables (LedgerState blk) KeysMK
isTxKeys       = LedgerTables (LedgerState blk) KeysMK
keys
       , isTxValues :: LedgerTables (LedgerState blk) ValuesMK
isTxValues     = (forall k v.
 LedgerTableConstraints' (LedgerState blk) k v =>
 ValuesMK k v -> KeysMK k v -> ValuesMK k v)
-> LedgerTables (LedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) KeysMK
-> LedgerTables (LedgerState blk) ValuesMK
forall (l :: LedgerStateKind) (mk1 :: * -> * -> *)
       (mk2 :: * -> * -> *) (mk3 :: * -> * -> *).
LedgerTableConstraints l =>
(forall k v.
 LedgerTableConstraints' l k v =>
 mk1 k v -> mk2 k v -> mk3 k v)
-> LedgerTables l mk1 -> LedgerTables l mk2 -> LedgerTables l mk3
ltliftA2 ValuesMK k v -> KeysMK k v -> ValuesMK k v
forall k v. Ord k => ValuesMK k v -> KeysMK k v -> ValuesMK k v
forall k v.
LedgerTableConstraints' (LedgerState blk) k v =>
ValuesMK k v -> KeysMK k v -> ValuesMK k v
restrictValuesMK LedgerTables (LedgerState blk) ValuesMK
values LedgerTables (LedgerState blk) KeysMK
keys
       , isLedgerState :: TickedLedgerState blk DiffMK
isLedgerState  = TickedLedgerState blk TrackingMK -> TickedLedgerState blk DiffMK
forall (l :: LedgerStateKind).
(HasLedgerTables l, LedgerTableConstraints l) =>
l TrackingMK -> l DiffMK
trackingToDiffs TickedLedgerState blk TrackingMK
st'
       , isTip :: Point blk
isTip          = Point (Ticked (LedgerState blk)) -> Point blk
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (Ticked (LedgerState blk)) -> Point blk)
-> Point (Ticked (LedgerState blk)) -> Point blk
forall a b. (a -> b) -> a -> b
$ TickedLedgerState blk DiffMK -> Point (Ticked (LedgerState blk))
forall (mk :: * -> * -> *).
Ticked (LedgerState blk) mk -> Point (Ticked (LedgerState blk))
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip TickedLedgerState blk DiffMK
st
       , isSlotNo :: SlotNo
isSlotNo       = SlotNo
slot
       , isLastTicketNo :: TicketNo
isLastTicketNo = TicketNo
lastTicketNo
       , isCapacity :: TxMeasure blk
isCapacity     = LedgerCfg (LedgerState blk)
-> TickedLedgerState blk TrackingMK
-> MempoolCapacityBytesOverride
-> TxMeasure blk
forall blk (mk :: * -> * -> *).
LedgerSupportsMempool blk =>
LedgerConfig blk
-> TickedLedgerState blk mk
-> MempoolCapacityBytesOverride
-> TxMeasure blk
computeMempoolCapacity LedgerCfg (LedgerState blk)
cfg TickedLedgerState blk TrackingMK
st' MempoolCapacityBytesOverride
capacityOverride
       })
       [Invalidated blk]
err

data RevalidateTxsResult blk =
  RevalidateTxsResult {
     -- | The internal state after revalidation
     forall blk. RevalidateTxsResult blk -> InternalState blk
newInternalState :: !(InternalState blk)
     -- | The previously valid transactions that were now invalid
   , forall blk. RevalidateTxsResult blk -> [Invalidated blk]
removedTxs       :: ![Invalidated blk]
   }

-- | Compute snapshot is largely the same as revalidate the transactions
-- but we ignore the diffs.
computeSnapshot
  :: (LedgerSupportsMempool blk, HasTxId (GenTx blk))
  => MempoolCapacityBytesOverride
  -> LedgerConfig blk
  -> SlotNo
  -> TickedLedgerState blk DiffMK
     -- ^ The ticked ledger state againt which txs will be revalidated
  -> LedgerTables (LedgerState blk) ValuesMK
     -- ^ The tables with all the inputs for the transactions
  -> TicketNo -- ^ 'isLastTicketNo' and 'vrLastTicketNo'
  -> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
  -> MempoolSnapshot blk
computeSnapshot :: forall blk.
(LedgerSupportsMempool blk, HasTxId (GenTx blk)) =>
MempoolCapacityBytesOverride
-> LedgerConfig blk
-> SlotNo
-> TickedLedgerState blk DiffMK
-> LedgerTables (LedgerState blk) ValuesMK
-> TicketNo
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> MempoolSnapshot blk
computeSnapshot MempoolCapacityBytesOverride
capacityOverride LedgerCfg (LedgerState blk)
cfg SlotNo
slot TickedLedgerState blk DiffMK
st LedgerTables (LedgerState blk) ValuesMK
values TicketNo
lastTicketNo [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
txTickets =
  let theTxs :: [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
theTxs = (TxTicket (TxMeasure blk) (Validated (GenTx blk))
 -> (Validated (GenTx blk), (TicketNo, TxMeasure blk)))
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
forall a b. (a -> b) -> [a] -> [b]
map TxTicket (TxMeasure blk) (Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
forall {b} {a}. TxTicket b a -> (a, (TicketNo, b))
wrap [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
txTickets
      wrap :: TxTicket b a -> (a, (TicketNo, b))
wrap = (\(TxTicket a
tx TicketNo
tk b
tz) -> (a
tx, (TicketNo
tk, b
tz)))
      unwrap :: (tx, (TicketNo, sz)) -> TxTicket sz tx
unwrap = (\(tx
tx, (TicketNo
tk, sz
tz)) -> tx -> TicketNo -> sz -> TxTicket sz tx
forall sz tx. tx -> TicketNo -> sz -> TxTicket sz tx
TxTicket tx
tx TicketNo
tk sz
tz)
      ReapplyTxsResult [Invalidated blk]
_ [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val TickedLedgerState blk TrackingMK
st' =
        ComputeDiffs
-> LedgerCfg (LedgerState blk)
-> SlotNo
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult (TicketNo, TxMeasure blk) blk
forall blk extra.
LedgerSupportsMempool blk =>
ComputeDiffs
-> LedgerConfig blk
-> SlotNo
-> [(Validated (GenTx blk), extra)]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult extra blk
forall extra.
ComputeDiffs
-> LedgerCfg (LedgerState blk)
-> SlotNo
-> [(Validated (GenTx blk), extra)]
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult extra blk
reapplyTxs ComputeDiffs
IgnoreDiffs LedgerCfg (LedgerState blk)
cfg SlotNo
slot [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
theTxs
        (TickedLedgerState blk ValuesMK
 -> ReapplyTxsResult (TicketNo, TxMeasure blk) blk)
-> TickedLedgerState blk ValuesMK
-> ReapplyTxsResult (TicketNo, TxMeasure blk) blk
forall a b. (a -> b) -> a -> b
$ LedgerTables (LedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) KeysMK
-> TickedLedgerState blk DiffMK
-> TickedLedgerState blk ValuesMK
forall blk.
LedgerSupportsMempool blk =>
LedgerTables (LedgerState blk) ValuesMK
-> LedgerTables (LedgerState blk) KeysMK
-> TickedLedgerState blk DiffMK
-> TickedLedgerState blk ValuesMK
applyMempoolDiffs
              LedgerTables (LedgerState blk) ValuesMK
values
              (((Validated (GenTx blk), (TicketNo, TxMeasure blk))
 -> LedgerTables (LedgerState blk) KeysMK)
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> LedgerTables (LedgerState blk) KeysMK
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap' (GenTx blk -> LedgerTables (LedgerState blk) KeysMK
forall blk.
LedgerSupportsMempool blk =>
GenTx blk -> LedgerTables (LedgerState blk) KeysMK
getTransactionKeySets (GenTx blk -> LedgerTables (LedgerState blk) KeysMK)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> GenTx blk)
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> LedgerTables (LedgerState blk) KeysMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (Validated (GenTx blk) -> GenTx blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTx blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> Validated (GenTx blk)
forall a b. (a, b) -> a
fst) [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
theTxs)
              TickedLedgerState blk DiffMK
st

  in InternalState blk -> MempoolSnapshot blk
forall blk.
(HasTxId (GenTx blk), TxLimits blk,
 GetTip (TickedLedgerState blk)) =>
InternalState blk -> MempoolSnapshot blk
snapshotFromIS (InternalState blk -> MempoolSnapshot blk)
-> InternalState blk -> MempoolSnapshot blk
forall a b. (a -> b) -> a -> b
$ IS {
         isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs          = [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall sz tx. Measure sz => [TxTicket sz tx] -> TxSeq sz tx
TxSeq.fromList ([TxTicket (TxMeasure blk) (Validated (GenTx blk))]
 -> TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall a b. (a -> b) -> a -> b
$ ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
 -> TxTicket (TxMeasure blk) (Validated (GenTx blk)))
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
forall a b. (a -> b) -> [a] -> [b]
map (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> TxTicket (TxMeasure blk) (Validated (GenTx blk))
forall {tx} {sz}. (tx, (TicketNo, sz)) -> TxTicket sz tx
unwrap [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val
       , isTxIds :: Set (GenTxId blk)
isTxIds        = [GenTxId blk] -> Set (GenTxId blk)
forall a. Ord a => [a] -> Set a
Set.fromList ([GenTxId blk] -> Set (GenTxId blk))
-> [GenTxId blk] -> Set (GenTxId blk)
forall a b. (a -> b) -> a -> b
$ ((Validated (GenTx blk), (TicketNo, TxMeasure blk)) -> GenTxId blk)
-> [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
-> [GenTxId blk]
forall a b. (a -> b) -> [a] -> [b]
map (GenTx blk -> GenTxId blk
forall tx. HasTxId tx => tx -> TxId tx
txId (GenTx blk -> GenTxId blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> GenTx blk)
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTxId blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated (Validated (GenTx blk) -> GenTx blk)
-> ((Validated (GenTx blk), (TicketNo, TxMeasure blk))
    -> Validated (GenTx blk))
-> (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> GenTx blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Validated (GenTx blk), (TicketNo, TxMeasure blk))
-> Validated (GenTx blk)
forall a b. (a, b) -> a
fst) [(Validated (GenTx blk), (TicketNo, TxMeasure blk))]
val
         -- These two can be empty since we don't need the resulting
         -- values at all when making a snapshot, as we won't update
         -- the internal state.
       , isTxKeys :: LedgerTables (LedgerState blk) KeysMK
isTxKeys       = LedgerTables (LedgerState blk) KeysMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
       , isTxValues :: LedgerTables (LedgerState blk) ValuesMK
isTxValues     = LedgerTables (LedgerState blk) ValuesMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
       , isLedgerState :: TickedLedgerState blk DiffMK
isLedgerState  = TickedLedgerState blk TrackingMK -> TickedLedgerState blk DiffMK
forall (l :: LedgerStateKind).
(HasLedgerTables l, LedgerTableConstraints l) =>
l TrackingMK -> l DiffMK
trackingToDiffs TickedLedgerState blk TrackingMK
st'
       , isTip :: Point blk
isTip          = Point (TickedLedgerState blk) -> Point blk
forall {k1} {k2} (b :: k1) (b' :: k2).
Coercible (HeaderHash b) (HeaderHash b') =>
Point b -> Point b'
castPoint (Point (TickedLedgerState blk) -> Point blk)
-> Point (TickedLedgerState blk) -> Point blk
forall a b. (a -> b) -> a -> b
$ TickedLedgerState blk DiffMK -> Point (TickedLedgerState blk)
forall (mk :: * -> * -> *).
Ticked (LedgerState blk) mk -> Point (TickedLedgerState blk)
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
GetTip l =>
l mk -> Point l
getTip TickedLedgerState blk DiffMK
st
       , isSlotNo :: SlotNo
isSlotNo       = SlotNo
slot
       , isLastTicketNo :: TicketNo
isLastTicketNo = TicketNo
lastTicketNo
       , isCapacity :: TxMeasure blk
isCapacity     = LedgerCfg (LedgerState blk)
-> TickedLedgerState blk TrackingMK
-> MempoolCapacityBytesOverride
-> TxMeasure blk
forall blk (mk :: * -> * -> *).
LedgerSupportsMempool blk =>
LedgerConfig blk
-> TickedLedgerState blk mk
-> MempoolCapacityBytesOverride
-> TxMeasure blk
computeMempoolCapacity LedgerCfg (LedgerState blk)
cfg TickedLedgerState blk TrackingMK
st' MempoolCapacityBytesOverride
capacityOverride
       }

{-------------------------------------------------------------------------------
  Conversions
-------------------------------------------------------------------------------}

-- | Create a Mempool Snapshot from a given Internal State of the mempool.
snapshotFromIS :: forall blk.
     (HasTxId (GenTx blk), TxLimits blk, GetTip (TickedLedgerState blk))
  => InternalState blk
  -> MempoolSnapshot blk
snapshotFromIS :: forall blk.
(HasTxId (GenTx blk), TxLimits blk,
 GetTip (TickedLedgerState blk)) =>
InternalState blk -> MempoolSnapshot blk
snapshotFromIS InternalState blk
is = MempoolSnapshot {
      snapshotTxs :: [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxs         = InternalState blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
implSnapshotGetTxs         InternalState blk
is
    , snapshotTxsAfter :: TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxsAfter    = InternalState blk
-> TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
implSnapshotGetTxsAfter    InternalState blk
is
    , snapshotLookupTx :: TicketNo -> Maybe (Validated (GenTx blk))
snapshotLookupTx    = InternalState blk -> TicketNo -> Maybe (Validated (GenTx blk))
implSnapshotGetTx          InternalState blk
is
    , snapshotHasTx :: GenTxId blk -> Bool
snapshotHasTx       = InternalState blk -> GenTxId blk -> Bool
implSnapshotHasTx          InternalState blk
is
    , snapshotMempoolSize :: MempoolSize
snapshotMempoolSize = InternalState blk -> MempoolSize
implSnapshotGetMempoolSize InternalState blk
is
    , snapshotSlotNo :: SlotNo
snapshotSlotNo      = InternalState blk -> SlotNo
forall blk. InternalState blk -> SlotNo
isSlotNo                   InternalState blk
is
    , snapshotStateHash :: ChainHash (TickedLedgerState blk)
snapshotStateHash   = TickedLedgerState blk DiffMK -> ChainHash (TickedLedgerState blk)
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
GetTip l =>
l mk -> ChainHash l
getTipHash (TickedLedgerState blk DiffMK -> ChainHash (TickedLedgerState blk))
-> TickedLedgerState blk DiffMK
-> ChainHash (TickedLedgerState blk)
forall a b. (a -> b) -> a -> b
$ InternalState blk -> TickedLedgerState blk DiffMK
forall blk. InternalState blk -> TickedLedgerState blk DiffMK
isLedgerState InternalState blk
is
    , snapshotTake :: TxMeasure blk -> [Validated (GenTx blk)]
snapshotTake        = InternalState blk -> TxMeasure blk -> [Validated (GenTx blk)]
implSnapshotTake           InternalState blk
is
    }
 where
  implSnapshotGetTxs :: InternalState blk
                     -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
  implSnapshotGetTxs :: InternalState blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
implSnapshotGetTxs = (InternalState blk
 -> TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)])
-> TicketNo
-> InternalState blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
forall a b c. (a -> b -> c) -> b -> a -> c
flip InternalState blk
-> TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
implSnapshotGetTxsAfter TicketNo
TxSeq.zeroTicketNo

  implSnapshotGetTxsAfter :: InternalState blk
                          -> TicketNo
                          -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
  implSnapshotGetTxsAfter :: InternalState blk
-> TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
implSnapshotGetTxsAfter IS{TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs} =
    TxSeq (TxMeasure blk) (Validated (GenTx blk))
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
forall sz tx. TxSeq sz tx -> [(tx, TicketNo, sz)]
TxSeq.toTuples (TxSeq (TxMeasure blk) (Validated (GenTx blk))
 -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)])
-> (TicketNo -> TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> TicketNo
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSeq (TxMeasure blk) (Validated (GenTx blk)),
 TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall a b. (a, b) -> b
snd ((TxSeq (TxMeasure blk) (Validated (GenTx blk)),
  TxSeq (TxMeasure blk) (Validated (GenTx blk)))
 -> TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> (TicketNo
    -> (TxSeq (TxMeasure blk) (Validated (GenTx blk)),
        TxSeq (TxMeasure blk) (Validated (GenTx blk))))
-> TicketNo
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq (TxMeasure blk) (Validated (GenTx blk))
-> TicketNo
-> (TxSeq (TxMeasure blk) (Validated (GenTx blk)),
    TxSeq (TxMeasure blk) (Validated (GenTx blk)))
forall sz tx.
Measure sz =>
TxSeq sz tx -> TicketNo -> (TxSeq sz tx, TxSeq sz tx)
TxSeq.splitAfterTicketNo TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs

  implSnapshotTake :: InternalState blk
                   -> TxMeasure blk
                   -> [Validated (GenTx blk)]
  implSnapshotTake :: InternalState blk -> TxMeasure blk -> [Validated (GenTx blk)]
implSnapshotTake IS{TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs} =
    (TxTicket (TxMeasure blk) (Validated (GenTx blk))
 -> Validated (GenTx blk))
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
-> [Validated (GenTx blk)]
forall a b. (a -> b) -> [a] -> [b]
map TxTicket (TxMeasure blk) (Validated (GenTx blk))
-> Validated (GenTx blk)
forall sz tx. TxTicket sz tx -> tx
TxSeq.txTicketTx ([TxTicket (TxMeasure blk) (Validated (GenTx blk))]
 -> [Validated (GenTx blk)])
-> (TxMeasure blk
    -> [TxTicket (TxMeasure blk) (Validated (GenTx blk))])
-> TxMeasure blk
-> [Validated (GenTx blk)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq (TxMeasure blk) (Validated (GenTx blk))
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
forall sz tx. TxSeq sz tx -> [TxTicket sz tx]
TxSeq.toList (TxSeq (TxMeasure blk) (Validated (GenTx blk))
 -> [TxTicket (TxMeasure blk) (Validated (GenTx blk))])
-> (TxMeasure blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> TxMeasure blk
-> [TxTicket (TxMeasure blk) (Validated (GenTx blk))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TxSeq (TxMeasure blk) (Validated (GenTx blk)),
 TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall a b. (a, b) -> a
fst ((TxSeq (TxMeasure blk) (Validated (GenTx blk)),
  TxSeq (TxMeasure blk) (Validated (GenTx blk)))
 -> TxSeq (TxMeasure blk) (Validated (GenTx blk)))
-> (TxMeasure blk
    -> (TxSeq (TxMeasure blk) (Validated (GenTx blk)),
        TxSeq (TxMeasure blk) (Validated (GenTx blk))))
-> TxMeasure blk
-> TxSeq (TxMeasure blk) (Validated (GenTx blk))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxSeq (TxMeasure blk) (Validated (GenTx blk))
-> TxMeasure blk
-> (TxSeq (TxMeasure blk) (Validated (GenTx blk)),
    TxSeq (TxMeasure blk) (Validated (GenTx blk)))
forall sz tx.
Measure sz =>
TxSeq sz tx -> sz -> (TxSeq sz tx, TxSeq sz tx)
TxSeq.splitAfterTxSize TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs

  implSnapshotGetTx :: InternalState blk
                    -> TicketNo
                    -> Maybe (Validated (GenTx blk))
  implSnapshotGetTx :: InternalState blk -> TicketNo -> Maybe (Validated (GenTx blk))
implSnapshotGetTx IS{TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: forall blk.
InternalState blk -> TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs :: TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs} = (TxSeq (TxMeasure blk) (Validated (GenTx blk))
isTxs TxSeq (TxMeasure blk) (Validated (GenTx blk))
-> TicketNo -> Maybe (Validated (GenTx blk))
forall sz tx. Measure sz => TxSeq sz tx -> TicketNo -> Maybe tx
`TxSeq.lookupByTicketNo`)

  implSnapshotHasTx :: InternalState blk
                    -> GenTxId blk
                    -> Bool
  implSnapshotHasTx :: InternalState blk -> GenTxId blk -> Bool
implSnapshotHasTx IS{Set (GenTxId blk)
isTxIds :: forall blk. InternalState blk -> Set (GenTxId blk)
isTxIds :: Set (GenTxId blk)
isTxIds} = (GenTxId blk -> Set (GenTxId blk) -> Bool)
-> Set (GenTxId blk) -> GenTxId blk -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip GenTxId blk -> Set (GenTxId blk) -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Set (GenTxId blk)
isTxIds

  implSnapshotGetMempoolSize :: InternalState blk
                             -> MempoolSize
  implSnapshotGetMempoolSize :: InternalState blk -> MempoolSize
implSnapshotGetMempoolSize = InternalState blk -> MempoolSize
forall blk. TxLimits blk => InternalState blk -> MempoolSize
isMempoolSize

{-------------------------------------------------------------------------------
  Tracing support for the mempool operations
-------------------------------------------------------------------------------}

-- | Events traced by the Mempool.
data TraceEventMempool blk
  = TraceMempoolAddedTx
      (Validated (GenTx blk))
      -- ^ New, valid transaction that was added to the Mempool.
      MempoolSize
      -- ^ The size of the Mempool before adding the transaction.
      MempoolSize
      -- ^ The size of the Mempool after adding the transaction.
  | TraceMempoolRejectedTx
      (GenTx blk)
      -- ^ New, invalid transaction thas was rejected and thus not added to
      -- the Mempool.
      (ApplyTxErr blk)
      -- ^ The reason for rejecting the transaction.
      MempoolSize
      -- ^ The current size of the Mempool.
  | TraceMempoolRemoveTxs
      [(Validated (GenTx blk), ApplyTxErr blk)]
      -- ^ Previously valid transactions that are no longer valid because of
      -- changes in the ledger state (details are in the provided 'ApplyTxErr').
      -- These transactions have been removed from the Mempool.
      MempoolSize
      -- ^ The current size of the Mempool.
  | TraceMempoolManuallyRemovedTxs
      (NE.NonEmpty (GenTxId blk))
      -- ^ Transactions that have been manually removed from the Mempool.
      [Validated (GenTx blk)]
      -- ^ Previously valid transactions that are no longer valid because they
      -- dependend on transactions that were manually removed from the
      -- Mempool. These transactions have also been removed from the Mempool.
      --
      -- This list shares not transactions with the list of manually removed
      -- transactions.
      MempoolSize
      -- ^ The current size of the Mempool.
   | TraceMempoolSynced
      -- ^ Emitted when the mempool is adjusted after the tip has changed.
      EnclosingTimed
      -- ^ How long the sync operation took.

     -- | A sync is not needed, as the point at the tip of the LedgerDB and the
     -- point at the mempool are the same.
   | TraceMempoolSyncNotNeeded (Point blk)
     -- | We will try to add a transaction. Adding a transaction might need to
     -- trigger a re-sync.
   | TraceMempoolAttemptingAdd (GenTx blk)
     -- | When adding a transaction, the ledger state in the mempool was found
     -- in the LedgerDB, and therefore we can read values, even if it is not the
     -- tip of the LedgerDB. An async re-sync will be performed eventually in
     -- that case.
   | TraceMempoolLedgerFound (Point blk)
     -- | When adding a transaction, the ledger state in the mempool is gone
     -- from the LedgerDB, so we cannot read values for the new
     -- transaction. This forces an in-place re-sync.
   | TraceMempoolLedgerNotFound (Point blk)
  deriving ((forall x. TraceEventMempool blk -> Rep (TraceEventMempool blk) x)
-> (forall x.
    Rep (TraceEventMempool blk) x -> TraceEventMempool blk)
-> Generic (TraceEventMempool blk)
forall x. Rep (TraceEventMempool blk) x -> TraceEventMempool blk
forall x. TraceEventMempool blk -> Rep (TraceEventMempool blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TraceEventMempool blk) x -> TraceEventMempool blk
forall blk x.
TraceEventMempool blk -> Rep (TraceEventMempool blk) x
$cfrom :: forall blk x.
TraceEventMempool blk -> Rep (TraceEventMempool blk) x
from :: forall x. TraceEventMempool blk -> Rep (TraceEventMempool blk) x
$cto :: forall blk x.
Rep (TraceEventMempool blk) x -> TraceEventMempool blk
to :: forall x. Rep (TraceEventMempool blk) x -> TraceEventMempool blk
Generic)

deriving instance ( Eq (GenTx blk)
                  , Eq (Validated (GenTx blk))
                  , Eq (GenTxId blk)
                  , Eq (ApplyTxErr blk)
                  , StandardHash blk
                  ) => Eq (TraceEventMempool blk)

deriving instance ( Show (GenTx blk)
                  , Show (Validated (GenTx blk))
                  , Show (GenTxId blk)
                  , Show (ApplyTxErr blk)
                  , StandardHash blk
                  ) => Show (TraceEventMempool blk)