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
This commit is contained in:
Evgeny
2024-08-24 14:51:26 +01:00
committed by GitHub
parent ab4acadcc1
commit 53e829a21c
3 changed files with 24 additions and 11 deletions
+20 -7
View File
@@ -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
+2 -2
View File
@@ -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)
+2 -2
View File
@@ -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