module Ouroboros.Network.TxSubmission.Mempool.Reader
  ( TxSubmissionMempoolReader (..)
  , MempoolSnapshot (..)
  , mapMempoolSnapshot
  , mapTxSubmissionMempoolReader
  ) where

import           Control.Monad.Class.MonadSTM (MonadSTM, STM)

import           Ouroboros.Network.Protocol.TxSubmission2.Client (TxSizeInBytes)

-- | The consensus layer functionality that the inbound and outbound side of
-- the tx submission logic requires.
--
-- This is provided to the tx submission logic by the consensus layer.
--
data TxSubmissionMempoolReader txid tx idx m =
     TxSubmissionMempoolReader {

       -- | In STM, grab a snapshot of the contents of the mempool. This allows
       -- further pure queries on the snapshot.
       --
       TxSubmissionMempoolReader txid tx idx m
-> STM m (MempoolSnapshot txid tx idx)
mempoolGetSnapshot :: STM m (MempoolSnapshot txid tx idx),

       -- | 'mempoolTxIdsAfter' with 'mempoolZeroIdx' is expected to give all
       -- txs currently in the mempool.
       TxSubmissionMempoolReader txid tx idx m -> idx
mempoolZeroIdx     :: idx
    }

mapTxSubmissionMempoolReader ::
     MonadSTM m
  => (tx -> tx')
  -> TxSubmissionMempoolReader txid tx  idx m
  -> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader :: (tx -> tx')
-> TxSubmissionMempoolReader txid tx idx m
-> TxSubmissionMempoolReader txid tx' idx m
mapTxSubmissionMempoolReader tx -> tx'
f TxSubmissionMempoolReader txid tx idx m
rdr =
    TxSubmissionMempoolReader txid tx idx m
rdr {
       mempoolGetSnapshot :: STM m (MempoolSnapshot txid tx' idx)
mempoolGetSnapshot = (tx -> tx')
-> MempoolSnapshot txid tx idx -> MempoolSnapshot txid tx' idx
forall tx tx' txid idx.
(tx -> tx')
-> MempoolSnapshot txid tx idx -> MempoolSnapshot txid tx' idx
mapMempoolSnapshot tx -> tx'
f (MempoolSnapshot txid tx idx -> MempoolSnapshot txid tx' idx)
-> STM m (MempoolSnapshot txid tx idx)
-> STM m (MempoolSnapshot txid tx' idx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TxSubmissionMempoolReader txid tx idx m
-> STM m (MempoolSnapshot txid tx idx)
forall txid tx idx (m :: * -> *).
TxSubmissionMempoolReader txid tx idx m
-> STM m (MempoolSnapshot txid tx idx)
mempoolGetSnapshot TxSubmissionMempoolReader txid tx idx m
rdr
    }

-- | 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 'mempoolLookupTx' 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 txid tx idx =
     MempoolSnapshot {
       MempoolSnapshot txid tx idx -> idx -> [(txid, idx, TxSizeInBytes)]
mempoolTxIdsAfter :: idx -> [(txid, idx, TxSizeInBytes)],
       MempoolSnapshot txid tx idx -> idx -> Maybe tx
mempoolLookupTx   :: idx -> Maybe tx,
       MempoolSnapshot txid tx idx -> txid -> Bool
mempoolHasTx      :: txid -> Bool
     }

mapMempoolSnapshot ::
     (tx -> tx')
  -> MempoolSnapshot txid tx  idx
  -> MempoolSnapshot txid tx' idx
mapMempoolSnapshot :: (tx -> tx')
-> MempoolSnapshot txid tx idx -> MempoolSnapshot txid tx' idx
mapMempoolSnapshot tx -> tx'
f MempoolSnapshot txid tx idx
snap =
     MempoolSnapshot txid tx idx
snap {
       mempoolLookupTx :: idx -> Maybe tx'
mempoolLookupTx = (tx -> tx') -> Maybe tx -> Maybe tx'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap tx -> tx'
f (Maybe tx -> Maybe tx') -> (idx -> Maybe tx) -> idx -> Maybe tx'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MempoolSnapshot txid tx idx -> idx -> Maybe tx
forall txid tx idx. MempoolSnapshot txid tx idx -> idx -> Maybe tx
mempoolLookupTx MempoolSnapshot txid tx idx
snap
     }