mirror of
https://github.com/simplex-chat/simplexmq.git
synced 2026-03-30 22:55:50 +00:00
add pragmas and vacuum db (#343)
This commit is contained in:
@@ -81,10 +81,24 @@ createSQLiteStore dbFilePath poolSize migrations yesToMigrations = do
|
||||
let dbDir = takeDirectory dbFilePath
|
||||
createDirectoryIfMissing False dbDir
|
||||
st <- connectSQLiteStore dbFilePath poolSize
|
||||
withConnection st $ \db -> DB.execute_ db "VACUUM;"
|
||||
-- _printPragmas st
|
||||
checkThreadsafe st
|
||||
migrateSchema st migrations yesToMigrations
|
||||
pure st
|
||||
|
||||
_printPragmas :: SQLiteStore -> IO ()
|
||||
_printPragmas st@SQLiteStore {dbFilePath} = withConnection st $ \db -> do
|
||||
foreign_keys <- DB.query_ db "PRAGMA foreign_keys;" :: IO [[Int]]
|
||||
print $ dbFilePath <> " foreign_keys: " <> show foreign_keys
|
||||
-- when run via sqlite-simple query for trusted_schema seems to return empty list
|
||||
trusted_schema <- DB.query_ db "PRAGMA trusted_schema;" :: IO [[Int]]
|
||||
print $ dbFilePath <> " trusted_schema: " <> show trusted_schema
|
||||
secure_delete <- DB.query_ db "PRAGMA secure_delete;" :: IO [[Int]]
|
||||
print $ dbFilePath <> " secure_delete: " <> show secure_delete
|
||||
auto_vacuum <- DB.query_ db "PRAGMA auto_vacuum;" :: IO [[Int]]
|
||||
print $ dbFilePath <> " auto_vacuum: " <> show auto_vacuum
|
||||
|
||||
checkThreadsafe :: SQLiteStore -> IO ()
|
||||
checkThreadsafe st = withConnection st $ \db -> do
|
||||
compileOptions <- DB.query_ db "pragma COMPILE_OPTIONS;" :: IO [[Text]]
|
||||
@@ -127,7 +141,10 @@ connectSQLiteStore dbFilePath poolSize = do
|
||||
connectDB :: FilePath -> IO DB.Connection
|
||||
connectDB path = do
|
||||
dbConn <- DB.open path
|
||||
DB.execute_ dbConn "PRAGMA foreign_keys = ON; PRAGMA journal_mode = WAL;"
|
||||
DB.execute_ dbConn "PRAGMA foreign_keys = ON;"
|
||||
-- DB.execute_ dbConn "PRAGMA trusted_schema = OFF;"
|
||||
DB.execute_ dbConn "PRAGMA secure_delete = ON;"
|
||||
DB.execute_ dbConn "PRAGMA auto_vacuum = FULL;"
|
||||
pure dbConn
|
||||
|
||||
checkConstraint :: StoreError -> IO (Either StoreError a) -> IO (Either StoreError a)
|
||||
|
||||
Reference in New Issue
Block a user