core: test db indexes (#4999)

src/Simplex/Chat/Migrations/chat_lint.sql

@@ -0,0 +1,2 @@
+CREATE INDEX 'chat_items_group_id' ON 'chat_items'('group_id'); --> groups(group_id)
+CREATE INDEX 'connections_group_member_id' ON 'connections'('group_member_id'); --> group_members(group_member_id)

tests/SchemaDump.hs

@@ -24,12 +24,29 @@ testDB = "tests/tmp/test_chat.db"
 appSchema :: FilePath
 appSchema = "src/Simplex/Chat/Migrations/chat_schema.sql"
 
+-- Some indexes found by `.lint fkey-indexes` are not added to schema, explanation:
+--
+-- - CREATE INDEX 'chat_items_group_id' ON 'chat_items'('group_id'); --> groups(group_id)
+--
+--   Covering index is used instead. See for example:
+--   EXPLAIN QUERY PLAN DELETE FROM groups;
+--   (uses idx_chat_items_groups_item_status)
+--
+-- - CREATE INDEX 'connections_group_member_id' ON 'connections'('group_member_id'); --> group_members(group_member_id)
+--
+--   Covering index is used instead. See for example:
+--   EXPLAIN QUERY PLAN DELETE FROM group_members;
+--   (uses idx_connections_group_member)
+appLint :: FilePath
+appLint = "src/Simplex/Chat/Migrations/chat_lint.sql"
+
 testSchema :: FilePath
 testSchema = "tests/tmp/test_agent_schema.sql"
 
 schemaDumpTest :: Spec
 schemaDumpTest = do
   it "verify and overwrite schema dump" testVerifySchemaDump
+  it "verify .lint fkey-indexes" testVerifyLintFKeyIndexes
   it "verify schema down migrations" testSchemaMigrations
 
 testVerifySchemaDump :: IO ()
@@ -40,6 +57,14 @@ testVerifySchemaDump = withTmpFiles $ do
   getSchema testDB appSchema `shouldReturn` savedSchema
   removeFile testDB
 
+testVerifyLintFKeyIndexes :: IO ()
+testVerifyLintFKeyIndexes = withTmpFiles $ do
+  savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
+  savedLint `deepseq` pure ()
+  void $ createChatStore testDB "" False MCError
+  getLintFKeyIndexes testDB "tests/tmp/chat_lint.sql" `shouldReturn` savedLint
+  removeFile testDB
+
 testSchemaMigrations :: IO ()
 testSchemaMigrations = withTmpFiles $ do
   let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
@@ -81,7 +106,13 @@ skipComparisonForDownMigrations =
   ]
 
 getSchema :: FilePath -> FilePath -> IO String
-getSchema dpPath schemaPath = do
-  void $ readCreateProcess (shell $ "sqlite3 " <> dpPath <> " '.schema --indent' > " <> schemaPath) ""
+getSchema dbPath schemaPath = do
+  void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.schema --indent' > " <> schemaPath) ""
   sch <- readFile schemaPath
   sch `deepseq` pure sch
+
+getLintFKeyIndexes :: FilePath -> FilePath -> IO String
+getLintFKeyIndexes dbPath lintPath = do
+  void $ readCreateProcess (shell $ "sqlite3 " <> dbPath <> " '.lint fkey-indexes' > " <> lintPath) ""
+  lint <- readFile lintPath
+  lint `deepseq` pure lint