diff --git a/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql new file mode 100644 index 000000000..318ea2d02 --- /dev/null +++ b/src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_lint.sql @@ -0,0 +1 @@ +CREATE INDEX 'ratchets_conn_id' ON 'ratchets'('conn_id'); --> connections(conn_id) diff --git a/tests/AgentTests/SchemaDump.hs b/tests/AgentTests/SchemaDump.hs index c32b69f10..3ee2774bc 100644 --- a/tests/AgentTests/SchemaDump.hs +++ b/tests/AgentTests/SchemaDump.hs @@ -4,6 +4,7 @@ module AgentTests.SchemaDump where import Control.DeepSeq +import Control.Exception (bracket_) import Control.Monad (unless, void) import Data.List (dropWhileEnd) import Data.Maybe (fromJust, isJust) @@ -14,7 +15,7 @@ import Simplex.Messaging.Agent.Store.SQLite.Common (withTransaction') import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..), MigrationsToRun (..), toDownMigration) import qualified Simplex.Messaging.Agent.Store.SQLite.Migrations as Migrations import Simplex.Messaging.Util (ifM) -import System.Directory (doesFileExist, removeFile) +import System.Directory (createDirectoryIfMissing, doesFileExist, removeDirectoryRecursive, removeFile) import System.Process (readCreateProcess, shell) import Test.Hspec @@ -24,12 +25,22 @@ testDB = "tests/tmp/test_agent_schema.db" appSchema :: FilePath appSchema = "src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_schema.sql" +-- Some indexes found by `.lint fkey-indexes` are not added to schema, explanation: +-- +-- - CREATE INDEX 'ratchets_conn_id' ON 'ratchets'('conn_id'); --> connections(conn_id) +-- Primary key is used instead. See for example: +-- EXPLAIN QUERY PLAN DELETE FROM connections; +-- (uses conn_id for ratchets table) +appLint :: FilePath +appLint = "src/Simplex/Messaging/Agent/Store/SQLite/Migrations/agent_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 it "should NOT create user record for new database" testUsersMigrationNew it "should create user record for old database" testUsersMigrationOld @@ -42,6 +53,20 @@ testVerifySchemaDump = do getSchema testDB appSchema `shouldReturn` savedSchema removeFile testDB +testVerifyLintFKeyIndexes :: IO () +testVerifyLintFKeyIndexes = do + savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "") + savedLint `deepseq` pure () + void $ createSQLiteStore testDB "" False Migrations.app MCConsole + getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint + removeFile testDB + +withTmpFiles :: IO () -> IO () +withTmpFiles = + bracket_ + (createDirectoryIfMissing False "tests/tmp") + (removeDirectoryRecursive "tests/tmp") + testSchemaMigrations :: IO () testSchemaMigrations = do let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Migrations.app @@ -92,7 +117,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