{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase                 #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE PatternSynonyms            #-}
{-# LANGUAGE ViewPatterns               #-}
-- | Intended for qualified import.
--
-- > import           Ouroboros.Consensus.Mempool.TxSeq (TxSeq (..))
-- > import qualified Ouroboros.Consensus.Mempool.TxSeq as TxSeq
module Ouroboros.Consensus.Mempool.TxSeq (
    TicketNo (..)
  , TxSeq (Empty, (:>), (:<))
  , TxTicket (..)
  , fromList
  , lookupByTicketNo
  , splitAfterTicketNo
  , splitAfterTxSize
  , toList
  , toMempoolSize
  , toTuples
  , zeroTicketNo
    -- * Reference implementations for testing
  , splitAfterTxSizeSpec
  ) where

import           Data.FingerTree.Strict (StrictFingerTree)
import qualified Data.FingerTree.Strict as FingerTree
import qualified Data.Foldable as Foldable
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)

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

import           Ouroboros.Consensus.Mempool.API (MempoolSize (..))

{-------------------------------------------------------------------------------
  Mempool transaction sequence as a finger tree
-------------------------------------------------------------------------------}

-- | We allocate each transaction a (monotonically increasing) ticket number
-- as it enters the mempool.
--
newtype TicketNo = TicketNo Word64
  deriving stock (TicketNo -> TicketNo -> Bool
(TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool) -> Eq TicketNo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TicketNo -> TicketNo -> Bool
$c/= :: TicketNo -> TicketNo -> Bool
== :: TicketNo -> TicketNo -> Bool
$c== :: TicketNo -> TicketNo -> Bool
Eq, Eq TicketNo
Eq TicketNo
-> (TicketNo -> TicketNo -> Ordering)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> Bool)
-> (TicketNo -> TicketNo -> TicketNo)
-> (TicketNo -> TicketNo -> TicketNo)
-> Ord TicketNo
TicketNo -> TicketNo -> Bool
TicketNo -> TicketNo -> Ordering
TicketNo -> TicketNo -> TicketNo
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TicketNo -> TicketNo -> TicketNo
$cmin :: TicketNo -> TicketNo -> TicketNo
max :: TicketNo -> TicketNo -> TicketNo
$cmax :: TicketNo -> TicketNo -> TicketNo
>= :: TicketNo -> TicketNo -> Bool
$c>= :: TicketNo -> TicketNo -> Bool
> :: TicketNo -> TicketNo -> Bool
$c> :: TicketNo -> TicketNo -> Bool
<= :: TicketNo -> TicketNo -> Bool
$c<= :: TicketNo -> TicketNo -> Bool
< :: TicketNo -> TicketNo -> Bool
$c< :: TicketNo -> TicketNo -> Bool
compare :: TicketNo -> TicketNo -> Ordering
$ccompare :: TicketNo -> TicketNo -> Ordering
$cp1Ord :: Eq TicketNo
Ord, Int -> TicketNo -> ShowS
[TicketNo] -> ShowS
TicketNo -> String
(Int -> TicketNo -> ShowS)
-> (TicketNo -> String) -> ([TicketNo] -> ShowS) -> Show TicketNo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TicketNo] -> ShowS
$cshowList :: [TicketNo] -> ShowS
show :: TicketNo -> String
$cshow :: TicketNo -> String
showsPrec :: Int -> TicketNo -> ShowS
$cshowsPrec :: Int -> TicketNo -> ShowS
Show)
  deriving newtype (Int -> TicketNo
TicketNo -> Int
TicketNo -> [TicketNo]
TicketNo -> TicketNo
TicketNo -> TicketNo -> [TicketNo]
TicketNo -> TicketNo -> TicketNo -> [TicketNo]
(TicketNo -> TicketNo)
-> (TicketNo -> TicketNo)
-> (Int -> TicketNo)
-> (TicketNo -> Int)
-> (TicketNo -> [TicketNo])
-> (TicketNo -> TicketNo -> [TicketNo])
-> (TicketNo -> TicketNo -> [TicketNo])
-> (TicketNo -> TicketNo -> TicketNo -> [TicketNo])
-> Enum TicketNo
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: TicketNo -> TicketNo -> TicketNo -> [TicketNo]
$cenumFromThenTo :: TicketNo -> TicketNo -> TicketNo -> [TicketNo]
enumFromTo :: TicketNo -> TicketNo -> [TicketNo]
$cenumFromTo :: TicketNo -> TicketNo -> [TicketNo]
enumFromThen :: TicketNo -> TicketNo -> [TicketNo]
$cenumFromThen :: TicketNo -> TicketNo -> [TicketNo]
enumFrom :: TicketNo -> [TicketNo]
$cenumFrom :: TicketNo -> [TicketNo]
fromEnum :: TicketNo -> Int
$cfromEnum :: TicketNo -> Int
toEnum :: Int -> TicketNo
$ctoEnum :: Int -> TicketNo
pred :: TicketNo -> TicketNo
$cpred :: TicketNo -> TicketNo
succ :: TicketNo -> TicketNo
$csucc :: TicketNo -> TicketNo
Enum, TicketNo
TicketNo -> TicketNo -> Bounded TicketNo
forall a. a -> a -> Bounded a
maxBound :: TicketNo
$cmaxBound :: TicketNo
minBound :: TicketNo
$cminBound :: TicketNo
Bounded, Context -> TicketNo -> IO (Maybe ThunkInfo)
Proxy TicketNo -> String
(Context -> TicketNo -> IO (Maybe ThunkInfo))
-> (Context -> TicketNo -> IO (Maybe ThunkInfo))
-> (Proxy TicketNo -> String)
-> NoThunks TicketNo
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy TicketNo -> String
$cshowTypeOf :: Proxy TicketNo -> String
wNoThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
noThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> TicketNo -> IO (Maybe ThunkInfo)
NoThunks)

