ouroboros-network
Safe HaskellNone
LanguageHaskell2010

Ouroboros.Network.TxSubmission.Inbound.V2.State

Synopsis

Core API

data SharedTxState peeraddr txid tx Source #

Shared state of all TxSubmission clients.

New txid enters unacknowledgedTxIds it is also added to availableTxIds and referenceCounts (see acknowledgeTxIdsImpl).

When a txid id is selected to be downloaded, it's added to requestedTxsInflightSize (see pickTxsToDownload).

When the request arrives, the txid is removed from inflightTxs. It might be added to unknownTxs if the server didn't have that txid, or it's added to bufferedTxs (see collectTxsImpl).

Whenever we choose txid to acknowledge (either in acknowledtxsIdsImpl, collectTxsImpl or pickTxsToDownload, we also recalculate referenceCounts and only keep live txids in other maps (e.g. availableTxIds, bufferedTxs, unknownTxs).

Constructors

SharedTxState 

Fields

  • peerTxStates :: !(Map peeraddr (PeerTxState txid tx))

    Map of peer states.

    Invariant: for peeraddr's which are registered using withPeer, there's always an entry in this map even if the set of txids is empty.

  • inflightTxs :: !(Map txid Int)

    Set of transactions which are in-flight (have already been requested) together with multiplicities (from how many peers it is currently in-flight)

    This set can intersect with availableTxIds.

  • inflightTxsSize :: !SizeInBytes

    Overall size of all txs in-flight.

  • bufferedTxs :: !(Map txid (Maybe tx))

    Map of tx which:

    • were downloaded and added to the mempool,
    • are already in the mempool (Nothing is inserted in that case),

    We only keep live txid, e.g. ones which txid is unacknowledged by at least one peer or has a timedTxs entry.

    Note: txids which tx were unknown by a peer are tracked separately in unknownTxs.

    Note: previous implementation also needed to explicitly track txids which were already acknowledged, but are still unacknowledged. In this implementation, this is done using reference counting.

    This map is useful to acknowledge txids, it's basically taking the longest prefix which contains entries in bufferedTxs or unknownTxs.

  • referenceCounts :: !(Map txid Int)

    We track reference counts of all unacknowledged and timedTxs txids. Once the count reaches 0, a tx is removed from bufferedTxs.

    The bufferedTx map contains a subset of txid which referenceCounts contains.

    Invariants:

    • the txid count is equal to multiplicity of txid in all unacknowledgedTxIds sequences;
    • Map.keysSet bufferedTxs isSubsetOf Map.keysSet referenceCounts;
    • all counts are positive integers.
  • timedTxs :: !(Map Time [txid])

    A set of timeouts for txids that have been added to bufferedTxs after being inserted into the mempool.

    We need these short timeouts to avoid re-downloading a tx. We could acknowledge this txid to all peers, when a peer from another continent presents us it again.

    Every txid entry has a reference count in referenceCounts.

  • inSubmissionToMempoolTxs :: !(Map txid Int)

    A set of txids that have been downloaded by a peer and are on their way to the mempool. We won't issue further fetch-requests for TXs in this state. We track these txs to not re-download them from another peer.

    • We subtract from the counter when a given tx is added or rejected by the mempool or do that for all txs in toMempoolTxs when a peer is unregistered.
    • We add to the counter when a given tx is selected to be added to the mempool in pickTxsToDownload.
  • peerRng :: !StdGen

    Rng used to randomly order peers

Instances

Instances details
Generic (SharedTxState peeraddr txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Associated Types

type Rep (SharedTxState peeraddr txid tx) 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

type Rep (SharedTxState peeraddr txid tx) = D1 ('MetaData "SharedTxState" "Ouroboros.Network.TxSubmission.Inbound.V2.Types" "ouroboros-network-0.22.1.0-inplace" 'False) (C1 ('MetaCons "SharedTxState" 'PrefixI 'True) (((S1 ('MetaSel ('Just "peerTxStates") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map peeraddr (PeerTxState txid tx))) :*: S1 ('MetaSel ('Just "inflightTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid Int))) :*: (S1 ('MetaSel ('Just "inflightTxsSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SizeInBytes) :*: S1 ('MetaSel ('Just "bufferedTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid (Maybe tx))))) :*: ((S1 ('MetaSel ('Just "referenceCounts") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid Int)) :*: S1 ('MetaSel ('Just "timedTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map Time [txid]))) :*: (S1 ('MetaSel ('Just "inSubmissionToMempoolTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid Int)) :*: S1 ('MetaSel ('Just "peerRng") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StdGen)))))

Methods

from :: SharedTxState peeraddr txid tx -> Rep (SharedTxState peeraddr txid tx) x #

to :: Rep (SharedTxState peeraddr txid tx) x -> SharedTxState peeraddr txid tx #

(Show peeraddr, Show txid, Show tx) => Show (SharedTxState peeraddr txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Methods

showsPrec :: Int -> SharedTxState peeraddr txid tx -> ShowS #

show :: SharedTxState peeraddr txid tx -> String #

showList :: [SharedTxState peeraddr txid tx] -> ShowS #

(Eq peeraddr, Eq txid, Eq tx) => Eq (SharedTxState peeraddr txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Methods

(==) :: SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx -> Bool #

(/=) :: SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx -> Bool #

(NoThunks peeraddr, NoThunks tx, NoThunks txid, NoThunks StdGen) => NoThunks (SharedTxState peeraddr txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Methods

noThunks :: Context -> SharedTxState peeraddr txid tx -> IO (Maybe ThunkInfo) #

wNoThunks :: Context -> SharedTxState peeraddr txid tx -> IO (Maybe ThunkInfo) #

showTypeOf :: Proxy (SharedTxState peeraddr txid tx) -> String #

type Rep (SharedTxState peeraddr txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

type Rep (SharedTxState peeraddr txid tx) = D1 ('MetaData "SharedTxState" "Ouroboros.Network.TxSubmission.Inbound.V2.Types" "ouroboros-network-0.22.1.0-inplace" 'False) (C1 ('MetaCons "SharedTxState" 'PrefixI 'True) (((S1 ('MetaSel ('Just "peerTxStates") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map peeraddr (PeerTxState txid tx))) :*: S1 ('MetaSel ('Just "inflightTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid Int))) :*: (S1 ('MetaSel ('Just "inflightTxsSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SizeInBytes) :*: S1 ('MetaSel ('Just "bufferedTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid (Maybe tx))))) :*: ((S1 ('MetaSel ('Just "referenceCounts") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid Int)) :*: S1 ('MetaSel ('Just "timedTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map Time [txid]))) :*: (S1 ('MetaSel ('Just "inSubmissionToMempoolTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid Int)) :*: S1 ('MetaSel ('Just "peerRng") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 StdGen)))))

data PeerTxState txid tx Source #

Constructors

PeerTxState 

Fields

  • unacknowledgedTxIds :: !(StrictSeq txid)

    Those transactions (by their identifier) that the client has told us about, and which we have not yet acknowledged. This is kept in the order in which the client gave them to us. This is the same order in which we submit them to the mempool (or for this example, the final result order). It is also the order we acknowledge in.

  • availableTxIds :: !(Map txid SizeInBytes)

    Set of known transaction ids which can be requested from this peer.

  • requestedTxIdsInflight :: !NumTxIdsToReq

    The number of transaction identifiers that we have requested but which have not yet been replied to. We need to track this it keep our requests within the limit on the number of unacknowledged txids.

  • requestedTxsInflightSize :: !SizeInBytes

    The size in bytes of transactions that we have requested but which have not yet been replied to. We need to track this to keep our requests within the maxTxsSizeInflight limit.

  • requestedTxsInflight :: !(Set txid)

    The set of requested txids.

  • unknownTxs :: !(Set txid)

    A subset of unacknowledgedTxIds which were unknown to the peer (i.e. requested but not received). We need to track these txids since they need to be acknowledged.

    We track these txid per peer, rather than in bufferedTxs map, since that could potentially lead to corrupting the node, not being able to download a tx which is needed & available from other nodes.

  • score :: !Double

    Score is a metric that tracks how usefull a peer has been. The larger the value the less usefull peer. It slowly decays towards zero.

  • scoreTs :: !Time

    Timestamp for the last time score was drained.

  • downloadedTxs :: !(Map txid tx)

    A set of TXs downloaded from the peer. They are not yet acknowledged and haven't been sent to the mempool yet.

    Life cycle of entries: * added when a tx is downloaded (see collectTxsImpl) * follows unacknowledgedTxIds (see acknowledgeTxIds)

  • toMempoolTxs :: !(Map txid tx)

    A set of TXs on their way to the mempool. Tracked here so that we can cleanup inSubmissionToMempoolTxs if the peer dies.

    Life cycle of entries: * added by acknowledgeTxIds (where decide which txs can be submitted to the mempool) * removed by withMempoolSem

Instances

Instances details
Generic (PeerTxState txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Associated Types

type Rep (PeerTxState txid tx) 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

type Rep (PeerTxState txid tx) = D1 ('MetaData "PeerTxState" "Ouroboros.Network.TxSubmission.Inbound.V2.Types" "ouroboros-network-0.22.1.0-inplace" 'False) (C1 ('MetaCons "PeerTxState" 'PrefixI 'True) (((S1 ('MetaSel ('Just "unacknowledgedTxIds") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (StrictSeq txid)) :*: S1 ('MetaSel ('Just "availableTxIds") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid SizeInBytes))) :*: (S1 ('MetaSel ('Just "requestedTxIdsInflight") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NumTxIdsToReq) :*: (S1 ('MetaSel ('Just "requestedTxsInflightSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SizeInBytes) :*: S1 ('MetaSel ('Just "requestedTxsInflight") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set txid))))) :*: ((S1 ('MetaSel ('Just "unknownTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set txid)) :*: S1 ('MetaSel ('Just "score") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double)) :*: (S1 ('MetaSel ('Just "scoreTs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Time) :*: (S1 ('MetaSel ('Just "downloadedTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid tx)) :*: S1 ('MetaSel ('Just "toMempoolTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid tx)))))))

Methods

from :: PeerTxState txid tx -> Rep (PeerTxState txid tx) x #

to :: Rep (PeerTxState txid tx) x -> PeerTxState txid tx #

(Show txid, Show tx) => Show (PeerTxState txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Methods

showsPrec :: Int -> PeerTxState txid tx -> ShowS #

show :: PeerTxState txid tx -> String #

showList :: [PeerTxState txid tx] -> ShowS #

(Eq txid, Eq tx) => Eq (PeerTxState txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

Methods

(==) :: PeerTxState txid tx -> PeerTxState txid tx -> Bool #

(/=) :: PeerTxState txid tx -> PeerTxState txid tx -> Bool #

(NoThunks txid, NoThunks tx) => NoThunks (PeerTxState txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

type Rep (PeerTxState txid tx) Source # 
Instance details

Defined in Ouroboros.Network.TxSubmission.Inbound.V2.Types

type Rep (PeerTxState txid tx) = D1 ('MetaData "PeerTxState" "Ouroboros.Network.TxSubmission.Inbound.V2.Types" "ouroboros-network-0.22.1.0-inplace" 'False) (C1 ('MetaCons "PeerTxState" 'PrefixI 'True) (((S1 ('MetaSel ('Just "unacknowledgedTxIds") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (StrictSeq txid)) :*: S1 ('MetaSel ('Just "availableTxIds") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid SizeInBytes))) :*: (S1 ('MetaSel ('Just "requestedTxIdsInflight") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 NumTxIdsToReq) :*: (S1 ('MetaSel ('Just "requestedTxsInflightSize") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 SizeInBytes) :*: S1 ('MetaSel ('Just "requestedTxsInflight") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set txid))))) :*: ((S1 ('MetaSel ('Just "unknownTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Set txid)) :*: S1 ('MetaSel ('Just "score") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Double)) :*: (S1 ('MetaSel ('Just "scoreTs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 Time) :*: (S1 ('MetaSel ('Just "downloadedTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid tx)) :*: S1 ('MetaSel ('Just "toMempoolTxs") 'NoSourceUnpackedness 'SourceStrict 'DecidedStrict) (Rec0 (Map txid tx)))))))

type SharedTxStateVar (m :: Type -> Type) peeraddr txid tx = StrictTVar m (SharedTxState peeraddr txid tx) Source #

newSharedTxStateVar :: MonadSTM m => StdGen -> m (SharedTxStateVar m peeraddr txid tx) Source #

receivedTxIds Source #

Arguments

:: forall m peeraddr idx tx txid. (MonadSTM m, Ord txid, Ord peeraddr) 
=> Tracer m (TraceTxLogic peeraddr txid tx) 
-> SharedTxStateVar m peeraddr txid tx 
-> STM m (MempoolSnapshot txid tx idx) 
-> peeraddr 
-> NumTxIdsToReq

number of requests to subtract from requestedTxIdsInflight

-> StrictSeq txid

sequence of received txids

-> Map txid SizeInBytes

received txids with sizes

-> m () 

Acknowledge txids, return the number of txids to be acknowledged to the remote side.

collectTxs Source #

Arguments

:: forall m peeraddr tx txid. (MonadSTM m, Ord txid, Ord peeraddr, Show txid, Typeable txid) 
=> Tracer m (TraceTxLogic peeraddr txid tx) 
-> (tx -> SizeInBytes) 
-> SharedTxStateVar m peeraddr txid tx 
-> peeraddr 
-> Map txid SizeInBytes

set of requested txids with their announced size

-> Map txid tx

received txs

-> m (Maybe TxSubmissionProtocolError)

number of txids to be acknowledged and txs to be added to the mempool

Include received txs in SharedTxState. Return number of txids to be acknowledged and list of tx to be added to the mempool.

acknowledgeTxIds Source #

Arguments

:: forall peeraddr tx txid. (Ord txid, HasCallStack) 
=> TxDecisionPolicy 
-> SharedTxState peeraddr txid tx 
-> PeerTxState txid tx 
-> (NumTxIdsToAck, NumTxIdsToReq, TxsToMempool txid tx, RefCountDiff txid, PeerTxState txid tx)

number of txid to acknowledge, requests, txs which we can submit to the mempool, txids to acknowledge with multiplicities, updated PeerTxState.

splitAcknowledgedTxIds Source #

Arguments

:: (Ord txid, HasCallStack) 
=> TxDecisionPolicy 
-> SharedTxState peer txid tx 
-> PeerTxState txid tx 
-> (NumTxIdsToReq, StrictSeq txid, StrictSeq txid)

number of txids to request, acknowledged txids, unacknowledged txids

Split unacknowledged txids into acknowledged and unacknowledged parts, also return number of txids which can be requested.

tickTimedTxs :: forall peeraddr tx txid. Ord txid => Time -> SharedTxState peeraddr txid tx -> SharedTxState peeraddr txid tx Source #

const_MAX_TX_SIZE_DISCREPENCY :: SizeInBytes Source #

We check advertised sizes up in a fuzzy way. The advertised and received sizes need to agree up to const_MAX_TX_SIZE_DISCREPENCY.

Internals, only exported for testing purposes:

newtype RefCountDiff txid Source #

RefCountDiff represents a map of txid which can be acknowledged together with their multiplicities.

Constructors

RefCountDiff 

Fields

updateRefCounts :: Ord txid => Map txid Int -> RefCountDiff txid -> Map txid Int Source #

receivedTxIdsImpl Source #

Arguments

:: forall peeraddr tx txid. (Ord txid, Ord peeraddr, HasCallStack) 
=> (txid -> Bool)

check if txid is in the mempool, ref mempoolHasTx

-> peeraddr 
-> NumTxIdsToReq

number of requests to subtract from requestedTxIdsInflight

-> StrictSeq txid

sequence of received txids

-> Map txid SizeInBytes

received txids with sizes

-> SharedTxState peeraddr txid tx 
-> SharedTxState peeraddr txid tx 

Insert received txids and return the number of txids to be acknowledged and the updated SharedTxState.

collectTxsImpl Source #

Arguments

:: forall peeraddr tx txid. (Ord peeraddr, Ord txid, Show txid, Typeable txid) 
=> (tx -> SizeInBytes)

compute tx size

-> peeraddr 
-> Map txid SizeInBytes

requested txids

-> Map txid tx

received txs

-> SharedTxState peeraddr txid tx 
-> Either TxSubmissionProtocolError (SharedTxState peeraddr txid tx)

Return list of txid which sizes didn't match or a new state. If one of the tx has wrong size, we return an error. The mini-protocol will throw, which will clean the state map from this peer.