From 53e829a21c977a1048cb5d225ec5fa4a5b158f65 Mon Sep 17 00:00:00 2001
From: Evgeny <evgeny@poberezkin.com>
Date: Sat, 24 Aug 2024 14:51:26 +0100
Subject: [PATCH] agent: store query errors, reduce slow query threshold to 1ms
 (#1277)

* agent: collect query errors stats

* simplify

* test

* use microseconds

* parens

* revert change to track all queries, reduce threshold to 1 ms
---
 .../Messaging/Agent/Store/SQLite/DB.hs        | 27 ++++++++++++++-----
 src/Simplex/Messaging/Util.hs                 |  4 +--
 tests/AgentTests/NotificationTests.hs         |  4 +--
 3 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs b/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
index b356b3f87..4d9dbeb57 100644
--- a/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
+++ b/src/Simplex/Messaging/Agent/Store/SQLite/DB.hs
@@ -1,4 +1,5 @@
 {-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE StrictData #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -20,15 +21,19 @@ where
 
 import Control.Concurrent.STM
 import Control.Monad (when)
+import Control.Exception
 import qualified Data.Aeson.TH as J
 import Data.Int (Int64)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as M
+import Data.Text (Text)
 import Data.Time (diffUTCTime, getCurrentTime)
 import Database.SQLite.Simple (FromRow, NamedParam, Query, ToRow)
 import qualified Database.SQLite.Simple as SQL
 import Simplex.Messaging.Parsers (defaultJSON)
 import Simplex.Messaging.TMap (TMap)
 import qualified Simplex.Messaging.TMap as TM
-import Simplex.Messaging.Util (diffToMilliseconds)
+import Simplex.Messaging.Util (diffToMilliseconds, tshow)
 
 data Connection = Connection
   { conn :: SQL.Connection,
@@ -38,27 +43,35 @@ data Connection = Connection
 data SlowQueryStats = SlowQueryStats
   { count :: Int64,
     timeMax :: Int64,
-    timeAvg :: Int64
+    timeAvg :: Int64,
+    errs :: Map Text Int
   }
   deriving (Show)
 
 timeIt :: TMap Query SlowQueryStats -> Query -> IO a -> IO a
 timeIt slow sql a = do
   t <- getCurrentTime
-  r <- a
+  r <- a `catch` \e -> do
+    atomically $ TM.alter (Just . updateQueryErrors e) sql slow
+    throwIO e
   t' <- getCurrentTime
   let diff = diffToMilliseconds $ diffUTCTime t' t
-  atomically $ when (diff > 5) $ TM.alter (updateQueryStats diff) sql slow
+  when (diff > 1) $ atomically $ TM.alter (updateQueryStats diff) sql slow
   pure r
   where
+    updateQueryErrors :: SomeException -> Maybe SlowQueryStats -> SlowQueryStats
+    updateQueryErrors e Nothing = SlowQueryStats 0 0 0 $ M.singleton (tshow e) 1
+    updateQueryErrors e (Just stats@SlowQueryStats {errs}) =
+      stats {errs = M.alter (Just . maybe 1 (+ 1)) (tshow e) errs}
     updateQueryStats :: Int64 -> Maybe SlowQueryStats -> Maybe SlowQueryStats
-    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff
-    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg}) =
+    updateQueryStats diff Nothing = Just $ SlowQueryStats 1 diff diff M.empty
+    updateQueryStats diff (Just SlowQueryStats {count, timeMax, timeAvg, errs}) =
       Just $
         SlowQueryStats
           { count = count + 1,
             timeMax = max timeMax diff,
-            timeAvg = (timeAvg * count + diff) `div` (count + 1)
+            timeAvg = (timeAvg * count + diff) `div` (count + 1),
+            errs
           }
 
 open :: String -> IO Connection
diff --git a/src/Simplex/Messaging/Util.hs b/src/Simplex/Messaging/Util.hs
index b023f460a..e46681ea7 100644
--- a/src/Simplex/Messaging/Util.hs
+++ b/src/Simplex/Messaging/Util.hs
@@ -166,10 +166,10 @@ threadDelay' = loop
           loop $ time - maxWait
 
 diffToMicroseconds :: NominalDiffTime -> Int64
-diffToMicroseconds diff = fromIntegral ((truncate $ diff * 1000000) :: Integer)
+diffToMicroseconds diff = truncate $ diff * 1000000
 
 diffToMilliseconds :: NominalDiffTime -> Int64
-diffToMilliseconds diff = fromIntegral ((truncate $ diff * 1000) :: Integer)
+diffToMilliseconds diff = truncate $ diff * 1000
 
 labelMyThread :: MonadIO m => String -> m ()
 labelMyThread label = liftIO $ myThreadId >>= (`labelThread` label)
diff --git a/tests/AgentTests/NotificationTests.hs b/tests/AgentTests/NotificationTests.hs
index 012da704d..c45c37124 100644
--- a/tests/AgentTests/NotificationTests.hs
+++ b/tests/AgentTests/NotificationTests.hs
@@ -508,7 +508,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
   suspendAgent alice 0
   closeSQLiteStore store
   threadDelay 1000000
-  print "before opening the database from another agent"
+  putStrLn "before opening the database from another agent"
 
   -- aliceNtf client doesn't have subscription and is allowed to get notification message
   withAgent 3 aliceCfg initAgentServers testDB $ \aliceNtf -> runRight_ $ do
@@ -516,7 +516,7 @@ testNotificationSubscriptionExistingConnection APNSMockServer {apnsQ} baseId ali
     pure ()
 
   threadDelay 1000000
-  print "after closing the database in another agent"
+  putStrLn "after closing the database in another agent"
   reopenSQLiteStore store
   foregroundAgent alice
   threadDelay 500000