agent: add indexes to improve slow queries performance (#823)

simplexmq.cabal

@@ -87,6 +87,7 @@ library
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
       Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
+      Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
       Simplex.Messaging.Agent.TAsyncs
       Simplex.Messaging.Agent.TRcvQueues
       Simplex.Messaging.Client

src/Simplex/Messaging/Agent/Store/SQLite.hs

@@ -1106,7 +1106,7 @@ deleteSndMsgsExpired db ttl = do
   cutoffTs <- addUTCTime (- ttl) <$> getCurrentTime
   DB.execute
     db
-    "DELETE FROM messages WHERE internal_snd_id IS NOT NULL AND internal_ts < ?"
+    "DELETE FROM messages WHERE internal_ts < ? AND internal_snd_id IS NOT NULL"
     (Only cutoffTs)
 
 createRatchetX3dhKeys :: DB.Connection -> ConnId -> C.PrivateKeyX448 -> C.PrivateKeyX448 -> IO ()

src/Simplex/Messaging/Agent/Store/SQLite/Migrations.hs

@@ -65,6 +65,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230615_ratchet_sync
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230701_delivery_receipts
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230720_delete_expired_messages
 import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230722_indexes
+import Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes
 import Simplex.Messaging.Encoding.String
 import Simplex.Messaging.Parsers (dropPrefix, sumTypeJSON)
 import Simplex.Messaging.Transport.Client (TransportHost)
@@ -96,7 +97,8 @@ schemaMigrations =
     ("m20230615_ratchet_sync", m20230615_ratchet_sync, Just down_m20230615_ratchet_sync),
     ("m20230701_delivery_receipts", m20230701_delivery_receipts, Just down_m20230701_delivery_receipts),
     ("m20230720_delete_expired_messages", m20230720_delete_expired_messages, Just down_m20230720_delete_expired_messages),
-    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes)
+    ("m20230722_indexes", m20230722_indexes, Just down_m20230722_indexes),
+    ("m20230814_indexes", m20230814_indexes, Just down_m20230814_indexes)
   ]
 
 -- | The list of migrations in ascending order by date

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/M20230814_indexes.hs

@@ -0,0 +1,22 @@
+{-# LANGUAGE QuasiQuotes #-}
+
+module Simplex.Messaging.Agent.Store.SQLite.Migrations.M20230814_indexes where
+
+import Database.SQLite.Simple (Query)
+import Database.SQLite.Simple.QQ (sql)
+
+m20230814_indexes :: Query
+m20230814_indexes =
+  [sql|
+DROP INDEX idx_messages_internal_snd_id_ts;
+
+CREATE INDEX idx_messages_internal_ts ON messages(internal_ts);
+|]
+
+down_m20230814_indexes :: Query
+down_m20230814_indexes =
+  [sql|
+DROP INDEX idx_messages_internal_ts;
+
+CREATE INDEX idx_messages_internal_snd_id_ts ON messages(internal_snd_id, internal_ts);
+|]

src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql

@@ -467,13 +467,10 @@ CREATE INDEX idx_snd_messages_rcpt_internal_id ON snd_messages(
   conn_id,
   rcpt_internal_id
 );
-CREATE INDEX idx_messages_internal_snd_id_ts ON messages(
-  internal_snd_id,
-  internal_ts
-);
 CREATE INDEX idx_processed_ratchet_key_hashes_created_at ON processed_ratchet_key_hashes(
   created_at
 );
 CREATE INDEX idx_encrypted_rcv_message_hashes_created_at ON encrypted_rcv_message_hashes(
   created_at
 );
+CREATE INDEX idx_messages_internal_ts ON messages(internal_ts);

tests/AgentTests.hs

@@ -16,7 +16,6 @@ import AgentTests.FunctionalAPITests (functionalAPITests)
 import AgentTests.MigrationTests (migrationTests)
 import AgentTests.NotificationTests (notificationTests)
 import AgentTests.SQLiteTests (storeTests)
-import AgentTests.SchemaDump (schemaDumpTest)
 import Control.Concurrent
 import Control.Monad (forM_)
 import Data.ByteString.Char8 (ByteString)
@@ -42,7 +41,6 @@ agentTests (ATransport t) = do
   describe "Functional API" $ functionalAPITests (ATransport t)
   describe "Notification tests" $ notificationTests (ATransport t)
   describe "SQLite store" storeTests
-  describe "SQLite schema dump" schemaDumpTest
   describe "Migration tests" migrationTests
   describe "SMP agent protocol syntax" $ syntaxTests t
   describe "Establishing duplex connection" $ do

tests/AgentTests/SchemaDump.hs

@@ -4,7 +4,7 @@
 module AgentTests.SchemaDump where
 
 import Control.DeepSeq
-import Control.Monad (void)
+import Control.Monad (unless, void)
 import Data.List (dropWhileEnd)
 import Data.Maybe (fromJust, isJust)
 import Simplex.Messaging.Agent.Store.SQLite
@@ -54,12 +54,19 @@ testSchemaMigrations = do
       schema' <- getSchema testDB testSchema
       schema' `shouldNotBe` schema
       withConnection' st (`Migrations.run` MTRDown [downMigr])
-      schema'' <- getSchema testDB testSchema
-      schema'' `shouldBe` schema
+      unless (name m `elem` skipComparisonForDownMigrations) $ do
+        schema'' <- getSchema testDB testSchema
+        schema'' `shouldBe` schema
       withConnection' st (`Migrations.run` MTRUp [m])
       schema''' <- getSchema testDB testSchema
       schema''' `shouldBe` schema'
 
+skipComparisonForDownMigrations :: [String]
+skipComparisonForDownMigrations =
+  [ -- on down migration idx_messages_internal_snd_id_ts index moves down to the end of the file
+    "m20230814_indexes"
+  ]
+
 getSchema :: FilePath -> FilePath -> IO String
 getSchema dpPath schemaPath = do
   void $ readCreateProcess (shell $ "sqlite3 " <> dpPath <> " '.schema --indent' > " <> schemaPath) ""

tests/Test.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE TypeApplications #-}
 
 import AgentTests (agentTests)
+import AgentTests.SchemaDump (schemaDumpTest)
 import CLITests
 import Control.Logger.Simple
 import CoreTests.CryptoTests
@@ -34,6 +35,7 @@ main = do
       . before_ (createDirectoryIfMissing False "tests/tmp")
       . after_ (removeDirectoryRecursive "tests/tmp")
       $ do
+        describe "Agent SQLite schema dump" schemaDumpTest
         describe "Core tests" $ do
           describe "Encoding tests" encodingTests
           describe "Protocol error tests" protocolErrorTests