diff --git a/app/Main.hs b/app/Main.hs index 6362386..1fa642f 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -64,6 +64,7 @@ import AirGQL.Utils ( getGraphiQLVersion, getSqliteBinaryVersion, getSqliteEmbeddedVersion, + withRetryConn, ) import Server.Server (platformApp) @@ -198,7 +199,7 @@ main = do putText versionSlug ---------- Serve{dbFilePath} -> do - SS.withConnection dbFilePath $ \conn -> do + withRetryConn dbFilePath $ \conn -> do P.when (dbFilePath == "") $ P.die "ERROR: No database file path was specified" diff --git a/source/AirGQL/Servant/SqlQuery.hs b/source/AirGQL/Servant/SqlQuery.hs index c2a568d..3d6185e 100644 --- a/source/AirGQL/Servant/SqlQuery.hs +++ b/source/AirGQL/Servant/SqlQuery.hs @@ -104,7 +104,7 @@ sqlQueryPostHandler pragmaConf dbId sqlPost = do validationErrors <- liftIO $ case parseSql sqlPost.query of Left error -> pure [prettyError error] Right statement@(CreateTable{}) -> - SS.withConnection (getMainDbPath dbId) $ \conn -> + withRetryConn (getMainDbPath dbId) $ \conn -> lintTableCreationCode (Just conn) statement _ -> pure [] diff --git a/source/AirGQL/Utils.hs b/source/AirGQL/Utils.hs index 68aca22..73bf932 100644 --- a/source/AirGQL/Utils.hs +++ b/source/AirGQL/Utils.hs @@ -358,4 +358,5 @@ withRetryConn :: FilePath -> (Connection -> IO a) -> IO a withRetryConn filePath action = do SS.withConnection filePath $ \conn -> do SS.execute_ conn "PRAGMA busy_timeout = 5000;" -- 5 seconds + SS.execute_ conn "PRAGMA foreign_keys = True" action conn diff --git a/tests/Spec.hs b/tests/Spec.hs index 49b246f..3c85339 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -180,7 +180,7 @@ testSuite = do results `shouldBe` ["hi world", "hi World", "HeLLo WorLd"] it "loads all tables from database" $ do - tables <- SS.withConnection dbPath $ \conn -> + tables <- withRetryConn dbPath $ \conn -> getTables conn shouldBe @@ -217,7 +217,7 @@ testSuite = do describe "getColumns" $ do it "loads all columns from users table" $ do - tableColumns <- SS.withConnection dbPath $ \conn -> + tableColumns <- withRetryConn dbPath $ \conn -> getColumns fixtureDbId conn "users" let diff --git a/tests/Tests/MutationSpec.hs b/tests/Tests/MutationSpec.hs index 009cda8..f06cf63 100644 --- a/tests/Tests/MutationSpec.hs +++ b/tests/Tests/MutationSpec.hs @@ -32,6 +32,7 @@ import AirGQL.Types.SchemaConf (SchemaConf (accessMode), defaultSchemaConf) import AirGQL.Types.SqlQueryPostResult ( SqlQueryPostResult (rows), ) +import AirGQL.Utils (withRetryConn) import Data.Text qualified as T import Database.SQLite.Simple (SQLData (SQLFloat, SQLInteger, SQLNull, SQLText)) import Servant (runHandler) @@ -193,7 +194,7 @@ main = void $ do it "supports inserting empty records" $ do let testDbPath = testRoot </> "empty-record-insertion.db" - SS.withConnection testDbPath $ \conn -> do + withRetryConn testDbPath $ \conn -> do SS.execute_ conn [sql|