From 80ed419fdc660370d37c5438f3cd93a99022161a Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Tue, 17 Jun 2025 11:30:27 +0100
Subject: [PATCH] smp server: prometheus metrics for delievered and not
 acknowledged messages (to monitor stuck deliveries)

---
 src/Simplex/Messaging/Server.hs            | 10 +++++++++-
 src/Simplex/Messaging/Server/Prometheus.hs | 10 ++++++++++
 2 files changed, 19 insertions(+), 1 deletion(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index 73e12c5f1..7128f104c 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -579,15 +579,23 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
       let threadsCount = 0
 #endif
       clientsCount <- IM.size <$> getServerClients srv
+      deliveredSubs <- getDeliveredMetrics
       smpSubs <- getSubscribersMetrics subscribers
       ntfSubs <- getSubscribersMetrics ntfSubscribers
       loadedCounts <- loadedQueueCounts ms
-      pure RealTimeMetrics {socketStats, threadsCount, clientsCount, smpSubs, ntfSubs, loadedCounts}
+      pure RealTimeMetrics {socketStats, threadsCount, clientsCount, deliveredSubs, smpSubs, ntfSubs, loadedCounts}
       where
         getSubscribersMetrics ServerSubscribers {queueSubscribers, subClients} = do
           subsCount <- M.size <$> getSubscribedClients queueSubscribers
           subClientsCount <- IS.size <$> readTVarIO subClients
           pure RTSubscriberMetrics {subsCount, subClientsCount}
+        getDeliveredMetrics = foldM countClnd (RTSubscriberMetrics 0 0) =<< getServerClients srv
+        countClnd metrics (AClient _ _ Client {subscriptions}) = do
+          cnt <- foldM countSubs 0 =<< readTVarIO subscriptions
+          pure $ if cnt > 0
+            then metrics {subsCount = subsCount metrics + cnt, subClientsCount = subClientsCount metrics + 1}
+            else metrics
+        countSubs !cnt Sub {delivered} = (\empty -> if empty then cnt else cnt + 1) <$> atomically (isEmptyTMVar delivered)
 
     runClient :: Transport c => X.CertificateChain -> C.APrivateSignKey -> TProxy c 'TServer -> c 'TServer -> M ()
     runClient srvCert srvSignKey tp h = do
diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs
index 2aea7ac6a..c38914588 100644
--- a/src/Simplex/Messaging/Server/Prometheus.hs
+++ b/src/Simplex/Messaging/Server/Prometheus.hs
@@ -33,6 +33,7 @@ data RealTimeMetrics = RealTimeMetrics
   { socketStats :: [(ServiceName, SocketStats)],
     threadsCount :: Int,
     clientsCount :: Int,
+    deliveredSubs :: RTSubscriberMetrics,
     smpSubs :: RTSubscriberMetrics,
     ntfSubs :: RTSubscriberMetrics,
     loadedCounts :: LoadedQueueCounts
@@ -53,6 +54,7 @@ prometheusMetrics sm rtm ts =
       { socketStats,
         threadsCount,
         clientsCount,
+        deliveredSubs,
         smpSubs,
         ntfSubs,
         loadedCounts
@@ -368,6 +370,14 @@ prometheusMetrics sm rtm ts =
       \# TYPE simplex_smp_clients_total gauge\n\
       \simplex_smp_clients_total " <> mshow clientsCount <> "\n\
       \\n\
+      \# HELP simplex_smp_delivered_total Total SMP subscriptions with delivered messages\n\
+      \# TYPE simplex_smp_delivered_total gauge\n\
+      \simplex_smp_delivered_total " <> mshow (subsCount deliveredSubs) <> "\n# delivered.subsCount\n\
+      \\n\
+      \# HELP simplex_smp_delivered_clients_total Subscribed clients\n\
+      \# TYPE simplex_smp_delivered_clients_total gauge\n\
+      \simplex_smp_delivered_clients_total " <> mshow (subClientsCount deliveredSubs) <> "\n# delivered.subClientsCount\n\
+      \\n\
       \# HELP simplex_smp_subscribtion_total Total SMP subscriptions\n\
       \# TYPE simplex_smp_subscribtion_total gauge\n\
       \simplex_smp_subscribtion_total " <> mshow (subsCount smpSubs) <> "\n# smp.subsCount\n\