-- | The transaction ticket number from which our counter starts.
zeroTicketNo :: TicketNo
zeroTicketNo :: TicketNo
zeroTicketNo = Word64 -> TicketNo
TicketNo Word64
0

-- | We associate transactions in the mempool with their ticket number and
-- size in bytes.
--
data TxTicket tx = TxTicket
  { TxTicket tx -> tx
txTicketTx            :: !tx
    -- ^ The transaction associated with this ticket.
  , TxTicket tx -> TicketNo
txTicketNo            :: !TicketNo
    -- ^ The ticket number.
  , TxTicket tx -> TxSizeInBytes
txTicketTxSizeInBytes :: !TxSizeInBytes
    -- ^ The byte size of the transaction ('txTicketTx') associated with this
    -- ticket.
  } deriving (TxTicket tx -> TxTicket tx -> Bool
(TxTicket tx -> TxTicket tx -> Bool)
-> (TxTicket tx -> TxTicket tx -> Bool) -> Eq (TxTicket tx)
forall tx. Eq tx => TxTicket tx -> TxTicket tx -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxTicket tx -> TxTicket tx -> Bool
$c/= :: forall tx. Eq tx => TxTicket tx -> TxTicket tx -> Bool
== :: TxTicket tx -> TxTicket tx -> Bool
$c== :: forall tx. Eq tx => TxTicket tx -> TxTicket tx -> Bool
Eq, Int -> TxTicket tx -> ShowS
[TxTicket tx] -> ShowS
TxTicket tx -> String
(Int -> TxTicket tx -> ShowS)
-> (TxTicket tx -> String)
-> ([TxTicket tx] -> ShowS)
-> Show (TxTicket tx)
forall tx. Show tx => Int -> TxTicket tx -> ShowS
forall tx. Show tx => [TxTicket tx] -> ShowS
forall tx. Show tx => TxTicket tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxTicket tx] -> ShowS
$cshowList :: forall tx. Show tx => [TxTicket tx] -> ShowS
show :: TxTicket tx -> String
$cshow :: forall tx. Show tx => TxTicket tx -> String
showsPrec :: Int -> TxTicket tx -> ShowS
$cshowsPrec :: forall tx. Show tx => Int -> TxTicket tx -> ShowS
Show, (forall x. TxTicket tx -> Rep (TxTicket tx) x)
-> (forall x. Rep (TxTicket tx) x -> TxTicket tx)
-> Generic (TxTicket tx)
forall x. Rep (TxTicket tx) x -> TxTicket tx
forall x. TxTicket tx -> Rep (TxTicket tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (TxTicket tx) x -> TxTicket tx
forall tx x. TxTicket tx -> Rep (TxTicket tx) x
$cto :: forall tx x. Rep (TxTicket tx) x -> TxTicket tx
$cfrom :: forall tx x. TxTicket tx -> Rep (TxTicket tx) x
Generic, Context -> TxTicket tx -> IO (Maybe ThunkInfo)
Proxy (TxTicket tx) -> String
(Context -> TxTicket tx -> IO (Maybe ThunkInfo))
-> (Context -> TxTicket tx -> IO (Maybe ThunkInfo))
-> (Proxy (TxTicket tx) -> String)
-> NoThunks (TxTicket tx)
forall tx.
NoThunks tx =>
Context -> TxTicket tx -> IO (Maybe ThunkInfo)
forall tx. NoThunks tx => Proxy (TxTicket tx) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxTicket tx) -> String
$cshowTypeOf :: forall tx. NoThunks tx => Proxy (TxTicket tx) -> String
wNoThunks :: Context -> TxTicket tx -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall tx.
NoThunks tx =>
Context -> TxTicket tx -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxTicket tx -> IO (Maybe ThunkInfo)
$cnoThunks :: forall tx.
NoThunks tx =>
Context -> TxTicket tx -> IO (Maybe ThunkInfo)
NoThunks)

