Merge branch 'master' into rcv-services

This commit is contained in:
Evgeny Poberezkin
2025-12-03 17:23:59 +00:00
6 changed files with 40 additions and 22 deletions
+1 -1
View File
@@ -3715,7 +3715,7 @@ insertUser :: DBStore -> IO ()
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users DEFAULT VALUES")
#else
createStore :: String -> IO (Either MigrationError DBStore)
createStore dbPath = createAgentStore (DBOpts dbPath "" False True DB.TQOff) (MigrationConfig MCError Nothing)
createStore dbPath = createAgentStore (DBOpts dbPath [] "" False True DB.TQOff) (MigrationConfig MCError Nothing)
insertUser :: DBStore -> IO ()
insertUser st = withTransaction st (`DB.execute_` "INSERT INTO users (user_id) VALUES (1)")
+1
View File
@@ -230,6 +230,7 @@ createStore randSuffix migrations confirmMigrations = do
let dbOpts =
DBOpts {
dbFilePath = testDB randSuffix,
dbFunctions = [],
dbKey = "",
keepKey = False,
vacuum = True,
+2 -2
View File
@@ -72,7 +72,7 @@ withStore2 = before connect2 . after (removeStore . fst)
connect2 :: IO (DBStore, DBStore)
connect2 = do
s1@DBStore {dbFilePath} <- createStore'
s2 <- connectSQLiteStore dbFilePath "" False DB.TQOff
s2 <- connectSQLiteStore $ DBOpts dbFilePath [] "" False False DB.TQOff
pure (s1, s2)
createStore' :: IO DBStore
@@ -83,7 +83,7 @@ createEncryptedStore key keepKey = do
-- Randomize DB file name to avoid SQLite IO errors supposedly caused by asynchronous
-- IO operations on multiple similarly named files; error seems to be environment specific
r <- randomIO :: IO Word32
Right st <- createDBStore (DBOpts (testDB <> show r) key keepKey True DB.TQOff) appMigrations (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts (testDB <> show r) [] key keepKey True DB.TQOff) appMigrations (MigrationConfig MCError Nothing)
withTransaction' st (`SQL.execute_` "INSERT INTO users (user_id) VALUES (1);")
pure st
+6 -6
View File
@@ -51,7 +51,7 @@ testVerifySchemaDump :: IO ()
testVerifySchemaDump = do
savedSchema <- ifM (doesFileExist appSchema) (readFile appSchema) (pure "")
savedSchema `deepseq` pure ()
void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
void $ createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
getSchema testDB appSchema `shouldReturn` savedSchema
removeFile testDB
@@ -59,14 +59,14 @@ testVerifyLintFKeyIndexes :: IO ()
testVerifyLintFKeyIndexes = do
savedLint <- ifM (doesFileExist appLint) (readFile appLint) (pure "")
savedLint `deepseq` pure ()
void $ createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
void $ createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCConsole Nothing)
getLintFKeyIndexes testDB "tests/tmp/agent_lint.sql" `shouldReturn` savedLint
removeFile testDB
testSchemaMigrations :: IO ()
testSchemaMigrations = do
let noDownMigrations = dropWhileEnd (\Migration {down} -> isJust down) appMigrations
Right st <- createDBStore (DBOpts testDB "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) noDownMigrations (MigrationConfig MCError Nothing)
mapM_ (testDownMigration st) $ drop (length noDownMigrations) appMigrations
closeDBStore st
removeFile testDB
@@ -89,7 +89,7 @@ testSchemaMigrations = do
testUsersMigrationNew :: IO ()
testUsersMigrationNew = do
Right st <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCError Nothing)
withTransaction' st (`SQL.query_` "SELECT user_id FROM users;")
`shouldReturn` ([] :: [Only Int])
closeDBStore st
@@ -97,11 +97,11 @@ testUsersMigrationNew = do
testUsersMigrationOld :: IO ()
testUsersMigrationOld = do
let beforeUsers = takeWhile (("m20230110_users" /=) . name) appMigrations
Right st <- createDBStore (DBOpts testDB "" False True TQOff) beforeUsers (MigrationConfig MCError Nothing)
Right st <- createDBStore (DBOpts testDB [] "" False True TQOff) beforeUsers (MigrationConfig MCError Nothing)
withTransaction' st (`SQL.query_` "SELECT name FROM sqlite_master WHERE type = 'table' AND name = 'users';")
`shouldReturn` ([] :: [Only String])
closeDBStore st
Right st' <- createDBStore (DBOpts testDB "" False True TQOff) appMigrations (MigrationConfig MCYesUp Nothing)
Right st' <- createDBStore (DBOpts testDB [] "" False True TQOff) appMigrations (MigrationConfig MCYesUp Nothing)
withTransaction' st' (`SQL.query_` "SELECT user_id FROM users;")
`shouldReturn` ([Only (1 :: Int)])
closeDBStore st'