From d8c776ea2219f35766d77eb605eb8274b32e4982 Mon Sep 17 00:00:00 2001
From: Stevan Andjelkovic <stevan.andjelkovic@symbiont.io>
Date: Thu, 10 Mar 2022 10:04:31 +0100
Subject: [PATCH] feat(sut): add metrics app that displays service time in
 real-time

---
 src/journal/src/Journal/Internal/Metrics.hs   | 10 ++++-
 src/sut/dumblog/app/metrics/Main.hs           |  8 ++++
 src/sut/dumblog/dumblog.cabal                 |  6 +++
 src/sut/dumblog/src/Dumblog/Journal/Worker.hs |  6 ++-
 src/sut/dumblog/src/Dumblog/Metrics/Main.hs   | 38 +++++++++++++++++++
 5 files changed, 64 insertions(+), 4 deletions(-)
 create mode 100644 src/sut/dumblog/app/metrics/Main.hs
 create mode 100644 src/sut/dumblog/src/Dumblog/Metrics/Main.hs

diff --git a/src/journal/src/Journal/Internal/Metrics.hs b/src/journal/src/Journal/Internal/Metrics.hs
index e6fc5e1e..b79f12d8 100644
--- a/src/journal/src/Journal/Internal/Metrics.hs
+++ b/src/journal/src/Journal/Internal/Metrics.hs
@@ -130,8 +130,8 @@ percentile (Metrics _ hbuf) label p
       then return Nothing
       else do
         let d = realToFrac count * (p * 0.01)
-        let target :: Double
-            target | d == 0.0 = 1.0
+            target :: Double
+            target | d == 0.0  = 1.0
                    | otherwise = d
         go offsetBucket target
       where
@@ -150,6 +150,12 @@ percentile (Metrics _ hbuf) label p
                   then return (Just (decompress idx))
                   else go' (succ idx) sum'
 
+count :: Enum h => Metrics c h -> h -> IO Int
+count (Metrics _cbuf hbuf) label = do
+  let offsetHistogram = sizeOfAHistogram * fromEnum label
+      offsetHistogramCount = offsetHistogram + sizeOf (8 :: Int)
+  readIntOffArrayIx hbuf offsetHistogramCount
+
 -- * Example
 
 data MyMetricsCounter = Connections
diff --git a/src/sut/dumblog/app/metrics/Main.hs b/src/sut/dumblog/app/metrics/Main.hs
new file mode 100644
index 00000000..5424048e
--- /dev/null
+++ b/src/sut/dumblog/app/metrics/Main.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import Dumblog.Metrics.Main
+
+------------------------------------------------------------------------
+
+main :: IO ()
+main = metricsMain
diff --git a/src/sut/dumblog/dumblog.cabal b/src/sut/dumblog/dumblog.cabal
index 2534ab31..2dffadd1 100644
--- a/src/sut/dumblog/dumblog.cabal
+++ b/src/sut/dumblog/dumblog.cabal
@@ -77,6 +77,7 @@ library
     Dumblog.ZeroCopy.HttpServer
     Dumblog.ZeroCopy.Main
     Dumblog.ZeroCopy.State
+    Dumblog.Metrics.Main
   if flag(persistent-sqlite)
     exposed-modules: Dumblog.SQLite.DBPersistent
 
@@ -112,6 +113,11 @@ executable dumblog-zero-copy
   hs-source-dirs: app/zero-copy
   main-is:        Main.hs
 
+executable metrics
+  import:         executable-common
+  hs-source-dirs: app/metrics
+  main-is:        Main.hs
+
 common bench-common
   hs-source-dirs:   bench
   build-depends:
diff --git a/src/sut/dumblog/src/Dumblog/Journal/Worker.hs b/src/sut/dumblog/src/Dumblog/Journal/Worker.hs
index afe72854..59034a95 100644
--- a/src/sut/dumblog/src/Dumblog/Journal/Worker.hs
+++ b/src/sut/dumblog/src/Dumblog/Journal/Worker.hs
@@ -33,8 +33,10 @@ timeIt metrics action = do
   !startTime <- getCurrentTime
   result <- action
   !endTime <- getCurrentTime
-  -- dunno what timescale we are measuring
-  Metrics.measure metrics ServiceTime (realToFrac . (*1000) $ diffUTCTime endTime startTime)
+  Metrics.measure metrics ServiceTime
+    -- `diffUTCTime` has a precision of 10^-12 s, so after multiplying with 10^9
+    -- we get milliseconds.
+    (realToFrac (diffUTCTime endTime startTime * 1e9))
   return result
 
 wakeUpFrontend :: Blocker (Either Response Response) -> Int -> Either Response Response
diff --git a/src/sut/dumblog/src/Dumblog/Metrics/Main.hs b/src/sut/dumblog/src/Dumblog/Metrics/Main.hs
new file mode 100644
index 00000000..2e539d0a
--- /dev/null
+++ b/src/sut/dumblog/src/Dumblog/Metrics/Main.hs
@@ -0,0 +1,38 @@
+{-# LANGUAGE NumericUnderscores #-}
+
+module Dumblog.Metrics.Main where
+
+import Control.Monad (forever)
+import Control.Concurrent (threadDelay)
+import Text.Printf (printf)
+
+import Dumblog.Journal.Metrics
+import Journal.Internal.Metrics
+
+------------------------------------------------------------------------
+
+metricsMain :: IO ()
+metricsMain = forever $ do
+  metrics <- newMetrics dumblogSchema "/tmp/dumblog.metrics"
+  putStrLn ansiClearScreen
+  mMin  <- percentile metrics ServiceTime 0
+  mMed  <- percentile metrics ServiceTime 50
+  m90   <- percentile metrics ServiceTime 90
+  m99   <- percentile metrics ServiceTime 99
+  m999  <- percentile metrics ServiceTime 99.9
+  m9999 <- percentile metrics ServiceTime 99.99
+  mMax  <- percentile metrics ServiceTime 100
+  putStrLn "Service time:"
+  putStrLn (maybe "N/A" (printf "  min   %10.2f ms") mMin)
+  putStrLn (maybe "N/A" (printf "  med   %10.2f ms") mMed)
+  putStrLn (maybe "N/A" (printf "  90    %10.2f ms") m90)
+  putStrLn (maybe "N/A" (printf "  99    %10.2f ms") m99)
+  putStrLn (maybe "N/A" (printf "  99.9  %10.2f ms") m999)
+  putStrLn (maybe "N/A" (printf "  99.99 %10.2f ms") m9999)
+  putStrLn (maybe "N/A" (printf "  max   %10.2f ms") mMax)
+  cnt <- count metrics ServiceTime
+  putStrLn (printf "  count %10d" cnt)
+  threadDelay 1_000_000
+
+ansiClearScreen :: String
+ansiClearScreen = "\ESC[2J"