{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Exposes the @'Mempool'@ datatype which captures the public API of the
-- Mempool. Also exposes all the types used to interact with said API.
--
-- The interface is then initialized in "Ouroboros.Consensus.Mempool.Init" with
-- the functions from "Ouroboros.Consensus.Mempool.Update" and
-- "Ouroboros.Consensus.Mempool.Query".
module Ouroboros.Consensus.Mempool.API
  ( -- * Mempool
    Mempool (..)
  , MempoolTimeoutConfig (..)
  , ExnMempoolTimeout (..)

    -- * Transaction adding
  , AddTxOnBehalfOf (..)
  , MempoolAddTxResult (..)
  , addLocalTxs
  , addTxs
  , isMempoolTxAdded
  , isMempoolTxRejected
  , mempoolTxAddedToMaybe

    -- * Ledger state to forge on top of
  , ForgeLedgerState (..)

    -- * Mempool Snapshot
  , DiffTimeMeasure (..)
  , MempoolSnapshot (..)
  , TxMeasureWithDiffTime (..)
  , forgetTxMeasureWithDiffTime

    -- * Re-exports
  , SizeInBytes
  , TicketNo
  , zeroTicketNo
  ) where

import Control.ResourceRegistry
import Data.DerivingVia (InstantiatedAt (..))
import qualified Data.List.NonEmpty as NE
import Data.Measure (Measure)
import qualified Data.Measure
import GHC.Generics (Generic)
import NoThunks.Class
import Ouroboros.Consensus.Block (ChainHash, Point, SlotNo)
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.SupportsMempool
import qualified Ouroboros.Consensus.Mempool.Capacity as Cap
import Ouroboros.Consensus.Mempool.TxSeq (TicketNo, zeroTicketNo)
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Network.Protocol.TxSubmission2.Type (SizeInBytes)

{-------------------------------------------------------------------------------
  Mempool API
-------------------------------------------------------------------------------}

-- | Mempool
--
-- The mempool is the set of transactions that should be included in the next
-- block. In principle this is a /set/ of all the transactions that we receive
-- from our peers. In order to avoid flooding the network with invalid
-- transactions, however, we only want to keep /valid/ transactions in the
-- mempool. That raises the question: valid with respect to which ledger state?
--
-- We opt for a very simple answer to this: the mempool will be interpreted
-- as a /list/ of transactions; which are validated strictly in order, starting
-- from the current ledger state. This has a number of advantages:
--
-- * It's simple to implement and it's efficient. In particular, no search for
--   a valid subset is ever required.
-- * When producing a block, we can simply take the longest possible prefix
--   of transactions that fits in a block.
-- * It supports wallets that submit dependent transactions (where later
--   transaction depends on outputs from earlier ones).
--
-- The mempool provides fairness guarantees for the case of multiple threads
-- performing 'addTx' concurrently. Implementations of this interface must
-- provide this guarantee, and users of this interface may rely on it.
-- Specifically, multiple threads that continuously use 'addTx' will, over
-- time, get a share of the mempool resource (measured by the number of txs
-- only, not their sizes) roughly proportional to their \"weight\". The weight
-- depends on the 'AddTxOnBehalfOf': either acting on behalf of remote peers
-- ('AddTxForRemotePeer') or on behalf of a local client
-- ('AddTxForLocalClient'). The weighting for threads acting on behalf of
-- remote peers is the same for all remote peers, so all remote peers will get
-- a roughly equal share of the resource. The weighting for local clients is
-- the same for all local clients but /may/ be higher than the weighting for
-- remote peers. The weighting is not unboundedly higher however, so there is
-- still (weighted) fairness between remote peers and local clients. Thus
-- local clients will also get a roughly equal share of the resource, but that
-- share may be strictly greater than the share for each remote peer.
-- Furthermore, this implies local clients cannot starve remote peers, despite
-- their higher weighting.
--
-- This fairness specification in terms of weighting is deliberately
-- non-specific, which allows multiple strategies. The existing default
-- strategy (for the implementation in "Ouroboros.Consensus.Mempool") is as
-- follows. The design uses two FIFOs, to give strictly in-order behaviour.
-- All remote peers get equal weight and all local clients get equal weight.
-- The relative weight between remote and local is that if there are N remote
-- peers and M local clients, each local client gets weight 1/(M+1), while all
-- of the N remote peers together also get total weight 1/(M+1). This means
-- individual remote peers get weight 1/(N * (M+1)). Intuitively: a single local
-- client has the same weight as all the remote peers put together.
data Mempool m blk = Mempool
  { forall (m :: * -> *) blk.
Mempool m blk
-> AddTxOnBehalfOf -> GenTx blk -> m (MempoolAddTxResult blk)
addTx ::
      AddTxOnBehalfOf ->
      GenTx blk ->
      m (MempoolAddTxResult blk)
  -- ^ Add a single transaction to the mempool.
  --
  -- The new transaction provided will be validated, /in order/, against
  -- the ledger state obtained by applying all the transactions already in
  -- the mempool. Transactions which are found to be invalid are dropped,
  -- whereas valid transactions are added to the mempool.
  --
  -- Note that transactions that are invalid will /never/ be added to the
  -- mempool. However, it is possible that, at a given point in time,
  -- transactions which were valid in an older ledger state but are invalid in
  -- the current ledger state, could exist within the mempool until they are
  -- revalidated and dropped from the mempool via a call to by the background
  -- thread that watches the ledger for changes or by 'testSyncWithLedger' in
  -- testing scenarios.
  --
  -- This action returns one of two results.
  --
  --  * A 'MempoolTxAdded' value if the transaction provided was found to
  --    be valid. This transactions is now in the mempool.
  --
  --  * A 'MempoolTxRejected' value if the transaction provided was found
  --    to be invalid, along with its accompanying validation errors. This
  --    transactions is not in the mempool.
  --
  -- Note that this is a blocking action. It will block until the
  -- transaction fits into the mempool. This includes transactions that
  -- turn out to be invalid: the action waits for there to be space for
  -- the transaction before validation is attempted.
  --
  -- Note that it is safe to use this from multiple threads concurrently.
  --
  -- POSTCONDITION:
  -- > let prj = \case
  -- >       MempoolTxAdded vtx        -> txForgetValidated vtx
  -- >       MempoolTxRejected tx _err -> tx
  -- > processed <- addTx wti txs
  -- > prj processed == tx
  --
  -- In principle it is possible that validation errors are transient; for
  -- example, it is possible that a transaction is rejected because one of
  -- its inputs is not /yet/ available in the UTxO (the transaction it
  -- depends on is not yet in the chain, nor in the mempool). In practice
  -- however it is likely that rejected transactions will still be
  -- rejected later, and should just be dropped.
  --
  -- It is important to note one important special case of transactions
  -- being "invalid": a transaction will /also/ be considered invalid if
  -- /that very same transaction/ is already included on the blockchain
  -- (after all, by definition that must mean its inputs have been used).
  -- Rejected transactions are therefore not necessarily a sign of
  -- malicious behaviour. Indeed, we would expect /most/ transactions that
  -- are reported as invalid by 'addTxs' to be invalid precisely because
  -- they have already been included. Distinguishing between these two
  -- cases can be done in theory, but it is expensive unless we have an
  -- index of transaction hashes that have been included on the blockchain.
  --
  -- As long as we keep the mempool entirely in-memory this could live in
  -- @STM m@; we keep it in @m@ instead to leave open the possibility of
  -- persistence.
  , forall (m :: * -> *) blk.
Mempool m blk -> NonEmpty (GenTxId blk) -> m ()
removeTxsEvenIfValid :: NE.NonEmpty (GenTxId blk) -> m ()
  -- ^ Manually remove the given transactions from the mempool.
  , forall (m :: * -> *) blk.
Mempool m blk -> STM m (MempoolSnapshot blk)
getSnapshot :: STM m (MempoolSnapshot blk)
  -- ^ Get a snapshot of the current mempool state. This allows for
  -- further pure queries on the snapshot.
  --
  -- This doesn't look at the ledger state at all.
  , forall (m :: * -> *) blk.
Mempool m blk
-> SlotNo
-> TickedLedgerState blk DiffMK
-> (LedgerTables (LedgerState blk) KeysMK
    -> m (LedgerTables (LedgerState blk) ValuesMK))
-> m (MempoolSnapshot blk)
getSnapshotFor ::
      SlotNo ->
      TickedLedgerState blk DiffMK ->
      (LedgerTables (LedgerState blk) KeysMK -> m (LedgerTables (LedgerState blk) ValuesMK)) ->
      m (MempoolSnapshot blk)
  -- ^ Get a snapshot of the mempool state that is valid with respect to
  -- the given ledger state
  --
  -- This does not update the state of the mempool.
  --
  -- The arguments:
  --
  -- - The current slot in which we want the snapshot
  --
  -- - The ledger state ticked to the given slot number (with the diffs from ticking)
  --
  -- - A function that reads values for keys at the unticked ledger state.
  , forall (m :: * -> *) blk. Mempool m blk -> STM m (TxMeasure blk)
getCapacity :: STM m (TxMeasure blk)
  -- ^ Get the mempool's capacity
  --
  -- Note that the capacity of the Mempool, unless it is overridden with
  -- 'MempoolCapacityBytesOverride', can dynamically change when the ledger
  -- state is updated: it will be set to twice the current ledger's maximum
  -- transaction capacity of a block.
  --
  -- When the capacity happens to shrink at some point, we /do not/ remove
  -- transactions from the Mempool to satisfy this new lower limit.
  -- Instead, we treat it the same way as a Mempool which is /at/
  -- capacity, i.e., we won't admit new transactions until some have been
  -- removed because they have become invalid.
  --
  -- This capacity excludes the `mempoolTimeoutCapacity`.
  , forall (m :: * -> *) blk.
Mempool m blk -> forall a. String -> m a -> m (Thread m a)
testForkMempoolThread :: forall a. String -> m a -> m (Thread m a)
  -- ^ FOR TESTS ONLY
  --
  -- If we want to run a thread that can perform syncs in the mempool, it needs
  -- to be registered in the mempool's internal registry. This function exposes
  -- such functionality.
  --
  -- The 'String' passed will be used as the thread label, and the @m a@ will be
  -- the action forked in the thread.
  , forall (m :: * -> *) blk.
Mempool m blk
-> DiffTime
-> AddTxOnBehalfOf
-> GenTx blk
-> m (Maybe (MempoolAddTxResult blk))
testTryAddTx ::
      DiffTime ->
      AddTxOnBehalfOf ->
      GenTx blk ->
      m (Maybe (MempoolAddTxResult blk))
  -- ^ ONLY FOR TESTS
  --
  -- This is exactly 'addTx' except for two differences. First, it also accepts
  -- the amount of wallclock the test suite's model is assuming that the tx
  -- takes to validate and then uses a 'threadDelay' call to inflate the actual
  -- duration to match. It can't help if validation actually took longer than
  -- intended, so avoid small intended durations. Also, avoid durations near
  -- the soft and hard timeout, since their is plenty of inaccuracy. Second,
  -- this function immediately returns 'Nothing' when the tx cannot fit instead
  -- of trying again.
  , forall (m :: * -> *) blk. Mempool m blk -> m (MempoolSnapshot blk)
testSyncWithLedger :: m (MempoolSnapshot blk)
  -- ^ ONLY FOR TESTS
  --
  -- Sync the transactions in the mempool with the current ledger state
  --  of the 'ChainDB'.
  --
  -- The transactions that exist within the mempool will be revalidated
  -- against the current ledger state. Transactions which are found to be
  -- invalid with respect to the current ledger state, will be dropped
  -- from the mempool, whereas valid transactions will remain.
  --
  -- We keep this in @m@ instead of @STM m@ to leave open the possibility
  -- of persistence. Additionally, this makes it possible to trace the
  -- removal of invalid transactions.
  --
  -- n.b. in our current implementation, when one opens a mempool, we
  -- spawn a thread which performs this action whenever the 'ChainDB' tip
  -- point changes.
  }

-- | This configuration data controls a lightweight "defensive programming"
-- feature in the Mempool.
--
-- The overall Praos design assumes that the 'TxLimits' strongly bounds how
-- much CPU&allocation it will cost to determine whether a given tx is valid or
-- invalid. But the June 2024 incident proved that such performance bugs might
-- can slip through to Cardano @mainnet@. When they do, it'd be desirable for
-- the Mempool to help prevent honest users from making regrettable mistakes
-- (eg the November 2025 incident), at least inconvenience the adversary, etc.
--
-- To be clear: this timeout could never fully protect Cardano @mainnet@ from
-- such performance bugs, since the adversary could always put slow txs
-- directly into their own blocks, circumventing the Mempool entirely. But it
-- at least forces the adversary to have enough stake to issue slow blocks
-- often enough to matter and moreover forces them to public reveal whichever
-- stake pools they use as untrustworthy, since the blocks with slow txs must
-- be well-signed in order to affect the honest nodes.
--
-- Latency spikes (eg GC pauses, snapshot writing, OS sleeping the process,
-- etc) will cause occasional false alarms for this timeout. But we don't
-- expect them to be frequent enough to matter.
data MempoolTimeoutConfig = MempoolTimeoutConfig
  { MempoolTimeoutConfig -> DiffTime
mempoolTimeoutSoft :: DiffTime
  -- ^ If the mempool takes longer than this to validate a tx, then it
  -- discards the tx instead of adding it.
  , MempoolTimeoutConfig -> DiffTime
mempoolTimeoutHard :: DiffTime
  -- ^ If the mempool takes longer than this to validate a tx, then it
  -- disconnects from the peer.
  --
  -- WARNING: if this is less than 'mempoolTimeoutSoft', then
  -- 'mempoolTimeoutSoft' is irrelevant. If it's equal or just barely larger,
  -- then the soft/hard distinction will likely be unreliable.
  , MempoolTimeoutConfig -> DiffTime
mempoolTimeoutCapacity :: DiffTime
  -- ^ If the txs in the mempool took longer than this cumulatively to
  -- validate when each entered the mempool, then the mempool is at capacity,
  -- ie it's full, ie no tx can be added.
  --
  -- A potential minor surprise: unlike the other components of the capacity
  -- (ie those from `TxMeasure`), this component admits one tx above the
  -- given limit. This is unavoidable, because we must not validate a tx
  -- unless it could fit in the mempool but we can't know its validation time
  -- before we validate it. If we validate it and it's less than
  -- 'mempoolTimeoutSoft', then it'd be a waste of resources to ever not add
  -- it.
  --
  -- Therefore, the recommended value of this parameter is @X -
  -- 'mempoolTimeoutSoft'@, where @X@ is the forging thread's limit for how
  -- much of this component it will put into a block.
  --
  -- Latency spikes (eg GC pauses, snapshot writing, OS sleeping the process,
  -- etc) do risk "wasting" this capacity, but only up to
  -- 'mempoolTimeoutSoft' /per/ /validated/ /tx/.
  }
  deriving (MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool
(MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool)
-> (MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool)
-> Eq MempoolTimeoutConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool
== :: MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool
$c/= :: MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool
/= :: MempoolTimeoutConfig -> MempoolTimeoutConfig -> Bool
Eq, Int -> MempoolTimeoutConfig -> ShowS
[MempoolTimeoutConfig] -> ShowS
MempoolTimeoutConfig -> String
(Int -> MempoolTimeoutConfig -> ShowS)
-> (MempoolTimeoutConfig -> String)
-> ([MempoolTimeoutConfig] -> ShowS)
-> Show MempoolTimeoutConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MempoolTimeoutConfig -> ShowS
showsPrec :: Int -> MempoolTimeoutConfig -> ShowS
$cshow :: MempoolTimeoutConfig -> String
show :: MempoolTimeoutConfig -> String
$cshowList :: [MempoolTimeoutConfig] -> ShowS
showList :: [MempoolTimeoutConfig] -> ShowS
Show)

{-------------------------------------------------------------------------------
  Result of adding a transaction to the mempool
-------------------------------------------------------------------------------}

-- | The result of attempting to add a transaction to the mempool.
data MempoolAddTxResult blk
  = -- | The transaction was added to the mempool.
    MempoolTxAdded !(Validated (GenTx blk))
  | -- | The transaction was rejected and could not be added to the mempool
    -- for the specified reason.
    MempoolTxRejected !(GenTx blk) !(ApplyTxErr blk)

deriving instance
  (Eq (GenTx blk), Eq (Validated (GenTx blk)), Eq (ApplyTxErr blk)) => Eq (MempoolAddTxResult blk)
deriving instance
  (Show (GenTx blk), Show (Validated (GenTx blk)), Show (ApplyTxErr blk)) =>
  Show (MempoolAddTxResult blk)

mempoolTxAddedToMaybe :: MempoolAddTxResult blk -> Maybe (Validated (GenTx blk))
mempoolTxAddedToMaybe :: forall blk. MempoolAddTxResult blk -> Maybe (Validated (GenTx blk))
mempoolTxAddedToMaybe (MempoolTxAdded Validated (GenTx blk)
vtx) = Validated (GenTx blk) -> Maybe (Validated (GenTx blk))
forall a. a -> Maybe a
Just Validated (GenTx blk)
vtx
mempoolTxAddedToMaybe MempoolAddTxResult blk
_ = Maybe (Validated (GenTx blk))
forall a. Maybe a
Nothing

isMempoolTxAdded :: MempoolAddTxResult blk -> Bool
isMempoolTxAdded :: forall blk. MempoolAddTxResult blk -> Bool
isMempoolTxAdded MempoolTxAdded{} = Bool
True
isMempoolTxAdded MempoolAddTxResult blk
_ = Bool
False

isMempoolTxRejected :: MempoolAddTxResult blk -> Bool
isMempoolTxRejected :: forall blk. MempoolAddTxResult blk -> Bool
isMempoolTxRejected MempoolTxRejected{} = Bool
True
isMempoolTxRejected MempoolAddTxResult blk
_ = Bool
False

-- | A wrapper around 'addTx' that adds a sequence of transactions on behalf of
-- a remote peer.
--
-- Note that transactions are added one by one, and can interleave with other
-- concurrent threads using 'addTx'.
--
-- See 'addTx' for further details.
addTxs ::
  forall m blk t.
  (MonadSTM m, Traversable t) =>
  Mempool m blk ->
  t (GenTx blk) ->
  m (t (MempoolAddTxResult blk))
addTxs :: forall (m :: * -> *) blk (t :: * -> *).
(MonadSTM m, Traversable t) =>
Mempool m blk -> t (GenTx blk) -> m (t (MempoolAddTxResult blk))
addTxs Mempool m blk
mempool = (GenTx blk -> m (MempoolAddTxResult blk))
-> t (GenTx blk) -> m (t (MempoolAddTxResult blk))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM (Mempool m blk
-> AddTxOnBehalfOf -> GenTx blk -> m (MempoolAddTxResult blk)
forall (m :: * -> *) blk.
Mempool m blk
-> AddTxOnBehalfOf -> GenTx blk -> m (MempoolAddTxResult blk)
addTx Mempool m blk
mempool AddTxOnBehalfOf
AddTxForRemotePeer)

-- | A wrapper around 'addTx' that adds a sequence of transactions on behalf of
-- a local client. This reports more errors for local clients, see 'Intervene'.
--
-- Note that transactions are added one by one, and can interleave with other
-- concurrent threads using 'addTx'.
--
-- See 'addTx' for further details.
addLocalTxs ::
  forall m blk t.
  (MonadSTM m, Traversable t) =>
  Mempool m blk ->
  t (GenTx blk) ->
  m (t (MempoolAddTxResult blk))
addLocalTxs :: forall (m :: * -> *) blk (t :: * -> *).
(MonadSTM m, Traversable t) =>
Mempool m blk -> t (GenTx blk) -> m (t (MempoolAddTxResult blk))
addLocalTxs Mempool m blk
mempool = (GenTx blk -> m (MempoolAddTxResult blk))
-> t (GenTx blk) -> m (t (MempoolAddTxResult blk))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> t a -> m (t b)
mapM (Mempool m blk
-> AddTxOnBehalfOf -> GenTx blk -> m (MempoolAddTxResult blk)
forall (m :: * -> *) blk.
Mempool m blk
-> AddTxOnBehalfOf -> GenTx blk -> m (MempoolAddTxResult blk)
addTx Mempool m blk
mempool AddTxOnBehalfOf
AddTxForLocalClient)

-- | Who are we adding a tx on behalf of, a remote peer or a local client?
--
-- This affects two things:
--
-- 1. how certain errors are treated: we want to be helpful to local clients.
-- 2. priority of service: local clients are prioritised over remote peers.
--
-- See 'Mempool' for a discussion of fairness and priority.
data AddTxOnBehalfOf = AddTxForRemotePeer | AddTxForLocalClient

{-------------------------------------------------------------------------------
  Ledger state considered for forging
-------------------------------------------------------------------------------}

-- | The ledger state wrt to which we should produce a block
--
-- The transactions in the mempool will be part of the body of a block, but a
-- block consists of a header and a body, and the full validation of a block
-- consists of first processing its header and only then processing the body.
-- This is important, because processing the header may change the state of the
-- ledger: the update system might be updated, scheduled delegations might be
-- applied, etc., and such changes should take effect before we validate any
-- transactions.
data ForgeLedgerState blk
  = -- | The slot number of the block is known
    --
    -- This will only be the case when we realized that we are the slot leader
    -- and we are actually producing a block. It is the caller's responsibility
    -- to call 'applyChainTick' and produce the ticked ledger state.
    ForgeInKnownSlot SlotNo (TickedLedgerState blk DiffMK)
  | -- | The slot number of the block is not yet known
    --
    -- When we are validating transactions before we know in which block they
    -- will end up, we have to make an assumption about which slot number to use
    -- for 'applyChainTick' to prepare the ledger state; we will assume that
    -- they will end up in the slot after the slot at the tip of the ledger.
    ForgeInUnknownSlot (LedgerState blk EmptyMK)

{-------------------------------------------------------------------------------
  Snapshot of the mempool
-------------------------------------------------------------------------------}

-- | A pure snapshot of the contents of the mempool. It allows fetching
-- information about transactions in the mempool, and fetching individual
-- transactions.
--
-- This uses a transaction sequence number type for identifying transactions
-- within the mempool sequence. The sequence number is local to this mempool,
-- unlike the transaction hash. This allows us to ask for all transactions
-- after a known sequence number, to get new transactions. It is also used to
-- look up individual transactions.
--
-- Note that it is expected that 'getTx' will often return 'Nothing'
-- even for tx sequence numbers returned in previous snapshots. This happens
-- when the transaction has been removed from the mempool between snapshots.
data MempoolSnapshot blk = MempoolSnapshot
  { forall blk.
MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxs :: [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
  -- ^ Get all transactions (oldest to newest) in the mempool snapshot along
  -- with their ticket number.
  , forall blk.
MempoolSnapshot blk
-> TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxsAfter :: TicketNo -> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
  -- ^ Get all transactions (oldest to newest) in the mempool snapshot,
  -- along with their ticket number, which are associated with a ticket
  -- number greater than the one provided.
  , forall blk.
MempoolSnapshot blk
-> TxMeasure blk
-> ([Validated (GenTx blk)], TxMeasureWithDiffTime blk)
snapshotTake :: TxMeasure blk -> ([Validated (GenTx blk)], TxMeasureWithDiffTime blk)
  -- ^ Get the greatest prefix (oldest to newest) that respects the given
  -- block capacity, and the prefix's total size.
  , forall blk.
MempoolSnapshot blk -> TicketNo -> Maybe (Validated (GenTx blk))
snapshotLookupTx :: TicketNo -> Maybe (Validated (GenTx blk))
  -- ^ Get a specific transaction from the mempool snapshot by its ticket
  -- number, if it exists.
  , forall blk. MempoolSnapshot blk -> GenTxId blk -> Bool
snapshotHasTx :: GenTxId blk -> Bool
  -- ^ Determine whether a specific transaction exists within the mempool
  -- snapshot.
  , forall blk. MempoolSnapshot blk -> MempoolSize
snapshotMempoolSize :: Cap.MempoolSize
  -- ^ Get the size of the mempool snapshot.
  , forall blk. MempoolSnapshot blk -> SlotNo
snapshotSlotNo :: SlotNo
  -- ^ The block number of the "virtual block" under construction
  , forall blk.
MempoolSnapshot blk -> ChainHash (TickedLedgerState blk)
snapshotStateHash :: ChainHash (TickedLedgerState blk)
  -- ^ The resulting state currently in the mempool after applying the
  -- transactions
  , forall blk. MempoolSnapshot blk -> Point blk
snapshotPoint :: Point blk
  }

data TxMeasureWithDiffTime blk = MkTxMeasureWithDiffTime !(TxMeasure blk) !DiffTimeMeasure
  deriving stock (forall x.
 TxMeasureWithDiffTime blk -> Rep (TxMeasureWithDiffTime blk) x)
-> (forall x.
    Rep (TxMeasureWithDiffTime blk) x -> TxMeasureWithDiffTime blk)
-> Generic (TxMeasureWithDiffTime blk)
forall x.
Rep (TxMeasureWithDiffTime blk) x -> TxMeasureWithDiffTime blk
forall x.
TxMeasureWithDiffTime blk -> Rep (TxMeasureWithDiffTime blk) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall blk x.
Rep (TxMeasureWithDiffTime blk) x -> TxMeasureWithDiffTime blk
forall blk x.
TxMeasureWithDiffTime blk -> Rep (TxMeasureWithDiffTime blk) x
$cfrom :: forall blk x.
TxMeasureWithDiffTime blk -> Rep (TxMeasureWithDiffTime blk) x
from :: forall x.
TxMeasureWithDiffTime blk -> Rep (TxMeasureWithDiffTime blk) x
$cto :: forall blk x.
Rep (TxMeasureWithDiffTime blk) x -> TxMeasureWithDiffTime blk
to :: forall x.
Rep (TxMeasureWithDiffTime blk) x -> TxMeasureWithDiffTime blk
Generic

deriving instance Eq (TxMeasure blk) => Eq (TxMeasureWithDiffTime blk)
deriving instance Ord (TxMeasure blk) => Ord (TxMeasureWithDiffTime blk)
deriving instance Show (TxMeasure blk) => Show (TxMeasureWithDiffTime blk)

deriving via
  (InstantiatedAt Measure (TxMeasureWithDiffTime blk))
  instance
    Measure (TxMeasure blk) => Semigroup (TxMeasureWithDiffTime blk)

deriving via
  (InstantiatedAt Measure (TxMeasureWithDiffTime blk))
  instance
    Measure (TxMeasure blk) => Monoid (TxMeasureWithDiffTime blk)

forgetTxMeasureWithDiffTime :: TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime :: forall blk. TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime (MkTxMeasureWithDiffTime TxMeasure blk
x DiffTimeMeasure
_) = TxMeasure blk
x

deriving instance NoThunks (TxMeasure blk) => NoThunks (TxMeasureWithDiffTime blk)

binopViaTuple ::
  ((TxMeasure x, DiffTimeMeasure) -> (TxMeasure y, DiffTimeMeasure) -> (TxMeasure z, DiffTimeMeasure)) ->
  TxMeasureWithDiffTime x ->
  TxMeasureWithDiffTime y ->
  TxMeasureWithDiffTime z
binopViaTuple :: forall x y z.
((TxMeasure x, DiffTimeMeasure)
 -> (TxMeasure y, DiffTimeMeasure)
 -> (TxMeasure z, DiffTimeMeasure))
-> TxMeasureWithDiffTime x
-> TxMeasureWithDiffTime y
-> TxMeasureWithDiffTime z
binopViaTuple (TxMeasure x, DiffTimeMeasure)
-> (TxMeasure y, DiffTimeMeasure) -> (TxMeasure z, DiffTimeMeasure)
f (MkTxMeasureWithDiffTime TxMeasure x
a DiffTimeMeasure
b) (MkTxMeasureWithDiffTime TxMeasure y
p DiffTimeMeasure
q) =
  let (TxMeasure z
x, DiffTimeMeasure
y) = (TxMeasure x, DiffTimeMeasure)
-> (TxMeasure y, DiffTimeMeasure) -> (TxMeasure z, DiffTimeMeasure)
f (TxMeasure x
a, DiffTimeMeasure
b) (TxMeasure y
p, DiffTimeMeasure
q)
   in TxMeasure z -> DiffTimeMeasure -> TxMeasureWithDiffTime z
forall blk.
TxMeasure blk -> DiffTimeMeasure -> TxMeasureWithDiffTime blk
MkTxMeasureWithDiffTime TxMeasure z
x DiffTimeMeasure
y

instance Measure (TxMeasure blk) => Measure (TxMeasureWithDiffTime blk) where
  zero :: TxMeasureWithDiffTime blk
zero = TxMeasure blk -> DiffTimeMeasure -> TxMeasureWithDiffTime blk
forall blk.
TxMeasure blk -> DiffTimeMeasure -> TxMeasureWithDiffTime blk
MkTxMeasureWithDiffTime TxMeasure blk
forall a. Measure a => a
Data.Measure.zero DiffTimeMeasure
forall a. Measure a => a
Data.Measure.zero
  plus :: TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk -> TxMeasureWithDiffTime blk
plus = ((TxMeasure blk, DiffTimeMeasure)
 -> (TxMeasure blk, DiffTimeMeasure)
 -> (TxMeasure blk, DiffTimeMeasure))
-> TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk
forall x y z.
((TxMeasure x, DiffTimeMeasure)
 -> (TxMeasure y, DiffTimeMeasure)
 -> (TxMeasure z, DiffTimeMeasure))
-> TxMeasureWithDiffTime x
-> TxMeasureWithDiffTime y
-> TxMeasureWithDiffTime z
binopViaTuple (TxMeasure blk, DiffTimeMeasure)
-> (TxMeasure blk, DiffTimeMeasure)
-> (TxMeasure blk, DiffTimeMeasure)
forall a. Measure a => a -> a -> a
Data.Measure.plus
  min :: TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk -> TxMeasureWithDiffTime blk
min = ((TxMeasure blk, DiffTimeMeasure)
 -> (TxMeasure blk, DiffTimeMeasure)
 -> (TxMeasure blk, DiffTimeMeasure))
-> TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk
forall x y z.
((TxMeasure x, DiffTimeMeasure)
 -> (TxMeasure y, DiffTimeMeasure)
 -> (TxMeasure z, DiffTimeMeasure))
-> TxMeasureWithDiffTime x
-> TxMeasureWithDiffTime y
-> TxMeasureWithDiffTime z
binopViaTuple (TxMeasure blk, DiffTimeMeasure)
-> (TxMeasure blk, DiffTimeMeasure)
-> (TxMeasure blk, DiffTimeMeasure)
forall a. Measure a => a -> a -> a
Data.Measure.min
  max :: TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk -> TxMeasureWithDiffTime blk
max = ((TxMeasure blk, DiffTimeMeasure)
 -> (TxMeasure blk, DiffTimeMeasure)
 -> (TxMeasure blk, DiffTimeMeasure))
-> TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk
-> TxMeasureWithDiffTime blk
forall x y z.
((TxMeasure x, DiffTimeMeasure)
 -> (TxMeasure y, DiffTimeMeasure)
 -> (TxMeasure z, DiffTimeMeasure))
-> TxMeasureWithDiffTime x
-> TxMeasureWithDiffTime y
-> TxMeasureWithDiffTime z
binopViaTuple (TxMeasure blk, DiffTimeMeasure)
-> (TxMeasure blk, DiffTimeMeasure)
-> (TxMeasure blk, DiffTimeMeasure)
forall a. Measure a => a -> a -> a
Data.Measure.max

instance HasByteSize (TxMeasure blk) => HasByteSize (TxMeasureWithDiffTime blk) where
  txMeasureByteSize :: TxMeasureWithDiffTime blk -> ByteSize32
txMeasureByteSize = TxMeasure blk -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize (TxMeasure blk -> ByteSize32)
-> (TxMeasureWithDiffTime blk -> TxMeasure blk)
-> TxMeasureWithDiffTime blk
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasureWithDiffTime blk -> TxMeasure blk
forall blk. TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime

instance TxMeasureMetrics (TxMeasure blk) => TxMeasureMetrics (TxMeasureWithDiffTime blk) where
  txMeasureMetricTxSizeBytes :: TxMeasureWithDiffTime blk -> ByteSize32
txMeasureMetricTxSizeBytes = TxMeasure blk -> ByteSize32
forall msr. TxMeasureMetrics msr => msr -> ByteSize32
txMeasureMetricTxSizeBytes (TxMeasure blk -> ByteSize32)
-> (TxMeasureWithDiffTime blk -> TxMeasure blk)
-> TxMeasureWithDiffTime blk
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasureWithDiffTime blk -> TxMeasure blk
forall blk. TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime
  txMeasureMetricExUnitsMemory :: TxMeasureWithDiffTime blk -> Natural
txMeasureMetricExUnitsMemory = TxMeasure blk -> Natural
forall msr. TxMeasureMetrics msr => msr -> Natural
txMeasureMetricExUnitsMemory (TxMeasure blk -> Natural)
-> (TxMeasureWithDiffTime blk -> TxMeasure blk)
-> TxMeasureWithDiffTime blk
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasureWithDiffTime blk -> TxMeasure blk
forall blk. TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime
  txMeasureMetricExUnitsSteps :: TxMeasureWithDiffTime blk -> Natural
txMeasureMetricExUnitsSteps = TxMeasure blk -> Natural
forall msr. TxMeasureMetrics msr => msr -> Natural
txMeasureMetricExUnitsSteps (TxMeasure blk -> Natural)
-> (TxMeasureWithDiffTime blk -> TxMeasure blk)
-> TxMeasureWithDiffTime blk
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasureWithDiffTime blk -> TxMeasure blk
forall blk. TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime
  txMeasureMetricRefScriptsSizeBytes :: TxMeasureWithDiffTime blk -> ByteSize32
txMeasureMetricRefScriptsSizeBytes = TxMeasure blk -> ByteSize32
forall msr. TxMeasureMetrics msr => msr -> ByteSize32
txMeasureMetricRefScriptsSizeBytes (TxMeasure blk -> ByteSize32)
-> (TxMeasureWithDiffTime blk -> TxMeasure blk)
-> TxMeasureWithDiffTime blk
-> ByteSize32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxMeasureWithDiffTime blk -> TxMeasure blk
forall blk. TxMeasureWithDiffTime blk -> TxMeasure blk
forgetTxMeasureWithDiffTime

-- | How long it took to validate a valid tx
data DiffTimeMeasure = FiniteDiffTimeMeasure !DiffTime | InfiniteDiffTimeMeasure
  deriving stock (DiffTimeMeasure -> DiffTimeMeasure -> Bool
(DiffTimeMeasure -> DiffTimeMeasure -> Bool)
-> (DiffTimeMeasure -> DiffTimeMeasure -> Bool)
-> Eq DiffTimeMeasure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DiffTimeMeasure -> DiffTimeMeasure -> Bool
== :: DiffTimeMeasure -> DiffTimeMeasure -> Bool
$c/= :: DiffTimeMeasure -> DiffTimeMeasure -> Bool
/= :: DiffTimeMeasure -> DiffTimeMeasure -> Bool
Eq, (forall x. DiffTimeMeasure -> Rep DiffTimeMeasure x)
-> (forall x. Rep DiffTimeMeasure x -> DiffTimeMeasure)
-> Generic DiffTimeMeasure
forall x. Rep DiffTimeMeasure x -> DiffTimeMeasure
forall x. DiffTimeMeasure -> Rep DiffTimeMeasure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DiffTimeMeasure -> Rep DiffTimeMeasure x
from :: forall x. DiffTimeMeasure -> Rep DiffTimeMeasure x
$cto :: forall x. Rep DiffTimeMeasure x -> DiffTimeMeasure
to :: forall x. Rep DiffTimeMeasure x -> DiffTimeMeasure
Generic, Int -> DiffTimeMeasure -> ShowS
[DiffTimeMeasure] -> ShowS
DiffTimeMeasure -> String
(Int -> DiffTimeMeasure -> ShowS)
-> (DiffTimeMeasure -> String)
-> ([DiffTimeMeasure] -> ShowS)
-> Show DiffTimeMeasure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DiffTimeMeasure -> ShowS
showsPrec :: Int -> DiffTimeMeasure -> ShowS
$cshow :: DiffTimeMeasure -> String
show :: DiffTimeMeasure -> String
$cshowList :: [DiffTimeMeasure] -> ShowS
showList :: [DiffTimeMeasure] -> ShowS
Show)
  deriving anyclass Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo)
Proxy DiffTimeMeasure -> String
(Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo))
-> (Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo))
-> (Proxy DiffTimeMeasure -> String)
-> NoThunks DiffTimeMeasure
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo)
noThunks :: Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> DiffTimeMeasure -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy DiffTimeMeasure -> String
showTypeOf :: Proxy DiffTimeMeasure -> String
NoThunks
  deriving
    (Semigroup DiffTimeMeasure
DiffTimeMeasure
Semigroup DiffTimeMeasure =>
DiffTimeMeasure
-> (DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure)
-> ([DiffTimeMeasure] -> DiffTimeMeasure)
-> Monoid DiffTimeMeasure
[DiffTimeMeasure] -> DiffTimeMeasure
DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
$cmempty :: DiffTimeMeasure
mempty :: DiffTimeMeasure
$cmappend :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
mappend :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
$cmconcat :: [DiffTimeMeasure] -> DiffTimeMeasure
mconcat :: [DiffTimeMeasure] -> DiffTimeMeasure
Monoid, NonEmpty DiffTimeMeasure -> DiffTimeMeasure
DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
(DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure)
-> (NonEmpty DiffTimeMeasure -> DiffTimeMeasure)
-> (forall b.
    Integral b =>
    b -> DiffTimeMeasure -> DiffTimeMeasure)
-> Semigroup DiffTimeMeasure
forall b. Integral b => b -> DiffTimeMeasure -> DiffTimeMeasure
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
<> :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
$csconcat :: NonEmpty DiffTimeMeasure -> DiffTimeMeasure
sconcat :: NonEmpty DiffTimeMeasure -> DiffTimeMeasure
$cstimes :: forall b. Integral b => b -> DiffTimeMeasure -> DiffTimeMeasure
stimes :: forall b. Integral b => b -> DiffTimeMeasure -> DiffTimeMeasure
Semigroup)
    via (InstantiatedAt Measure DiffTimeMeasure)

