{-# 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), Any, 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"