-- | The mempool is a sequence of transactions with their ticket numbers and
-- size in bytes.
--
-- Transactions are allocated monotonically increasing ticket numbers as they
-- are appended to the mempool sequence. Transactions can be removed from any
-- position, not just the front.
--
-- The sequence is thus ordered by the ticket numbers. We can use the ticket
-- numbers as a compact representation for a \"reader\" location in the
-- sequence. If a reader knows it has seen all txs with a lower ticket number
-- then it is only interested in transactions with higher ticket numbers.
--
-- The mempool sequence is represented by a fingertree. We use a fingertree
-- measure to allow not just normal sequence operations but also efficient
-- splitting and indexing by the ticket number.
--
newtype TxSeq tx = TxSeq (StrictFingerTree TxSeqMeasure (TxTicket tx))
  deriving stock   (Int -> TxSeq tx -> ShowS
[TxSeq tx] -> ShowS
TxSeq tx -> String
(Int -> TxSeq tx -> ShowS)
-> (TxSeq tx -> String) -> ([TxSeq tx] -> ShowS) -> Show (TxSeq tx)
forall tx. Show tx => Int -> TxSeq tx -> ShowS
forall tx. Show tx => [TxSeq tx] -> ShowS
forall tx. Show tx => TxSeq tx -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxSeq tx] -> ShowS
$cshowList :: forall tx. Show tx => [TxSeq tx] -> ShowS
show :: TxSeq tx -> String
$cshow :: forall tx. Show tx => TxSeq tx -> String
showsPrec :: Int -> TxSeq tx -> ShowS
$cshowsPrec :: forall tx. Show tx => Int -> TxSeq tx -> ShowS
Show)
  deriving newtype (Context -> TxSeq tx -> IO (Maybe ThunkInfo)
Proxy (TxSeq tx) -> String
(Context -> TxSeq tx -> IO (Maybe ThunkInfo))
-> (Context -> TxSeq tx -> IO (Maybe ThunkInfo))
-> (Proxy (TxSeq tx) -> String)
-> NoThunks (TxSeq tx)
forall tx.
NoThunks tx =>
Context -> TxSeq tx -> IO (Maybe ThunkInfo)
forall tx. NoThunks tx => Proxy (TxSeq tx) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (TxSeq tx) -> String
$cshowTypeOf :: forall tx. NoThunks tx => Proxy (TxSeq tx) -> String
wNoThunks :: Context -> TxSeq tx -> IO (Maybe ThunkInfo)
$cwNoThunks :: forall tx.
NoThunks tx =>
Context -> TxSeq tx -> IO (Maybe ThunkInfo)
noThunks :: Context -> TxSeq tx -> IO (Maybe ThunkInfo)
$cnoThunks :: forall tx.
NoThunks tx =>
Context -> TxSeq tx -> IO (Maybe ThunkInfo)
NoThunks)

instance Foldable TxSeq where
  foldMap :: (a -> m) -> TxSeq a -> m
