{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}

module Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server (localTxMonitorServer) where

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import qualified Data.Measure as Measure
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Mempool
import Ouroboros.Consensus.Util.IOLike
import Ouroboros.Network.Protocol.LocalTxMonitor.Server
import Ouroboros.Network.Protocol.LocalTxMonitor.Type

-- | Local transaction monitoring server, for inspecting the mempool.
localTxMonitorServer ::
  forall blk m.
  ( MonadSTM m
  , LedgerSupportsMempool blk
  ) =>
  Mempool m blk ->
  LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
localTxMonitorServer :: forall blk (m :: * -> *).
(MonadSTM m, LedgerSupportsMempool blk) =>
Mempool m blk
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
localTxMonitorServer Mempool m blk
mempool =
  m (ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ())
-> LocalTxMonitorServer (GenTxId blk) (GenTx blk) SlotNo m ()
forall txid tx slot (m :: * -> *) a.
m (ServerStIdle txid tx slot m a)
-> LocalTxMonitorServer txid tx slot m a
LocalTxMonitorServer (ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ()
serverStIdle)
 where
  serverStIdle ::
    ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ()
  serverStIdle :: ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ()
serverStIdle =
    ServerStIdle
      { recvMsgDone :: m ()
recvMsgDone = do
          () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      , recvMsgAcquire :: m (ServerStAcquiring (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgAcquire = do
          s <-
            STM m (TxMeasure blk, MempoolSnapshot blk)
-> m (TxMeasure blk, MempoolSnapshot blk)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (TxMeasure blk, MempoolSnapshot blk)
 -> m (TxMeasure blk, MempoolSnapshot blk))
-> STM m (TxMeasure blk, MempoolSnapshot blk)
-> m (TxMeasure blk, MempoolSnapshot blk)
forall a b. (a -> b) -> a -> b
$
              (,)
                (TxMeasure blk
 -> MempoolSnapshot blk -> (TxMeasure blk, MempoolSnapshot blk))
-> STM m (TxMeasure blk)
-> STM
     m (MempoolSnapshot blk -> (TxMeasure blk, MempoolSnapshot blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mempool m blk -> STM m (TxMeasure blk)
forall (m :: * -> *) blk. Mempool m blk -> STM m (TxMeasure blk)
getCapacity Mempool m blk
mempool
                STM m (MempoolSnapshot blk -> (TxMeasure blk, MempoolSnapshot blk))
-> STM m (MempoolSnapshot blk)
-> STM m (TxMeasure blk, MempoolSnapshot blk)
forall a b. STM m (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mempool m blk -> STM m (MempoolSnapshot blk)
forall (m :: * -> *) blk.
Mempool m blk -> STM m (MempoolSnapshot blk)
getSnapshot Mempool m blk
mempool
          pure $ serverStAcquiring s
      }

  serverStAcquiring ::
    (TxMeasure blk, MempoolSnapshot blk) ->
    ServerStAcquiring (GenTxId blk) (GenTx blk) SlotNo m ()
  serverStAcquiring :: (TxMeasure blk, MempoolSnapshot blk)
-> ServerStAcquiring (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquiring s :: (TxMeasure blk, MempoolSnapshot blk)
s@(TxMeasure blk
_, MempoolSnapshot blk
snapshot) =
    SlotNo
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
-> ServerStAcquiring (GenTxId blk) (GenTx blk) SlotNo m ()
forall slot txid tx (m :: * -> *) a.
slot
-> ServerStAcquired txid tx slot m a
-> ServerStAcquiring txid tx slot m a
SendMsgAcquired (MempoolSnapshot blk -> SlotNo
forall blk. MempoolSnapshot blk -> SlotNo
snapshotSlotNo MempoolSnapshot blk
snapshot) ((TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired (TxMeasure blk, MempoolSnapshot blk)
s (MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
forall blk.
MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxs MempoolSnapshot blk
snapshot))

  serverStAcquired ::
    (TxMeasure blk, MempoolSnapshot blk) ->
    [(Validated (GenTx blk), idx, TxMeasure blk)] ->
    ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
  serverStAcquired :: forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired s :: (TxMeasure blk, MempoolSnapshot blk)
s@(TxMeasure blk
capacity, MempoolSnapshot blk
snapshot) [(Validated (GenTx blk), idx, TxMeasure blk)]
txs =
    ServerStAcquired
      { recvMsgNextTx :: m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgNextTx =
          case [(Validated (GenTx blk), idx, TxMeasure blk)]
txs of
            [] ->
              ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
 -> m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()))
-> ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ())
forall a b. (a -> b) -> a -> b
$ Maybe (GenTx blk)
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
-> ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
forall tx txid slot (m :: * -> *) a.
Maybe tx
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'NextTx txid tx slot m a
SendMsgReplyNextTx Maybe (GenTx blk)
forall a. Maybe a
Nothing ((TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), ZonkAny 0, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired (TxMeasure blk, MempoolSnapshot blk)
s [])
            (Validated (GenTx blk) -> GenTx blk
forall blk.
LedgerSupportsMempool blk =>
Validated (GenTx blk) -> GenTx blk
txForgetValidated -> GenTx blk
h, idx
_tno, TxMeasure blk
_byteSize) : [(Validated (GenTx blk), idx, TxMeasure blk)]
q ->
              ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
 -> m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()))
-> ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ())
forall a b. (a -> b) -> a -> b
$ Maybe (GenTx blk)
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
-> ServerStBusy 'NextTx (GenTxId blk) (GenTx blk) SlotNo m ()
forall tx txid slot (m :: * -> *) a.
Maybe tx
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'NextTx txid tx slot m a
SendMsgReplyNextTx (GenTx blk -> Maybe (GenTx blk)
forall a. a -> Maybe a
Just GenTx blk
h) ((TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired (TxMeasure blk, MempoolSnapshot blk)
s [(Validated (GenTx blk), idx, TxMeasure blk)]
q)
      , recvMsgHasTx :: GenTxId blk
-> m (ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgHasTx = \GenTxId blk
txid ->
          ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ()
 -> m (ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ()))
-> ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ())
forall a b. (a -> b) -> a -> b
$ Bool
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
-> ServerStBusy 'HasTx (GenTxId blk) (GenTx blk) SlotNo m ()
forall txid tx slot (m :: * -> *) a.
Bool
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'HasTx txid tx slot m a
SendMsgReplyHasTx (MempoolSnapshot blk -> GenTxId blk -> Bool
forall blk. MempoolSnapshot blk -> GenTxId blk -> Bool
snapshotHasTx MempoolSnapshot blk
snapshot GenTxId blk
txid) ((TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired (TxMeasure blk, MempoolSnapshot blk)
s [(Validated (GenTx blk), idx, TxMeasure blk)]
txs)
      , recvMsgGetSizes :: m (ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgGetSizes = do
          let MempoolSize{Word32
msNumTxs :: Word32
msNumTxs :: MempoolSize -> Word32
msNumTxs, ByteSize32
msNumBytes :: ByteSize32
msNumBytes :: MempoolSize -> ByteSize32
msNumBytes} = MempoolSnapshot blk -> MempoolSize
forall blk. MempoolSnapshot blk -> MempoolSize
snapshotMempoolSize MempoolSnapshot blk
snapshot
          let sizes :: MempoolSizeAndCapacity
sizes =
                MempoolSizeAndCapacity
                  { capacityInBytes :: Word32
capacityInBytes = ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> Word32) -> ByteSize32 -> Word32
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize TxMeasure blk
capacity
                  , sizeInBytes :: Word32
sizeInBytes = ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> Word32) -> ByteSize32 -> Word32
forall a b. (a -> b) -> a -> b
$ ByteSize32 -> ByteSize32
forall a. HasByteSize a => a -> ByteSize32
txMeasureByteSize ByteSize32
msNumBytes
                  , numberOfTxs :: Word32
numberOfTxs = Word32
msNumTxs
                  }
          ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ()
 -> m (ServerStBusy
         'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ()))
-> ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ())
forall a b. (a -> b) -> a -> b
$ MempoolSizeAndCapacity
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
-> ServerStBusy 'GetSizes (GenTxId blk) (GenTx blk) SlotNo m ()
forall txid tx slot (m :: * -> *) a.
MempoolSizeAndCapacity
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'GetSizes txid tx slot m a
SendMsgReplyGetSizes MempoolSizeAndCapacity
sizes ((TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired (TxMeasure blk, MempoolSnapshot blk)
s [(Validated (GenTx blk), idx, TxMeasure blk)]
txs)
      , recvMsgGetMeasures :: m (ServerStBusy 'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgGetMeasures = do
          let txsMeasures :: TxMeasure blk
txsMeasures =
                (TxMeasure blk
 -> (Validated (GenTx blk), idx, TxMeasure blk) -> TxMeasure blk)
-> TxMeasure blk
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> TxMeasure blk
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\TxMeasure blk
acc (Validated (GenTx blk)
_, idx
_, TxMeasure blk
m) -> TxMeasure blk -> TxMeasure blk -> TxMeasure blk
forall a. Measure a => a -> a -> a
Measure.plus TxMeasure blk
acc TxMeasure blk
m) TxMeasure blk
forall a. Measure a => a
Measure.zero [(Validated (GenTx blk), idx, TxMeasure blk)]
txs
              measures :: MempoolMeasures
measures =
                MempoolMeasures
                  { txCount :: Word32
txCount = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [(Validated (GenTx blk), idx, TxMeasure blk)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Validated (GenTx blk), idx, TxMeasure blk)]
txs
                  , measuresMap :: Map MeasureName (SizeAndCapacity Integer)
measuresMap =
                      Proxy blk
-> TxMeasure blk
-> TxMeasure blk
-> Map MeasureName (SizeAndCapacity Integer)
forall blk.
TxMeasureMetrics (TxMeasure blk) =>
Proxy blk
-> TxMeasure blk
-> TxMeasure blk
-> Map MeasureName (SizeAndCapacity Integer)
mkMeasuresMap (Proxy blk
forall {k} (t :: k). Proxy t
Proxy :: Proxy blk) TxMeasure blk
txsMeasures TxMeasure blk
capacity
                  }
          ServerStBusy 'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy
        'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ServerStBusy 'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ()
 -> m (ServerStBusy
         'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ()))
-> ServerStBusy 'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStBusy
        'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ())
forall a b. (a -> b) -> a -> b
$ MempoolMeasures
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
-> ServerStBusy 'GetMeasures (GenTxId blk) (GenTx blk) SlotNo m ()
forall txid tx slot (m :: * -> *) a.
MempoolMeasures
-> ServerStAcquired txid tx slot m a
-> ServerStBusy 'GetMeasures txid tx slot m a
SendMsgReplyGetMeasures MempoolMeasures
measures ((TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
forall idx.
(TxMeasure blk, MempoolSnapshot blk)
-> [(Validated (GenTx blk), idx, TxMeasure blk)]
-> ServerStAcquired (GenTxId blk) (GenTx blk) SlotNo m ()
serverStAcquired (TxMeasure blk, MempoolSnapshot blk)
s [(Validated (GenTx blk), idx, TxMeasure blk)]
txs)
      , recvMsgAwaitAcquire :: m (ServerStAcquiring (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgAwaitAcquire = do
          s' <- STM m (TxMeasure blk, MempoolSnapshot blk)
-> m (TxMeasure blk, MempoolSnapshot blk)
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m (TxMeasure blk, MempoolSnapshot blk)
 -> m (TxMeasure blk, MempoolSnapshot blk))
-> STM m (TxMeasure blk, MempoolSnapshot blk)
-> m (TxMeasure blk, MempoolSnapshot blk)
forall a b. (a -> b) -> a -> b
$ do
            s'@(_, snapshot') <-
              (,)
                (TxMeasure blk
 -> MempoolSnapshot blk -> (TxMeasure blk, MempoolSnapshot blk))
-> STM m (TxMeasure blk)
-> STM
     m (MempoolSnapshot blk -> (TxMeasure blk, MempoolSnapshot blk))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mempool m blk -> STM m (TxMeasure blk)
forall (m :: * -> *) blk. Mempool m blk -> STM m (TxMeasure blk)
getCapacity Mempool m blk
mempool
                STM m (MempoolSnapshot blk -> (TxMeasure blk, MempoolSnapshot blk))
-> STM m (MempoolSnapshot blk)
-> STM m (TxMeasure blk, MempoolSnapshot blk)
forall a b. STM m (a -> b) -> STM m a -> STM m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mempool m blk -> STM m (MempoolSnapshot blk)
forall (m :: * -> *) blk.
Mempool m blk -> STM m (MempoolSnapshot blk)
getSnapshot Mempool m blk
mempool
            s' <$ check (not (snapshot `isSameSnapshot` snapshot'))
          pure $ serverStAcquiring s'
      , recvMsgRelease :: m (ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ())
recvMsgRelease =
          ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ()
-> m (ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ServerStIdle (GenTxId blk) (GenTx blk) SlotNo m ()
serverStIdle
      }

  -- Are two snapshots equal? (from the perspective of this protocol)
  isSameSnapshot ::
    MempoolSnapshot blk ->
    MempoolSnapshot blk ->
    Bool
  isSameSnapshot :: MempoolSnapshot blk -> MempoolSnapshot blk -> Bool
isSameSnapshot MempoolSnapshot blk
a MempoolSnapshot blk
b =
    ((Validated (GenTx blk), TicketNo, TxMeasure blk) -> TicketNo
forall {a} {c}. (a, TicketNo, c) -> TicketNo
tno ((Validated (GenTx blk), TicketNo, TxMeasure blk) -> TicketNo)
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)] -> [TicketNo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
forall blk.
MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxs MempoolSnapshot blk
a) [TicketNo] -> [TicketNo] -> Bool
forall a. Eq a => a -> a -> Bool
== ((Validated (GenTx blk), TicketNo, TxMeasure blk) -> TicketNo
forall {a} {c}. (a, TicketNo, c) -> TicketNo
tno ((Validated (GenTx blk), TicketNo, TxMeasure blk) -> TicketNo)
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)] -> [TicketNo]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
forall blk.
MempoolSnapshot blk
-> [(Validated (GenTx blk), TicketNo, TxMeasure blk)]
snapshotTxs MempoolSnapshot blk
b)
      Bool -> Bool -> Bool