instance Ord DiffTimeMeasure where
  compare :: DiffTimeMeasure -> DiffTimeMeasure -> Ordering
compare = ((DiffTimeMeasure, DiffTimeMeasure) -> Ordering)
-> DiffTimeMeasure -> DiffTimeMeasure -> Ordering
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((DiffTimeMeasure, DiffTimeMeasure) -> Ordering)
 -> DiffTimeMeasure -> DiffTimeMeasure -> Ordering)
-> ((DiffTimeMeasure, DiffTimeMeasure) -> Ordering)
-> DiffTimeMeasure
-> DiffTimeMeasure
-> Ordering
forall a b. (a -> b) -> a -> b
$ \case
    (DiffTimeMeasure
InfiniteDiffTimeMeasure, DiffTimeMeasure
InfiniteDiffTimeMeasure) -> Ordering
EQ
    (DiffTimeMeasure
InfiniteDiffTimeMeasure, DiffTimeMeasure
_) -> Ordering
GT
    (DiffTimeMeasure
_, DiffTimeMeasure
InfiniteDiffTimeMeasure) -> Ordering
LT
    (FiniteDiffTimeMeasure DiffTime
x, FiniteDiffTimeMeasure DiffTime
y) -> DiffTime -> DiffTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare DiffTime
x DiffTime
y