foldMap a -> m
f (TxSeq StrictFingerTree TxSeqMeasure (TxTicket a)
txs) = (TxTicket a -> m)
-> StrictFingerTree TxSeqMeasure (TxTicket a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
Foldable.foldMap (a -> m
f (a -> m) -> (TxTicket a -> a) -> TxTicket a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxTicket a -> a
forall tx. TxTicket tx -> tx
txTicketTx) StrictFingerTree TxSeqMeasure (TxTicket a)
txs
  null :: TxSeq a -> Bool
null      (TxSeq StrictFingerTree TxSeqMeasure (TxTicket a)
txs) = StrictFingerTree TxSeqMeasure (TxTicket a) -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Foldable.null StrictFingerTree TxSeqMeasure (TxTicket a)
txs
  length :: TxSeq a -> Int
length    (TxSeq StrictFingerTree TxSeqMeasure (TxTicket a)
txs) = TxSeqMeasure -> Int
mSize (TxSeqMeasure -> Int) -> TxSeqMeasure -> Int
forall a b. (a -> b) -> a -> b
$ StrictFingerTree TxSeqMeasure (TxTicket a) -> TxSeqMeasure
forall v a. Measured v a => a -> v
FingerTree.measure StrictFingerTree TxSeqMeasure (TxTicket a)
txs

-- | The 'StrictFingerTree' relies on a \"measure\" for subsequences in the
-- tree. A measure of the size of the subsequence allows for efficient
-- sequence operations. Also measuring the min and max ticket number allows
-- for efficient operations based on the ticket number (assuming the sequence
-- is ordered by ticket number).
--
-- To use a 'StrictFingerTree' with a 'TxSeqMeasure' we have to provide a way
-- to measure individual elements of the sequence (i.e. 'TxTicket's), via a
-- 'Measured' instance, and also a way to combine the measures, via a 'Monoid'
-- instance.
--
data TxSeqMeasure = TxSeqMeasure {
       TxSeqMeasure -> TicketNo
mMinTicket :: !TicketNo,
       TxSeqMeasure -> TicketNo
mMaxTicket :: !TicketNo,
       TxSeqMeasure -> TxSizeInBytes
mSizeBytes :: !TxSizeInBytes,
       TxSeqMeasure -> Int
mSize      :: !Int
     }
  deriving Int -> TxSeqMeasure -> ShowS
[TxSeqMeasure] -> ShowS
TxSeqMeasure -> String
(Int -> TxSeqMeasure -> ShowS)
-> (TxSeqMeasure -> String)
-> ([TxSeqMeasure] -> ShowS)
-> Show TxSeqMeasure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxSeqMeasure] -> ShowS
$cshowList :: [TxSeqMeasure] -> ShowS
show :: TxSeqMeasure -> String
$cshow :: TxSeqMeasure -> String
showsPrec :: Int -> TxSeqMeasure -> ShowS
$cshowsPrec :: Int -> TxSeqMeasure -> ShowS
Show

instance FingerTree.Measured TxSeqMeasure (TxTicket tx) where
  measure :: TxTicket tx -> TxSeqMeasure
measure (TxTicket tx
_ TicketNo
tno TxSizeInBytes
tsz) = TicketNo -> TicketNo -> TxSizeInBytes -> Int -> TxSeqMeasure
TxSeqMeasure TicketNo
tno TicketNo
tno TxSizeInBytes
tsz Int
1

instance Semigroup TxSeqMeasure where
  TxSeqMeasure
vl <> :: TxSeqMeasure -> TxSeqMeasure -> TxSeqMeasure
<> TxSeqMeasure
vr = TicketNo -> TicketNo -> TxSizeInBytes -> Int -> TxSeqMeasure
TxSeqMeasure
               (TxSeqMeasure -> TicketNo
mMinTicket TxSeqMeasure
vl TicketNo -> TicketNo -> TicketNo
forall a. Ord a => a -> a -> a
`min` TxSeqMeasure -> TicketNo
mMinTicket TxSeqMeasure
vr)
               (TxSeqMeasure -> TicketNo
mMaxTicket TxSeqMeasure
vl TicketNo -> TicketNo -> TicketNo
forall a. Ord a => a -> a -> a
`max` TxSeqMeasure -> TicketNo
mMaxTicket TxSeqMeasure
vr)
               (TxSeqMeasure -> TxSizeInBytes
mSizeBytes TxSeqMeasure
vl   TxSizeInBytes -> TxSizeInBytes -> TxSizeInBytes
forall a. Num a => a -> a -> a
+   TxSeqMeasure -> TxSizeInBytes
mSizeBytes TxSeqMeasure
vr)
               (TxSeqMeasure -> Int
mSize      TxSeqMeasure
vl   Int -> Int -> Int
forall a. Num a => a -> a -> a
+   TxSeqMeasure -> Int
mSize      TxSeqMeasure
vr)