&& MempoolSnapshot blk -> SlotNo
forall blk. MempoolSnapshot blk -> SlotNo
snapshotSlotNo MempoolSnapshot blk
a SlotNo -> SlotNo -> Bool
forall a. Eq a => a -> a -> Bool
== MempoolSnapshot blk -> SlotNo
forall blk. MempoolSnapshot blk -> SlotNo
snapshotSlotNo MempoolSnapshot blk
b

  tno :: (a, TicketNo, c) -> TicketNo
tno (a
_a, TicketNo
b, c
_c) = TicketNo
b :: TicketNo

mkMeasuresMap ::
  TxMeasureMetrics (TxMeasure blk) =>
  Proxy blk ->
  TxMeasure blk ->
  TxMeasure blk ->
  Map MeasureName (SizeAndCapacity Integer)
mkMeasuresMap :: forall blk.
TxMeasureMetrics (TxMeasure blk) =>
Proxy blk
-> TxMeasure blk
-> TxMeasure blk
-> Map MeasureName (SizeAndCapacity Integer)
mkMeasuresMap Proxy blk
Proxy TxMeasure blk
size TxMeasure blk
capacity =
  [(MeasureName, SizeAndCapacity Integer)]
-> Map MeasureName (SizeAndCapacity Integer)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    [
      ( MeasureName
TransactionBytes
      , Integer -> Integer -> SizeAndCapacity Integer
forall a. a -> a -> SizeAndCapacity a
SizeAndCapacity
          (ByteSize32 -> Integer
byteSizeInteger (ByteSize32 -> Integer) -> ByteSize32 -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> ByteSize32
forall msr. TxMeasureMetrics msr => msr -> ByteSize32
txMeasureMetricTxSizeBytes TxMeasure blk
size)
          (ByteSize32 -> Integer
byteSizeInteger (ByteSize32 -> Integer) -> ByteSize32 -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> ByteSize32
forall msr. TxMeasureMetrics msr => msr -> ByteSize32
txMeasureMetricTxSizeBytes TxMeasure blk
capacity)
      )
    ,
      ( MeasureName
ExUnitsMemory
      , Integer -> Integer -> SizeAndCapacity Integer
forall a. a -> a -> SizeAndCapacity a
SizeAndCapacity
          (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> Natural
forall msr. TxMeasureMetrics msr => msr -> Natural
txMeasureMetricExUnitsMemory TxMeasure blk
size)
          (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> Natural
forall msr. TxMeasureMetrics msr => msr -> Natural
txMeasureMetricExUnitsMemory TxMeasure blk
capacity)
      )
    ,
      ( MeasureName
ExUnitsSteps
      , Integer -> Integer -> SizeAndCapacity Integer
forall a. a -> a -> SizeAndCapacity a
SizeAndCapacity
          (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> Natural
forall msr. TxMeasureMetrics msr => msr -> Natural
txMeasureMetricExUnitsSteps TxMeasure blk
size)
          (Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Integer) -> Natural -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> Natural
forall msr. TxMeasureMetrics msr => msr -> Natural
txMeasureMetricExUnitsSteps TxMeasure blk
capacity)
      )
    ,
      ( MeasureName
ReferenceScriptsBytes
      , Integer -> Integer -> SizeAndCapacity Integer
forall a. a -> a -> SizeAndCapacity a
SizeAndCapacity
          (ByteSize32 -> Integer
byteSizeInteger (ByteSize32 -> Integer) -> ByteSize32 -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> ByteSize32
forall msr. TxMeasureMetrics msr => msr -> ByteSize32
txMeasureMetricRefScriptsSizeBytes TxMeasure blk
size)
          (ByteSize32 -> Integer
byteSizeInteger (ByteSize32 -> Integer) -> ByteSize32 -> Integer
forall a b. (a -> b) -> a -> b
$ TxMeasure blk -> ByteSize32
forall msr. TxMeasureMetrics msr => msr -> ByteSize32
txMeasureMetricRefScriptsSizeBytes TxMeasure blk
capacity)
      )
    ]
 where
  byteSizeInteger :: ByteSize32 -> Integer
  byteSizeInteger :: ByteSize32 -> Integer