instance Measure DiffTimeMeasure where
  zero :: DiffTimeMeasure
zero = DiffTime -> DiffTimeMeasure
FiniteDiffTimeMeasure DiffTime
0
  plus :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
plus = ((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
-> DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
 -> DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure)
-> ((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
-> DiffTimeMeasure
-> DiffTimeMeasure
-> DiffTimeMeasure
forall a b. (a -> b) -> a -> b
$ \case
    (DiffTimeMeasure
InfiniteDiffTimeMeasure, DiffTimeMeasure
_) -> DiffTimeMeasure
InfiniteDiffTimeMeasure
    (DiffTimeMeasure
_, DiffTimeMeasure
InfiniteDiffTimeMeasure) -> DiffTimeMeasure
InfiniteDiffTimeMeasure
    (FiniteDiffTimeMeasure DiffTime
x, FiniteDiffTimeMeasure DiffTime
y) ->
      DiffTime -> DiffTimeMeasure
FiniteDiffTimeMeasure (DiffTime
x DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ DiffTime
y)
  min :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
min = ((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
-> DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
 -> DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure)
-> ((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
-> DiffTimeMeasure
-> DiffTimeMeasure
-> DiffTimeMeasure
forall a b. (a -> b) -> a -> b
$ \case
    (DiffTimeMeasure
InfiniteDiffTimeMeasure, DiffTimeMeasure
y) -> DiffTimeMeasure
y
    (DiffTimeMeasure
x, DiffTimeMeasure
InfiniteDiffTimeMeasure) -> DiffTimeMeasure
x
    (FiniteDiffTimeMeasure DiffTime
x, FiniteDiffTimeMeasure DiffTime
y) ->
      DiffTime -> DiffTimeMeasure
FiniteDiffTimeMeasure (DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
min DiffTime
x DiffTime
y)
  max :: DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
max = ((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
-> DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure
forall a b c. ((a, b) -> c) -> a -> b -> c
curry (((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
 -> DiffTimeMeasure -> DiffTimeMeasure -> DiffTimeMeasure)
-> ((DiffTimeMeasure, DiffTimeMeasure) -> DiffTimeMeasure)
-> DiffTimeMeasure
-> DiffTimeMeasure
-> DiffTimeMeasure
forall a b. (a -> b) -> a -> b
$ \case
    (DiffTimeMeasure
InfiniteDiffTimeMeasure, DiffTimeMeasure
_) -> DiffTimeMeasure
InfiniteDiffTimeMeasure
    (DiffTimeMeasure
_, DiffTimeMeasure
InfiniteDiffTimeMeasure) -> DiffTimeMeasure
InfiniteDiffTimeMeasure
    (FiniteDiffTimeMeasure DiffTime
x, FiniteDiffTimeMeasure DiffTime
y) ->
      DiffTime -> DiffTimeMeasure
FiniteDiffTimeMeasure (DiffTime -> DiffTime -> DiffTime
forall a. Ord a => a -> a -> a
max DiffTime
x DiffTime
y)

-----

-- | Thrown by 'addTx' or 'testTryAddTx' when 'mempoolTimeoutHard' is exceeded.
data ExnMempoolTimeout
  = -- | The observed duration and the full tx that caused it.
    forall blk. Show (GenTx blk) => MkExnMempoolTimeout !DiffTime !(GenTx blk)

instance Show ExnMempoolTimeout where
  showsPrec :: Int -> ExnMempoolTimeout -> ShowS
showsPrec Int
p (MkExnMempoolTimeout DiffTime
dur GenTx blk
txid) =
    Bool -> ShowS -> ShowS
showParen
      (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
11)
      (String -> ShowS
showString String
"ExnMempoolTimeout " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> DiffTime -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 DiffTime
dur ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> GenTx blk -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 GenTx blk
txid)

instance Exception ExnMempoolTimeout