Merge pull request #3091 from unisonweb/cp/wal-on-create

Set journal mode on create rather than open.
unisonweb · Jun 2, 2022 · 3234b5f · 3234b5f
2 parents f61a4dd + de62ee0
commit 3234b5f
Show file tree

Hide file tree

Showing 2 changed files with 11 additions and 8 deletions.
diff --git a/lib/unison-sqlite/src/Unison/Sqlite/JournalMode.hs b/lib/unison-sqlite/src/Unison/Sqlite/JournalMode.hs
@@ -8,9 +8,9 @@ where
 import qualified Data.Text as Text
 import qualified Database.SQLite.Simple as Sqlite
 import Unison.Prelude
+import Unison.Sqlite.Connection
 import Unison.Sqlite.Exception (SqliteExceptionReason)
 import Unison.Sqlite.Sql
-import Unison.Sqlite.Connection
 
 -- | https://www.sqlite.org/pragma.html#pragma_journal_mode
 data JournalMode
@@ -45,8 +45,8 @@ journalModeToText = \case
   JournalMode'WAL -> "wal"
   JournalMode'OFF -> "off"
 
-trySetJournalMode :: Connection -> JournalMode -> IO ()
-trySetJournalMode conn mode0 = do
+trySetJournalMode :: MonadIO m => Connection -> JournalMode -> m ()
+trySetJournalMode conn mode0 = liftIO do
   queryOneRowCheck_
     conn
     (Sql ("PRAGMA journal_mode = " <> journalModeToText mode0))

diff --git a/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs b/parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs
@@ -131,7 +131,8 @@ createCodebaseOrError debugName path action = do
     (pure $ Left Codebase1.CreateCodebaseAlreadyExists)
     do
       createDirectoryIfMissing True (makeCodebaseDirPath path)
-      withConnection (debugName ++ ".createSchema") path \conn ->
+      withConnection (debugName ++ ".createSchema") path \conn -> do
+        Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL
         Sqlite.runTransaction conn do
           Q.createSchema
           void . Ops.saveRootBranch $ Cv.causalbranch1to2 Branch.empty
@@ -178,9 +179,7 @@ withConnection ::
   (Sqlite.Connection -> m a) ->
   m a
 withConnection name root action =
-  Sqlite.withConnection name (makeCodebasePath root) \conn -> do
-    liftIO (Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL)
-    action conn
+  Sqlite.withConnection name (makeCodebasePath root) action
 
 sqliteCodebase ::
   forall m r.
@@ -688,14 +687,18 @@ viewRemoteBranch' (repo, sbh, path) gitBranchBehavior action = UnliftIO.try $ do
   time "Git fetch" $
     throwEitherMWith C.GitProtocolError . withRepo repo gitBranchBehavior $ \remoteRepo -> do
       let remotePath = Git.gitDirToPath remoteRepo
+          -- In modern UCM all new codebases are created in WAL mode, but it's possible old
+          -- codebases were pushed to git in DELETE mode, so when pulling remote branches we
+          -- ensure we're in WAL mode just to be safe.
+          ensureWALMode conn = Sqlite.trySetJournalMode conn Sqlite.JournalMode'WAL
       -- Tickle the database before calling into `sqliteCodebase`; this covers the case that the database file either
       -- doesn't exist at all or isn't a SQLite database file, but does not cover the case that the database file itself
       -- is somehow corrupt, or not even a Unison database.
       --
       -- FIXME it would probably make more sense to define some proper preconditions on `sqliteCodebase`, and perhaps
       -- update its output type, which currently indicates the only way it can fail is with an `UnknownSchemaVersion`
       -- error.
-      (withConnection "codebase exists check" remotePath \_ -> pure ()) `catch` \exception ->
+      (withConnection "codebase exists check" remotePath ensureWALMode) `catch` \exception ->
         if Sqlite.isCantOpenException exception
           then throwIO (C.GitSqliteCodebaseError (GitError.NoDatabaseFile repo remotePath))
           else throwIO exception