Safe Haskell | None |
---|---|
Language | Haskell2010 |
The mempool API and implementation.
Synopsis
- type TxSizeInBytes = Word32
-
data
TraceEventMempool
blk
- = TraceMempoolAddedTx ( Validated ( GenTx blk)) MempoolSize MempoolSize
- | TraceMempoolRejectedTx ( GenTx blk) ( ApplyTxErr blk) MempoolSize
- | TraceMempoolRemoveTxs [ Validated ( GenTx blk)] MempoolSize
- | TraceMempoolManuallyRemovedTxs [ GenTxId blk] [ Validated ( GenTx blk)] MempoolSize
-
data
MempoolSize
=
MempoolSize
{
- msNumTxs :: ! Word32
- msNumBytes :: ! Word32
-
data
MempoolSnapshot
blk idx =
MempoolSnapshot
{
- snapshotTxs :: [( Validated ( GenTx blk), idx)]
- snapshotTxsAfter :: idx -> [( Validated ( GenTx blk), idx)]
- snapshotLookupTx :: idx -> Maybe ( Validated ( GenTx blk))
- snapshotHasTx :: GenTxId blk -> Bool
- snapshotMempoolSize :: MempoolSize
- snapshotSlotNo :: SlotNo
- snapshotLedgerState :: TickedLedgerState blk
- data MempoolCapacityBytesOverride
- newtype MempoolCapacityBytes = MempoolCapacityBytes { }
-
data
ForgeLedgerState
blk
- = ForgeInKnownSlot SlotNo ( TickedLedgerState blk)
- | ForgeInUnknownSlot ( LedgerState blk)
-
data
MempoolAddTxResult
blk
- = MempoolTxAdded !( Validated ( GenTx blk))
- | MempoolTxRejected !( GenTx blk) !( ApplyTxErr blk)
-
data
Mempool
m blk idx =
Mempool
{
- tryAddTxs :: WhetherToIntervene -> [ GenTx blk] -> m ([ MempoolAddTxResult blk], [ GenTx blk])
- removeTxs :: [ GenTxId blk] -> m ()
- syncWithLedger :: m ( MempoolSnapshot blk idx)
- getSnapshot :: STM m ( MempoolSnapshot blk idx)
- getSnapshotFor :: ForgeLedgerState blk -> STM m ( MempoolSnapshot blk idx)
- getCapacity :: STM m MempoolCapacityBytes
- getTxSize :: GenTx blk -> TxSizeInBytes
- zeroIdx :: idx
- mempoolTxAddedToMaybe :: MempoolAddTxResult blk -> Maybe ( Validated ( GenTx blk))
- isMempoolTxAdded :: MempoolAddTxResult blk -> Bool
- isMempoolTxRejected :: MempoolAddTxResult blk -> Bool
- addTxs :: forall m blk idx. MonadSTM m => Mempool m blk idx -> [ GenTx blk] -> m [ MempoolAddTxResult blk]
- addLocalTxs :: forall m blk idx. MonadSTM m => Mempool m blk idx -> [ GenTx blk] -> m [ MempoolAddTxResult blk]
- computeMempoolCapacity :: LedgerSupportsMempool blk => TickedLedgerState blk -> MempoolCapacityBytesOverride -> MempoolCapacityBytes
- data TicketNo
-
data
LedgerInterface
m blk =
LedgerInterface
{
- getCurrentLedgerState :: STM m ( LedgerState blk)
- openMempool :: ( IOLike m, LedgerSupportsMempool blk, HasTxId ( GenTx blk), ValidateEnvelope blk) => ResourceRegistry m -> LedgerInterface m blk -> LedgerConfig blk -> MempoolCapacityBytesOverride -> Tracer m ( TraceEventMempool blk) -> ( GenTx blk -> TxSizeInBytes ) -> m ( Mempool m blk TicketNo )
- openMempoolWithoutSyncThread :: ( IOLike m, LedgerSupportsMempool blk, HasTxId ( GenTx blk), ValidateEnvelope blk) => LedgerInterface m blk -> LedgerConfig blk -> MempoolCapacityBytesOverride -> Tracer m ( TraceEventMempool blk) -> ( GenTx blk -> TxSizeInBytes ) -> m ( Mempool m blk TicketNo )
- chainDBLedgerInterface :: ( IOLike m, IsLedger ( LedgerState blk)) => ChainDB m blk -> LedgerInterface m blk
Documentation
type TxSizeInBytes = Word32 Source #
Transactions are typically not big, but in principle in future we could have ones over 64k large.
data TraceEventMempool blk Source #
Events traced by the Mempool.
TraceMempoolAddedTx | |
|
|
TraceMempoolRejectedTx | |
|
|
TraceMempoolRemoveTxs | |
|
|
TraceMempoolManuallyRemovedTxs | |
|
Instances
( Eq ( GenTx blk), Eq ( Validated ( GenTx blk)), Eq ( GenTxId blk), Eq ( ApplyTxErr blk)) => Eq ( TraceEventMempool blk) Source # | |
Defined in Ouroboros.Consensus.Mempool.API (==) :: TraceEventMempool blk -> TraceEventMempool blk -> Bool Source # (/=) :: TraceEventMempool blk -> TraceEventMempool blk -> Bool Source # |
|
( Show ( GenTx blk), Show ( Validated ( GenTx blk)), Show ( GenTxId blk), Show ( ApplyTxErr blk)) => Show ( TraceEventMempool blk) Source # | |
Defined in Ouroboros.Consensus.Mempool.API |
data MempoolSize Source #
The size of a mempool.
MempoolSize | |
|
Instances
Eq MempoolSize Source # | |
Defined in Ouroboros.Consensus.Mempool.API (==) :: MempoolSize -> MempoolSize -> Bool Source # (/=) :: MempoolSize -> MempoolSize -> Bool Source # |
|
Show MempoolSize Source # | |
Defined in Ouroboros.Consensus.Mempool.API |
|
Semigroup MempoolSize Source # | |
Defined in Ouroboros.Consensus.Mempool.API (<>) :: MempoolSize -> MempoolSize -> MempoolSize Source # sconcat :: NonEmpty MempoolSize -> MempoolSize Source # stimes :: Integral b => b -> MempoolSize -> MempoolSize Source # |
|
Monoid MempoolSize Source # | |
Defined in Ouroboros.Consensus.Mempool.API mempty :: MempoolSize Source # mappend :: MempoolSize -> MempoolSize -> MempoolSize Source # mconcat :: [ MempoolSize ] -> MempoolSize Source # |
data MempoolSnapshot blk idx Source #
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.
MempoolSnapshot | |
|
data MempoolCapacityBytesOverride Source #
An override for the default
MempoolCapacityBytes
which is 2x the
maximum transaction capacity
NoMempoolCapacityBytesOverride |
Use 2x the maximum transaction capacity of a block. This will change dynamically with the protocol parameters adopted in the current ledger. |
MempoolCapacityBytesOverride ! MempoolCapacityBytes |
Use the following
|
Instances
newtype MempoolCapacityBytes Source #
Represents the maximum number of bytes worth of transactions that a
Mempool
can contain.
Instances
Eq MempoolCapacityBytes Source # | |
Defined in Ouroboros.Consensus.Mempool.API (==) :: MempoolCapacityBytes -> MempoolCapacityBytes -> Bool Source # (/=) :: MempoolCapacityBytes -> MempoolCapacityBytes -> Bool Source # |
|
Show MempoolCapacityBytes Source # | |
Defined in Ouroboros.Consensus.Mempool.API |
|
NoThunks MempoolCapacityBytes Source # | |
Defined in Ouroboros.Consensus.Mempool.API |
data ForgeLedgerState blk Source #
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.
ForgeInKnownSlot SlotNo ( TickedLedgerState 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
|
ForgeInUnknownSlot ( LedgerState blk) |
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
|
data MempoolAddTxResult blk Source #
The result of attempting to add a transaction to the mempool.
MempoolTxAdded !( Validated ( GenTx blk)) |
The transaction was added to the mempool. |
MempoolTxRejected !( GenTx blk) !( ApplyTxErr blk) |
The transaction was rejected and could not be added to the mempool for the specified reason. |
Instances
( Eq ( GenTx blk), Eq ( Validated ( GenTx blk)), Eq ( ApplyTxErr blk)) => Eq ( MempoolAddTxResult blk) Source # | |
Defined in Ouroboros.Consensus.Mempool.API (==) :: MempoolAddTxResult blk -> MempoolAddTxResult blk -> Bool Source # (/=) :: MempoolAddTxResult blk -> MempoolAddTxResult blk -> Bool Source # |
|
( Show ( GenTx blk), Show ( Validated ( GenTx blk)), Show ( ApplyTxErr blk)) => Show ( MempoolAddTxResult blk) Source # | |
Defined in Ouroboros.Consensus.Mempool.API |
data Mempool m blk idx Source #
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).
When only one thread is operating on the mempool, operations that mutate the state based on the input arguments (tryAddTxs and removeTxs) will produce the same result whether they process transactions one by one or all in one go, so this equality holds:
void (tryAddTxs wti txs) === forM_ txs (tryAddTxs wti . (:[])) void (trAddTxs wti [x,y]) === tryAddTxs wti x >> void (tryAddTxs wti y)
This shows that
is an homomorphism from
tryAddTxs
wti
++
and
>>
,
which informally makes these operations "distributive".
Mempool | |
|
mempoolTxAddedToMaybe :: MempoolAddTxResult blk -> Maybe ( Validated ( GenTx blk)) Source #
isMempoolTxAdded :: MempoolAddTxResult blk -> Bool Source #
isMempoolTxRejected :: MempoolAddTxResult blk -> Bool Source #
addTxs :: forall m blk idx. MonadSTM m => Mempool m blk idx -> [ GenTx blk] -> m [ MempoolAddTxResult blk] Source #
Wrapper around
implTryAddTxs
that blocks until all transaction have
either been added to the Mempool or rejected.
This function does not sync the Mempool contents with the ledger state in case the latter changes, it relies on the background thread to do that.
See the necessary invariants on the Haddock for
tryAddTxs
.
addLocalTxs :: forall m blk idx. MonadSTM m => Mempool m blk idx -> [ GenTx blk] -> m [ MempoolAddTxResult blk] Source #
computeMempoolCapacity :: LedgerSupportsMempool blk => TickedLedgerState blk -> MempoolCapacityBytesOverride -> MempoolCapacityBytes Source #
If no override is provided, calculate the default mempool capacity as 2x the current ledger's maximum transaction capacity of a block.
We allocate each transaction a (monotonically increasing) ticket number as it enters the mempool.
Instances
Bounded TicketNo Source # | |
Enum TicketNo Source # | |
Defined in Ouroboros.Consensus.Mempool.TxSeq succ :: TicketNo -> TicketNo Source # pred :: TicketNo -> TicketNo Source # toEnum :: Int -> TicketNo Source # fromEnum :: TicketNo -> Int Source # enumFrom :: TicketNo -> [ TicketNo ] Source # enumFromThen :: TicketNo -> TicketNo -> [ TicketNo ] Source # enumFromTo :: TicketNo -> TicketNo -> [ TicketNo ] Source # enumFromThenTo :: TicketNo -> TicketNo -> TicketNo -> [ TicketNo ] Source # |
|
Eq TicketNo Source # | |
Ord TicketNo Source # | |
Defined in Ouroboros.Consensus.Mempool.TxSeq |
|
Show TicketNo Source # | |
NoThunks TicketNo Source # | |
data LedgerInterface m blk Source #
Abstract interface needed to run a Mempool.
LedgerInterface | |
|
openMempool :: ( IOLike m, LedgerSupportsMempool blk, HasTxId ( GenTx blk), ValidateEnvelope blk) => ResourceRegistry m -> LedgerInterface m blk -> LedgerConfig blk -> MempoolCapacityBytesOverride -> Tracer m ( TraceEventMempool blk) -> ( GenTx blk -> TxSizeInBytes ) -> m ( Mempool m blk TicketNo ) Source #
Create a
Mempool m blk TicketNo
in
m
to manipulate the mempool. It
will also fork a thread that syncs the mempool and the ledger when the ledger
changes.
openMempoolWithoutSyncThread :: ( IOLike m, LedgerSupportsMempool blk, HasTxId ( GenTx blk), ValidateEnvelope blk) => LedgerInterface m blk -> LedgerConfig blk -> MempoolCapacityBytesOverride -> Tracer m ( TraceEventMempool blk) -> ( GenTx blk -> TxSizeInBytes ) -> m ( Mempool m blk TicketNo ) Source #
Unlike
openMempool
, this function does not fork a background thread
that synchronises with the ledger state whenever the later changes.
Intended for testing purposes.
chainDBLedgerInterface :: ( IOLike m, IsLedger ( LedgerState blk)) => ChainDB m blk -> LedgerInterface m blk Source #
Create a
LedgerInterface
from a
ChainDB
.