add pragmas and vacuum db (#343)

This commit is contained in:
JRoberts
2022-03-31 14:51:59 +04:00
committed by GitHub
parent b6e87e4a3e
commit 33f822d72c

View File

@@ -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)