1928256b09
* core: test group members are assigned different LDNs in group when direct connections aren't created
* disable test output
* core: connect existing contacts to new members when profile matches (#3059)
* core: connect existing contacts to new members when profile matches
* fix migration
* progress
* xInfoProbeOk for member
* fix tests
* add test
* fix tests
* tests
* remove deleteSentProbe
* remove deleteContactProfile_
* views
* don't check connections in deleteUnusedProfile_
* Revert "don't check connections in deleteUnusedProfile_"
This reverts commit 2016a0efde.
* fix test
* core: update member merge
* update saved schema
* fix queries and tests
* rename tables to original names
* remove index, corrections
* update schema dump
---------
Co-authored-by: spaced4ndy <8711996+spaced4ndy@users.noreply.github.com>
---------
Co-authored-by: Evgeny Poberezkin <2769109+epoberezkin@users.noreply.github.com>
82 lines
3.1 KiB
Haskell
82 lines
3.1 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module SchemaDump where
|
|
|
|
import ChatClient (withTmpFiles)
|
|
import Control.DeepSeq
|
|
import Control.Monad (unless, void)
|
|
import Data.List (dropWhileEnd)
|
|
import Data.Maybe (fromJust, isJust)
|
|
import Simplex.Chat.Store (createChatStore)
|
|
import qualified Simplex.Chat.Store as Store
|
|
import Simplex.Messaging.Agent.Store.SQLite (MigrationConfirmation (..), closeSQLiteStore, createSQLiteStore)
|
|
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, whenM)
|
|
import System.Directory (doesFileExist, removeFile)
|
|
import System.Process (readCreateProcess, shell)
|
|
import Test.Hspec
|
|
|
|
testDB :: FilePath
|
|
testDB = "tests/tmp/test_chat.db"
|
|
|
|
appSchema :: FilePath
|
|
appSchema = "src/Simplex/Chat/Migrations/chat_schema.sql"
|
|
|
|
testSchema :: FilePath
|
|
testSchema = "tests/tmp/test_agent_schema.sql"
|
|
|
|
schemaDumpTest :: Spec
|
|
schemaDumpTest = do
|
|
it "verify and overwrite schema dump" testVerifySchemaDump
|
|
it "verify schema down migrations" testSchemaMigrations
|
|
|
|
testVerifySchemaDump :: IO ()
|
|
testVerifySchemaDump = withTmpFiles $ do
|
|
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
|
|
savedSchema `deepseq` pure ()
|
|
void $ createChatStore testDB "" MCError
|
|
getSchema testDB appSchema `shouldReturn` savedSchema
|
|
removeFile testDB
|
|
|
|
testSchemaMigrations :: IO ()
|
|
testSchemaMigrations = withTmpFiles $ do
|
|
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) Store.migrations
|
|
Right st <- createSQLiteStore testDB "" noDownMigrations MCError
|
|
mapM_ (testDownMigration st) $ drop (length noDownMigrations) Store.migrations
|
|
closeSQLiteStore st
|
|
removeFile testDB
|
|
whenM (doesFileExist testSchema) $ removeFile testSchema
|
|
where
|
|
testDownMigration st m = do
|
|
putStrLn $ "down migration " <> name m
|
|
let downMigr = fromJust $ toDownMigration m
|
|
schema <- getSchema testDB testSchema
|
|
Migrations.run st $ MTRUp [m]
|
|
schema' <- getSchema testDB testSchema
|
|
schema' `shouldNotBe` schema
|
|
Migrations.run st $ MTRDown [downMigr]
|
|
unless (name m `elem` skipComparisonForDownMigrations) $ do
|
|
schema'' <- getSchema testDB testSchema
|
|
schema'' `shouldBe` schema
|
|
Migrations.run st $ MTRUp [m]
|
|
schema''' <- getSchema testDB testSchema
|
|
schema''' `shouldBe` schema'
|
|
|
|
skipComparisonForDownMigrations :: [String]
|
|
skipComparisonForDownMigrations =
|
|
[ -- on down migration msg_delivery_events table moves down to the end of the file
|
|
"20230504_recreate_msg_delivery_events_cleanup_messages",
|
|
-- on down migration idx_chat_items_timed_delete_at index moves down to the end of the file
|
|
"20230529_indexes",
|
|
-- table and index definitions move down the file, so fields are re-created as not unique
|
|
"20230914_member_probes"
|
|
]
|
|
|
|
getSchema :: FilePath -> FilePath -> IO String
|
|
getSchema dpPath schemaPath = do
|
|
void $ readCreateProcess (shell $ "sqlite3 " <> dpPath <> " '.schema --indent' > " <> schemaPath) ""
|
|
sch <- readFile schemaPath
|
|
sch `deepseq` pure sch
|