add MsgGetMeasures / MsgReplyGetMeasures to LocalTxMonitor.Client

IntersectMBO · Jan 15, 2025 · 48b514c · 48b514c
1 parent bc808e3
commit 48b514c
Show file tree

Hide file tree

Showing 2 changed files with 16 additions and 0 deletions.
diff --git a/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxMonitor/Client.hs b/ouroboros-network-protocols/src/Ouroboros/Network/Protocol/LocalTxMonitor/Client.hs
@@ -91,6 +91,11 @@ data ClientStAcquired txid tx slot m a where
     :: (MempoolSizeAndCapacity -> m (ClientStAcquired txid tx slot m a))
     -> ClientStAcquired txid tx slot m a
 
+  -- | Ask the server about the current mempool's measures
+  SendMsgGetMeasures
+    :: (MempoolMeasures -> m (ClientStAcquired txid tx slot m a))
+    -> ClientStAcquired txid tx slot m a
+
   -- | Await for a new snapshot and acquire it.
   --
   SendMsgAwaitAcquire
@@ -145,6 +150,11 @@ localTxMonitorClientPeer (LocalTxMonitorClient mClient) =
           Await $ \case
             MsgReplyGetSizes sizes ->
               Effect $ handleStAcquired <$> stAcquired sizes
+      SendMsgGetMeasures stAcquired ->
+        Yield MsgGetMeasures $
+          Await $ \case
+            MsgReplyGetMeasures measures ->
+              Effect $ handleStAcquired <$> stAcquired measures
       SendMsgAwaitAcquire stAcquired ->
         Yield MsgAwaitAcquire $
           Await $ \case

diff --git a/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalTxMonitor/Direct.hs b/ouroboros-network-protocols/testlib/Ouroboros/Network/Protocol/LocalTxMonitor/Direct.hs
@@ -47,6 +47,7 @@ direct (LocalTxMonitorClient mClient) (LocalTxMonitorServer mServer) = do
       , recvMsgNextTx
       , recvMsgHasTx
       , recvMsgGetSizes
+      , recvMsgGetMeasures
       } = \case
         SendMsgRelease mClientStIdle -> do
           serverStIdle <- recvMsgRelease
@@ -71,3 +72,8 @@ direct (LocalTxMonitorClient mClient) (LocalTxMonitorServer mServer) = do
             SendMsgReplyGetSizes result serverStAcquired -> do
               clientStAcquired <- mClientStAcquired result
               directAcquired serverStAcquired clientStAcquired
+        SendMsgGetMeasures mClientStAcquired -> do
+          recvMsgGetMeasures >>= \case
+            SendMsgReplyGetMeasures result serverStAcquired -> do
+              clientStAcquired <- mClientStAcquired result
+              directAcquired serverStAcquired clientStAcquired