From 320694688d8beef79889707e25ebfbcbf5559db5 Mon Sep 17 00:00:00 2001
From: Evgeny Poberezkin <evgeny@poberezkin.com>
Date: Wed, 18 Jun 2025 12:24:41 +0100
Subject: [PATCH] histogram

---
 src/Simplex/Messaging/Server.hs            | 12 +++++++++---
 src/Simplex/Messaging/Server/Prometheus.hs | 16 +++++++++-------
 2 files changed, 18 insertions(+), 10 deletions(-)

diff --git a/src/Simplex/Messaging/Server.hs b/src/Simplex/Messaging/Server.hs
index ecbc1babc..29d52cd34 100644
--- a/src/Simplex/Messaging/Server.hs
+++ b/src/Simplex/Messaging/Server.hs
@@ -596,18 +596,24 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
               pure $ if cnt > 0
                 then (metrics {subsCount = subsCount metrics + cnt, subClientsCount = subClientsCount metrics + 1}, times')
                 else acc
-            countSubs acc@(!cnt, TimeAggregations {sumTime, maxTime, minuteBuckets}) Sub {delivered} = do
+            countSubs acc@(!cnt, TimeAggregations {sumTime, maxTime, timeBuckets}) Sub {delivered} = do
               delivered_ <- atomically $ tryReadTMVar delivered
               pure $ case delivered_ of
                 Nothing -> acc
                 Just (_, RoundedSystemTime ts) ->
                   let t = ts' - ts
-                      mins = - fromIntegral ((- t) `div` 60) -- round up
+                      seconds
+                        | t <= 5 = fromIntegral t
+                        | t <= 30 = t `toBucket` 5
+                        | t <= 60 = t `toBucket` 10
+                        | t <= 180 = t `toBucket` 30
+                        | otherwise = t `toBucket` 60
+                      toBucket n m = - fromIntegral (((- n) `div` m) * m) -- round up
                       times' =
                         TimeAggregations
                           { sumTime = sumTime + t,
                             maxTime = max maxTime t,
-                            minuteBuckets = IM.alter (Just . maybe 1 (+ 1)) mins minuteBuckets
+                            timeBuckets = IM.alter (Just . maybe 1 (+ 1)) seconds timeBuckets
                           }
                    in (cnt + 1, times')
 
diff --git a/src/Simplex/Messaging/Server/Prometheus.hs b/src/Simplex/Messaging/Server/Prometheus.hs
index 19ed5d8eb..e217a29bb 100644
--- a/src/Simplex/Messaging/Server/Prometheus.hs
+++ b/src/Simplex/Messaging/Server/Prometheus.hs
@@ -5,9 +5,9 @@
 
 module Simplex.Messaging.Server.Prometheus where
 
-import Data.Bifunctor (first)
 import Data.Int (Int64)
 import qualified Data.IntMap as IM
+import Data.List (mapAccumL)
 import Data.Text (Text)
 import qualified Data.Text as T
 import Data.Time.Clock (UTCTime (..), diffUTCTime)
@@ -46,7 +46,7 @@ data RealTimeMetrics = RealTimeMetrics
 data TimeAggregations = TimeAggregations
   { sumTime :: Int64,
     maxTime :: Int64,
-    minuteBuckets :: IM.IntMap Int
+    timeBuckets :: IM.IntMap Int
   }
 
 data RTSubscriberMetrics = RTSubscriberMetrics
@@ -393,9 +393,9 @@ prometheusMetrics sm rtm ts =
       \# TYPE simplex_smp_delivery_ack_time histogram\n\
       \simplex_smp_delivery_ack_time_sum " <> mshow (sumTime deliveredTimes) <> "\n# delivered.sumTime\n\
       \simplex_smp_delivery_ack_time_count " <> mshow (subsCount deliveredSubs) <> "\n# delivered.subsCount\n"
-      <> T.concat (map (showTimeBucket . first tshow)  $ IM.assocs $ minuteBuckets deliveredTimes)
-      <> "simplex_smp_delivery_ack_time_bucket{le=\"+Inf\"} " <> mshow (subsCount deliveredSubs) <> "\n# delivered.minuteBuckets\n\
-      \\n\
+      <> showTimeBuckets (timeBuckets deliveredTimes)
+      <> showTimeBucket "+Inf" (subsCount deliveredSubs)
+      <> "\n\
       \# HELP simplex_smp_delivery_ack_time_max Max time to confirm message delivery\n\
       \# TYPE simplex_smp_delivery_ack_time_max gauge\n\
       \simplex_smp_delivery_ack_time_max " <> mshow (maxTime deliveredTimes) <> "\n# delivered.maxTime\n\
@@ -436,8 +436,10 @@ prometheusMetrics sm rtm ts =
       \# TYPE simplex_smp_loaded_queues_ntf_lock_count gauge\n\
       \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"
 
-    showTimeBucket :: (Text, Int) -> Text
-    showTimeBucket (minute, count) = "simplex_smp_delivery_ack_time_bucket{le=\"" <> minute <> "\"} " <> mshow count <> "\n# delivered.minuteBuckets\n"
+    showTimeBuckets :: IM.IntMap Int -> Text
+    showTimeBuckets = T.concat . snd . mapAccumL (\total (sec, cnt) -> (total + cnt, showTimeBucket (tshow sec) (total + cnt))) 0 . IM.assocs
+    showTimeBucket :: Text -> Int -> Text
+    showTimeBucket sec count = "simplex_smp_delivery_ack_time_bucket{le=\"" <> sec <> "\"} " <> mshow count <> "\n# delivered.timeBuckets\n"
     socketsMetric :: (SocketStats -> Int) -> Text -> Text -> Text
     socketsMetric sel metric descr =
       "# HELP " <> metric <> " " <> descr <> "\n"