gaugehistogram

Author: epoberezkin

src/Simplex/Messaging/Server.hs

@@ -695,7 +695,7 @@ smpServer started cfg@ServerConfig {transports, transportConfig = tCfg, startOpt
           subClientsCount <- IS.size <$> readTVarIO subClients
           subServicesCount <- M.size <$> getSubscribedClients serviceSubscribers
           pure RTSubscriberMetrics {subsCount, subClientsCount, subServicesCount}
-        getDeliveredMetrics ts' = foldM countClnt (RTSubscriberMetrics 0 0 0, TimeBuckets 0 0 IM.empty) =<< getServerClients srv
+        getDeliveredMetrics ts' = foldM countClnt (RTSubscriberMetrics 0 0 0, emptyTimeBuckets) =<< getServerClients srv
           where
             countClnt acc@(metrics, times) Client {subscriptions} = do
               (cnt, times') <- foldM countSubs (0, times) =<< readTVarIO subscriptions

src/Simplex/Messaging/Server/Prometheus.hs

@@ -442,23 +442,24 @@ prometheusMetrics sm rtm ts =
       \simplex_smp_delivered_clients_total " <> mshow (subClientsCount deliveredSubs) <> "\n# delivered.subClientsCount\n\
       \\n\
       \# HELP simplex_smp_delivery_ack_time Times to confirm message delivery, including pending confirmation\n\
-      \# TYPE simplex_smp_delivery_ack_time histogram\n\
-      \simplex_smp_delivery_ack_time_sum " <> mshow (sumTime _msgRecvAckTimes + sumTime deliveredTimes) <> "\n# delivered.sumTime\n\
-      \simplex_smp_delivery_ack_time_count " <> mshow (_msgRecv + _msgRecvGet + subsCount deliveredSubs) <> "\n# delivered.subsCount\n"
+      \# TYPE simplex_smp_delivery_ack_time gaugehistogram\n\
+      \simplex_smp_delivery_ack_time_gsum " <> mshow (sumTime _msgRecvAckTimes + sumTime deliveredTimes) <> "\n# delivered.sumTime\n\
+      \simplex_smp_delivery_ack_time_gcount " <> mshow (_msgRecv + _msgRecvGet + subsCount deliveredSubs) <> "\n# delivered.subsCount\n"
       <> showTimeBuckets "simplex_smp_delivery_ack_time" (IM.unionWith (+) (timeBuckets _msgRecvAckTimes) (timeBuckets deliveredTimes))
       <> showTimeBucket "simplex_smp_delivery_ack_time" "+Inf" (_msgRecv + _msgRecvGet + subsCount deliveredSubs)
       <> "\n\
       \# HELP simplex_smp_delivery_ack_confirmed_time Times to confirm message delivery, only confirmed deliveries\n\
       \# TYPE simplex_smp_delivery_ack_confirmed_time histogram\n\
+      \simplex_smp_delivery_ack_confirmed_time_created " <> mshow (createdAt _msgRecvAckTimes) <> "\n# delivered.createdAt\n\
       \simplex_smp_delivery_ack_confirmed_time_sum " <> mshow (sumTime _msgRecvAckTimes) <> "\n# delivered.sumTime\n\
       \simplex_smp_delivery_ack_confirmed_time_count " <> mshow (_msgRecv + _msgRecvGet) <> "\n# delivered.subsCount\n"
       <> showTimeBuckets "simplex_smp_delivery_ack_confirmed_time" (timeBuckets _msgRecvAckTimes)
       <> showTimeBucket "simplex_smp_delivery_ack_confirmed_time" "+Inf" (_msgRecv + _msgRecvGet)
       <> "\n\
       \# HELP simplex_smp_delivery_ack_pending_time Times to confirm message delivery, only pending confirmations\n\
-      \# TYPE simplex_smp_delivery_ack_pending_time histogram\n\
-      \simplex_smp_delivery_ack_pending_time_sum " <> mshow (sumTime deliveredTimes) <> "\n# delivered.sumTime\n\
-      \simplex_smp_delivery_ack_pending_time_count " <> mshow (subsCount deliveredSubs) <> "\n# delivered.subsCount\n"
+      \# TYPE simplex_smp_delivery_ack_pending_time gaugehistogram\n\
+      \simplex_smp_delivery_ack_pending_time_gsum " <> mshow (sumTime deliveredTimes) <> "\n# delivered.sumTime\n\
+      \simplex_smp_delivery_ack_pending_time_gcount " <> mshow (subsCount deliveredSubs) <> "\n# delivered.subsCount\n"
       <> showTimeBuckets "simplex_smp_delivery_ack_pending_time" (timeBuckets deliveredTimes)
       <> showTimeBucket "simplex_smp_delivery_ack_pending_time" "+Inf" (subsCount deliveredSubs)
       <> "\n\
@@ -511,7 +512,13 @@ prometheusMetrics sm rtm ts =
       \simplex_smp_loaded_queues_ntf_lock_count " <> mshow (notifierLockCount loadedCounts) <> "\n# loadedCounts.notifierLockCount\n"
 
     showTimeBuckets :: Text -> IM.IntMap Int -> Text
-    showTimeBuckets metric = T.concat . snd . mapAccumL (\total (sec, cnt) -> (total + cnt, showTimeBucket metric (tshow sec) (total + cnt))) 0 . IM.assocs
+    showTimeBuckets metric = T.concat . snd . mapAccumL accumBucket (0, 0) . IM.assocs
+      where
+        accumBucket (prevSec, total) (sec, cnt) =
+          let t
+                | sec - 60 > prevSec = showTimeBucket metric (tshow (sec - 60)) total
+                | otherwise = ""
+           in ((sec, total + cnt), t <> showTimeBucket metric (tshow sec) (total + cnt))
     showTimeBucket :: Text -> Text -> Int -> Text
     showTimeBucket metric sec count = metric <> "_bucket{le=\"" <> sec <> "\"} " <> mshow count <> "\n# delivered.timeBuckets\n"
     socketsMetric :: (SocketStats -> Int) -> Text -> Text -> Text

src/Simplex/Messaging/Server/Stats.hs

@@ -24,6 +24,7 @@ import Data.Text (Text)
 import Data.Time.Calendar.Month (pattern MonthDay)
 import Data.Time.Calendar.OrdinalDate (mondayStartWeek)
 import Data.Time.Clock (UTCTime (..))
+import Data.Time.Clock.System (systemEpochDay)
 import GHC.IORef (atomicSwapIORef)
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Protocol (EntityId (..))
@@ -179,7 +180,7 @@ newServerStats ts = do
   msgSentLarge <- newIORef 0
   msgSentBlock <- newIORef 0
   msgRecv <- newIORef 0
-  msgRecvAckTimes <- newIORef $ TimeBuckets 0 0 IM.empty
+  msgRecvAckTimes <- newIORef $ TimeBuckets 0 0 IM.empty ts
   msgRecvGet <- newIORef 0
   msgGet <- newIORef 0
   msgGetNoMsg <- newIORef 0
@@ -472,7 +473,6 @@ instance StrEncoding ServerStatsData where
         "msgSentLarge=" <> strEncode (_msgSentLarge d),
         "msgSentBlock=" <> strEncode (_msgSentBlock d),
         "msgRecv=" <> strEncode (_msgRecv d),
-        "msgRecvAckTimes=" <> strEncode (_msgRecvAckTimes d),
         "msgRecvGet=" <> strEncode (_msgRecvGet d),
         "msgGet=" <> strEncode (_msgGet d),
         "msgGetNoMsg=" <> strEncode (_msgGetNoMsg d),
@@ -536,7 +536,6 @@ instance StrEncoding ServerStatsData where
     _msgSentLarge <- opt "msgSentLarge="
     _msgSentBlock <- opt "msgSentBlock="
     _msgRecv <- "msgRecv=" *> strP <* A.endOfLine
-    _msgRecvAckTimes <- "msgRecvAckTimes=" *> strP <* A.endOfLine <|> pure (TimeBuckets 0 0 IM.empty)
     _msgRecvGet <- opt "msgRecvGet="
     _msgGet <- opt "msgGet="
     _msgGetNoMsg <- opt "msgGetNoMsg="
@@ -604,7 +603,7 @@ instance StrEncoding ServerStatsData where
           _msgSentLarge,
           _msgSentBlock,
           _msgRecv,
-          _msgRecvAckTimes,
+          _msgRecvAckTimes = emptyTimeBuckets,
           _msgRecvGet,
           _msgGet,
           _msgGetNoMsg,
@@ -961,16 +960,20 @@ instance StrEncoding ServiceStatsData where
 data TimeBuckets = TimeBuckets
   { sumTime :: Int64,
     maxTime :: Int64,
-    timeBuckets :: IM.IntMap Int
+    timeBuckets :: IM.IntMap Int,
+    createdAt :: UTCTime
   }
   deriving (Show)
 
+emptyTimeBuckets :: TimeBuckets
+emptyTimeBuckets = TimeBuckets 0 0 IM.empty (UTCTime systemEpochDay 0)
+
 updateTimeBuckets :: RoundedSystemTime -> RoundedSystemTime -> TimeBuckets -> TimeBuckets
 updateTimeBuckets
   (RoundedSystemTime deliveryTime)
   (RoundedSystemTime currTime)
-  TimeBuckets {sumTime, maxTime, timeBuckets} =
-    TimeBuckets
+  times@TimeBuckets {sumTime, maxTime, timeBuckets} =
+    times
       { sumTime = sumTime + t,
         maxTime = max maxTime t,
         timeBuckets = IM.alter (Just . maybe 1 (+ 1)) seconds timeBuckets
@@ -984,11 +987,3 @@ updateTimeBuckets
       | t <= 180 = t `toBucket` 30
       | otherwise = t `toBucket` 60
     toBucket n m = - fromIntegral (((- n) `div` m) * m) -- round up
-
-instance StrEncoding TimeBuckets where
-  strEncode TimeBuckets {sumTime, maxTime, timeBuckets} =
-    strEncode (sumTime, maxTime) <> " " <> strEncodeList (IM.toList timeBuckets)
-  strP = do
-    (sumTime, maxTime) <- strP_
-    tbs <- strListP
-    pure TimeBuckets {sumTime, maxTime, timeBuckets = IM.fromList tbs}