byteSizeInteger = Word32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Integer)
-> (ByteSize32 -> Word32) -> ByteSize32 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteSize32 -> Word32
unByteSize32

pattern TransactionBytes :: MeasureName
pattern $mTransactionBytes :: forall {r}. MeasureName -> ((# #) -> r) -> ((# #) -> r) -> r
$bTransactionBytes :: MeasureName
TransactionBytes = MeasureName "transaction_bytes"

pattern ExUnitsSteps :: MeasureName
pattern $mExUnitsSteps :: forall {r}. MeasureName -> ((# #) -> r) -> ((# #) -> r) -> r
$bExUnitsSteps :: MeasureName
ExUnitsSteps = MeasureName "ex_units_steps"

pattern ExUnitsMemory :: MeasureName
pattern $mExUnitsMemory :: forall {r}. MeasureName -> ((# #) -> r) -> ((# #) -> r) -> r
$bExUnitsMemory :: MeasureName
ExUnitsMemory = MeasureName "ex_units_memory"

pattern ReferenceScriptsBytes :: MeasureName
pattern $mReferenceScriptsBytes :: forall {r}. MeasureName -> ((# #) -> r) -> ((# #) -> r) -> r
$bReferenceScriptsBytes :: MeasureName
ReferenceScriptsBytes = MeasureName "reference_scripts_bytes"