instance Monoid TxSeqMeasure where
  mempty :: TxSeqMeasure
mempty  = TicketNo -> TicketNo -> TxSizeInBytes -> Int -> TxSeqMeasure
TxSeqMeasure TicketNo
forall a. Bounded a => a
maxBound TicketNo
forall a. Bounded a => a
minBound TxSizeInBytes
0 Int
0
  mappend :: TxSeqMeasure -> TxSeqMeasure -> TxSeqMeasure
mappend = TxSeqMeasure -> TxSeqMeasure -> TxSeqMeasure
forall a. Semigroup a => a -> a -> a
(<>)

-- | A helper function for the ':>' pattern.
--
viewBack :: TxSeq tx -> Maybe (TxSeq tx, TxTicket tx)
viewBack :: TxSeq tx -> Maybe (TxSeq tx, TxTicket tx)
viewBack (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs) = case StrictFingerTree TxSeqMeasure (TxTicket tx)
-> ViewR (StrictFingerTree TxSeqMeasure) (TxTicket tx)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewR (StrictFingerTree v) a
FingerTree.viewr StrictFingerTree TxSeqMeasure (TxTicket tx)
txs of
                         ViewR (StrictFingerTree TxSeqMeasure) (TxTicket tx)
FingerTree.EmptyR     -> Maybe (TxSeq tx, TxTicket tx)
forall a. Maybe a
Nothing
                         StrictFingerTree TxSeqMeasure (TxTicket tx)
txs' FingerTree.:> TxTicket tx
tx -> (TxSeq tx, TxTicket tx) -> Maybe (TxSeq tx, TxTicket tx)
forall a. a -> Maybe a
Just (StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs', TxTicket tx
tx)

-- | A helper function for the ':<' pattern.
--
viewFront :: TxSeq tx -> Maybe (TxTicket tx, TxSeq tx)
viewFront :: TxSeq tx -> Maybe (TxTicket tx, TxSeq tx)
viewFront (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs) = case StrictFingerTree TxSeqMeasure (TxTicket tx)
-> ViewL (StrictFingerTree TxSeqMeasure) (TxTicket tx)
forall v a.
Measured v a =>
StrictFingerTree v a -> ViewL (StrictFingerTree v) a
FingerTree.viewl StrictFingerTree TxSeqMeasure (TxTicket tx)
txs of
                          ViewL (StrictFingerTree TxSeqMeasure) (TxTicket tx)
FingerTree.EmptyL     -> Maybe (TxTicket tx, TxSeq tx)
forall a. Maybe a
Nothing
                          TxTicket tx
