diff --git a/src/Simplex/Chat/Migrations/chat_lint.sql b/src/Simplex/Chat/Migrations/chat_lint.sql new file mode 100644 index 0000000000..86047070fb --- /dev/null +++ b/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) diff --git a/tests/SchemaDump.hs b/tests/SchemaDump.hs index b6bc91e48b..23f36713b4 100644 --- a/tests/SchemaDump.hs +++ b/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