tx FingerTree.:< StrictFingerTree TxSeqMeasure (TxTicket tx)
txs' -> (TxTicket tx, TxSeq tx) -> Maybe (TxTicket tx, TxSeq tx)
forall a. a -> Maybe a
Just (TxTicket tx
tx, StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs')

-- | An empty mempool sequence.
--
pattern Empty :: TxSeq tx
pattern $bEmpty :: TxSeq tx
$mEmpty :: forall r tx. TxSeq tx -> (Void# -> r) -> (Void# -> r) -> r
Empty <- (viewFront -> Nothing) where
  Empty = StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
forall v a. Measured v a => StrictFingerTree v a
FingerTree.empty

-- | \( O(1) \). Access or add a tx at the back of the mempool sequence.
--
-- New txs are always added at the back.
--
pattern (:>) :: TxSeq tx -> TxTicket tx -> TxSeq tx
pattern txs $b:> :: TxSeq tx -> TxTicket tx -> TxSeq tx
$m:> :: forall r tx.
TxSeq tx -> (TxSeq tx -> TxTicket tx -> r) -> (Void# -> r) -> r
:> tx <- (viewBack -> Just (txs, tx)) where
  TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs :> TxTicket tx
tx = StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq (StrictFingerTree TxSeqMeasure (TxTicket tx)
txs StrictFingerTree TxSeqMeasure (TxTicket tx)
-> TxTicket tx -> StrictFingerTree TxSeqMeasure (TxTicket tx)
forall v a.
Measured v a =>
StrictFingerTree v a -> a -> StrictFingerTree v a
FingerTree.|> TxTicket tx
tx)  --TODO: assert ordered by ticket no

-- | \( O(1) \). Access a tx at the front of the mempool sequence.
--
-- Note that we never add txs at the front. We access txs from front to back
-- when forwarding txs to other peers, or when adding txs to blocks.
--
pattern (:<) :: TxTicket tx -> TxSeq tx -> TxSeq tx
pattern tx $m:< :: forall r tx.
TxSeq tx -> (TxTicket tx -> TxSeq tx -> r) -> (Void# -> r) -> r
:< txs <- (viewFront -> Just (tx, txs))

infixl 5 :>, :<

{-# COMPLETE Empty, (:>) #-}
{-# COMPLETE Empty, (:<) #-}


-- | \( O(\log(n)) \). Look up a transaction in the sequence by its 'TicketNo'.
--
lookupByTicketNo :: TxSeq tx -> TicketNo -> Maybe tx
lookupByTicketNo :: TxSeq tx -> TicketNo -> Maybe tx
lookupByTicketNo (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs) TicketNo
n =
    case (TxSeqMeasure -> TxSeqMeasure -> Bool)
-> StrictFingerTree TxSeqMeasure (TxTicket tx)
-> SearchResult TxSeqMeasure (TxTicket tx)
forall v a.
Measured v a =>
(v -> v -> Bool) -> StrictFingerTree v a -> SearchResult v a
FingerTree.search (\TxSeqMeasure
ml TxSeqMeasure
mr -> TxSeqMeasure -> TicketNo
mMaxTicket TxSeqMeasure
ml TicketNo -> TicketNo -> Bool
forall a. Ord a => a -> a -> Bool
>= TicketNo
n
                                   Bool -> Bool -> Bool
&& TxSeqMeasure -> TicketNo
mMinTicket TxSeqMeasure
mr TicketNo -> TicketNo -> Bool
forall a. Ord a => a -> a -> Bool
>  TicketNo
n) StrictFingerTree TxSeqMeasure (TxTicket tx)
txs of
      FingerTree.Position StrictFingerTree TxSeqMeasure (TxTicket tx)
_ (TxTicket tx
tx TicketNo
n' TxSizeInBytes
_) StrictFingerTree TxSeqMeasure (TxTicket tx)
_ | TicketNo
n' TicketNo -> TicketNo -> Bool
forall a. Eq a => a -> a -> Bool
== TicketNo
n -> tx -> Maybe tx
forall a. a -> Maybe a
Just tx
tx
      SearchResult TxSeqMeasure (TxTicket tx)
_                                                    -> Maybe tx
forall a. Maybe a
Nothing

-- | \( O(\log(n)) \). Split the sequence of transactions into two parts
-- based on the given 'TicketNo'. The first part has transactions with tickets
-- less than or equal to the given ticket, and the second part has transactions
-- with tickets strictly greater than the given ticket.
--
splitAfterTicketNo :: TxSeq tx -> TicketNo -> (TxSeq tx, TxSeq tx)
splitAfterTicketNo :: TxSeq tx -> TicketNo -> (TxSeq tx, TxSeq tx)
splitAfterTicketNo (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs) TicketNo
n =
    case (TxSeqMeasure -> Bool)
-> StrictFingerTree TxSeqMeasure (TxTicket tx)
-> (StrictFingerTree TxSeqMeasure (TxTicket tx),
    StrictFingerTree TxSeqMeasure (TxTicket tx))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FingerTree.split (\TxSeqMeasure
m -> TxSeqMeasure -> TicketNo
mMaxTicket TxSeqMeasure
m TicketNo -> TicketNo -> Bool
forall a. Ord a => a -> a -> Bool
> TicketNo
n) StrictFingerTree TxSeqMeasure (TxTicket tx)
txs of
      (StrictFingerTree TxSeqMeasure (TxTicket tx)
l, StrictFingerTree TxSeqMeasure (TxTicket tx)
r) -> (StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
l, StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
r)

-- | \( O(\log(n)) \). Split the sequence of transactions into two parts
-- based on the given 'TxSizeInBytes'. The first part has transactions whose
-- summed 'TxSizeInBytes' is less than or equal to the given 'TxSizeInBytes',
-- and the second part has the remaining transactions in the sequence.
--
splitAfterTxSize :: TxSeq tx -> TxSizeInBytes -> (TxSeq tx, TxSeq tx)
splitAfterTxSize :: TxSeq tx -> TxSizeInBytes -> (TxSeq tx, TxSeq tx)
splitAfterTxSize (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
txs) TxSizeInBytes
n =
    case (TxSeqMeasure -> Bool)
-> StrictFingerTree TxSeqMeasure (TxTicket tx)
-> (StrictFingerTree TxSeqMeasure (TxTicket tx),
    StrictFingerTree TxSeqMeasure (TxTicket tx))
forall v a.
Measured v a =>
(v -> Bool)
-> StrictFingerTree v a
-> (StrictFingerTree v a, StrictFingerTree v a)
FingerTree.split (\TxSeqMeasure
m -> TxSeqMeasure -> TxSizeInBytes
mSizeBytes TxSeqMeasure
m TxSizeInBytes -> TxSizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
> TxSizeInBytes
n) StrictFingerTree TxSeqMeasure (TxTicket tx)
txs of
      (StrictFingerTree TxSeqMeasure (TxTicket tx)
l, StrictFingerTree TxSeqMeasure (TxTicket tx)
r) -> (StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
l, StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
forall tx. StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeq tx
TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
r)

-- | \( O(n) \). Specification of 'splitAfterTxSize'.
--
-- Use 'splitAfterTxSize' as it should be faster.
--
-- This function is used to verify whether 'splitAfterTxSize' behaves as
-- expected.
splitAfterTxSizeSpec :: TxSeq tx -> TxSizeInBytes -> (TxSeq tx, TxSeq tx)
splitAfterTxSizeSpec :: TxSeq tx -> TxSizeInBytes -> (TxSeq tx, TxSeq tx)
splitAfterTxSizeSpec TxSeq tx
txseq TxSizeInBytes
n =
    ([TxTicket tx] -> TxSeq tx)
-> ([TxTicket tx], [TxTicket tx]) -> (TxSeq tx, TxSeq tx)
forall a b. (a -> b) -> (a, a) -> (b, b)
mapTuple [TxTicket tx] -> TxSeq tx
forall tx. [TxTicket tx] -> TxSeq tx
fromList (([TxTicket tx], [TxTicket tx]) -> (TxSeq tx, TxSeq tx))
-> ([TxTicket tx], [TxTicket tx]) -> (TxSeq tx, TxSeq tx)
forall a b. (a -> b) -> a -> b
$ TxSizeInBytes
-> [TxTicket tx] -> [TxTicket tx] -> ([TxTicket tx], [TxTicket tx])
forall tx.
TxSizeInBytes
-> [TxTicket tx] -> [TxTicket tx] -> ([TxTicket tx], [TxTicket tx])
go TxSizeInBytes
0 [] (TxSeq tx -> [TxTicket tx]
forall tx. TxSeq tx -> [TxTicket tx]
toList TxSeq tx
txseq)
  where
    mapTuple :: (a -> b) -> (a, a) -> (b, b)
    mapTuple :: (a -> b) -> (a, a) -> (b, b)
mapTuple a -> b
f (a
x, a
y) = (a -> b
f a
x, a -> b
f a
y)

    go :: TxSizeInBytes
       -> [TxTicket tx]
       -> [TxTicket tx]
       -> ([TxTicket tx], [TxTicket tx])
    go :: TxSizeInBytes
-> [TxTicket tx] -> [TxTicket tx] -> ([TxTicket tx], [TxTicket tx])
go TxSizeInBytes
accByteSize [TxTicket tx]
accTickets = \case
      []
        -> ([TxTicket tx] -> [TxTicket tx]
forall a. [a] -> [a]
reverse [TxTicket tx]
accTickets, [])
      TxTicket tx
t:[TxTicket tx]
ts
        | let accByteSize' :: TxSizeInBytes
accByteSize' = TxSizeInBytes
accByteSize TxSizeInBytes -> TxSizeInBytes -> TxSizeInBytes
forall a. Num a => a -> a -> a
+ TxTicket tx -> TxSizeInBytes
forall tx. TxTicket tx -> TxSizeInBytes
txTicketTxSizeInBytes TxTicket tx
t
        , TxSizeInBytes
accByteSize' TxSizeInBytes -> TxSizeInBytes -> Bool
forall a. Ord a => a -> a -> Bool
<= TxSizeInBytes
n
        -> TxSizeInBytes
-> [TxTicket tx] -> [TxTicket tx] -> ([TxTicket tx], [TxTicket tx])
forall tx.
TxSizeInBytes
-> [TxTicket tx] -> [TxTicket tx] -> ([TxTicket tx], [TxTicket tx])
go TxSizeInBytes
accByteSize' (TxTicket tx
tTxTicket tx -> [TxTicket tx] -> [TxTicket tx]
forall a. a -> [a] -> [a]
:[TxTicket tx]
accTickets) [TxTicket tx]
ts
        | Bool
otherwise
        -> ([TxTicket tx] -> [TxTicket tx]
forall a. [a] -> [a]
reverse [TxTicket tx]
accTickets, TxTicket tx
tTxTicket tx -> [TxTicket tx] -> [TxTicket tx]
forall a. a -> [a] -> [a]
:[TxTicket tx]
ts)

-- | Given a list of 'TxTicket's, construct a 'TxSeq'.
fromList :: [TxTicket tx] -> TxSeq tx
fromList :: [TxTicket tx] -> TxSeq tx
fromList = (TxSeq tx -> TxTicket tx -> TxSeq tx)
-> TxSeq tx -> [TxTicket tx] -> TxSeq tx
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
Foldable.foldl' TxSeq tx -> TxTicket tx -> TxSeq tx
forall tx. TxSeq tx -> TxTicket tx -> TxSeq tx
(:>) TxSeq tx
forall tx. TxSeq tx
Empty

-- | Convert a 'TxSeq' to a list of 'TxTicket's.
toList :: TxSeq tx -> [TxTicket tx]
toList :: TxSeq tx -> [TxTicket tx]
toList (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
ftree) = StrictFingerTree TxSeqMeasure (TxTicket tx) -> [TxTicket tx]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictFingerTree TxSeqMeasure (TxTicket tx)
ftree

-- | Convert a 'TxSeq' to a list of pairs of transactions and their
-- associated 'TicketNo's.
toTuples :: TxSeq tx -> [(tx, TicketNo)]
toTuples :: TxSeq tx -> [(tx, TicketNo)]
toTuples (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
ftree) = (TxTicket tx -> (tx, TicketNo))
-> [TxTicket tx] -> [(tx, TicketNo)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    (\TxTicket tx
ticket -> (TxTicket tx -> tx
forall tx. TxTicket tx -> tx
txTicketTx TxTicket tx
ticket, TxTicket tx -> TicketNo
forall tx. TxTicket tx -> TicketNo
txTicketNo TxTicket tx
ticket))
    (StrictFingerTree TxSeqMeasure (TxTicket tx) -> [TxTicket tx]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList StrictFingerTree TxSeqMeasure (TxTicket tx)
ftree)

-- | \( O(1) \). Return the 'MempoolSize' of the given 'TxSeq'.
toMempoolSize :: TxSeq tx -> MempoolSize
toMempoolSize :: TxSeq tx -> MempoolSize
toMempoolSize (TxSeq StrictFingerTree TxSeqMeasure (TxTicket tx)
ftree) = MempoolSize :: TxSizeInBytes -> TxSizeInBytes -> MempoolSize
MempoolSize
    { msNumTxs :: TxSizeInBytes
msNumTxs   = Int -> TxSizeInBytes
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
mSize
    , msNumBytes :: TxSizeInBytes
msNumBytes = TxSizeInBytes
mSizeBytes
    }
  where
    TxSeqMeasure { TxSizeInBytes
mSizeBytes :: TxSizeInBytes
mSizeBytes :: TxSeqMeasure -> TxSizeInBytes
mSizeBytes, Int
mSize :: Int
mSize :: TxSeqMeasure -> Int
mSize } = StrictFingerTree TxSeqMeasure (TxTicket tx) -> TxSeqMeasure
forall v a. Measured v a => a -> v
FingerTree.measure StrictFingerTree TxSeqMeasure (TxTicket tx)
ftree