From f5b642318dc33f9cee41cac08a276cae37878633 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Oct 2021 12:24:40 -0400 Subject: [PATCH] eliminate single/multi writer distinction After commit f4bdecc4ecce8bcbb2d8ccbb524ba1f3f76565ba, there is no longer any distinction between SingleWriter and MultiWriter's handling of read after write. Databases that were SingleWriter still have lock files that are used to prevent multiple writers. This does make writing to such databases a bit more expensive, because the MultiWriter code path that is now used opens a second db connection in order to write to them. --- Database/Benchmark.hs | 2 +- Database/ContentIdentifier.hs | 2 +- Database/Export.hs | 2 +- Database/Fsck.hs | 2 +- Database/Handle.hs | 53 +++++++++-------------------------- Database/Keys.hs | 2 +- Database/Queue.hs | 7 ++--- 7 files changed, 21 insertions(+), 49 deletions(-) diff --git a/Database/Benchmark.hs b/Database/Benchmark.hs index f895defdf6..613a30e508 100644 --- a/Database/Benchmark.hs +++ b/Database/Benchmark.hs @@ -107,7 +107,7 @@ benchDb :: RawFilePath -> Integer -> Annex BenchDb benchDb tmpdir num = do liftIO $ putStrLn $ "setting up database with " ++ show num ++ " items" initDb db SQL.createTables - h <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable + h <- liftIO $ H.openDbQueue db SQL.containedTable liftIO $ populateAssociatedFiles h num sz <- liftIO $ getFileSize db liftIO $ putStrLn $ "size of database on disk: " ++ diff --git a/Database/ContentIdentifier.hs b/Database/ContentIdentifier.hs index a65b4bc569..9dce98d104 100644 --- a/Database/ContentIdentifier.hs +++ b/Database/ContentIdentifier.hs @@ -89,7 +89,7 @@ openDb = do , liftIO $ runSqlite (T.pack (fromRawFilePath db)) $ void $ runMigrationSilent migrateContentIdentifier ) - h <- liftIO $ H.openDbQueue H.SingleWriter db "content_identifiers" + h <- liftIO $ H.openDbQueue db "content_identifiers" return $ ContentIdentifierHandle h closeDb :: ContentIdentifierHandle -> Annex () diff --git a/Database/Export.hs b/Database/Export.hs index 18f7b2fed9..5caf312e19 100644 --- a/Database/Export.hs +++ b/Database/Export.hs @@ -104,7 +104,7 @@ openDb u = do unlessM (liftIO $ R.doesPathExist db) $ do initDb db $ void $ runMigrationSilent migrateExport - h <- liftIO $ H.openDbQueue H.SingleWriter db "exported" + h <- liftIO $ H.openDbQueue db "exported" return $ ExportHandle h u closeDb :: ExportHandle -> Annex () diff --git a/Database/Fsck.hs b/Database/Fsck.hs index ab7a14c95e..4023390ace 100644 --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -76,7 +76,7 @@ openDb u = do initDb db $ void $ runMigrationSilent migrateFsck lockFileCached =<< fromRepo (gitAnnexFsckDbLock u) - h <- liftIO $ H.openDbQueue H.MultiWriter db "fscked" + h <- liftIO $ H.openDbQueue db "fscked" return $ FsckHandle h u closeDb :: FsckHandle -> Annex () diff --git a/Database/Handle.hs b/Database/Handle.hs index b2ae6ed5a7..f06cd0b08d 100644 --- a/Database/Handle.hs +++ b/Database/Handle.hs @@ -9,7 +9,6 @@ module Database.Handle ( DbHandle, - DbConcurrency(..), openDb, TableName, queryDb, @@ -37,40 +36,27 @@ import System.IO {- A DbHandle is a reference to a worker thread that communicates with - the database. It has a MVar which Jobs are submitted to. -} -data DbHandle = DbHandle DbConcurrency (Async ()) (MVar Job) +data DbHandle = DbHandle (Async ()) (MVar Job) {- Name of a table that should exist once the database is initialized. -} type TableName = String -{- Sqlite only allows a single write to a database at a time; a concurrent - - write will crash. - - - - MultiWrter works around this limitation. It uses additional resources - - when writing, because it needs to open the database multiple times. And - - writes to the database may block for some time, if other processes are also - - writing to it. - - - - When a database can only be written to by a single process (enforced by - - a lock file), use SingleWriter. (Multiple threads can still write.) - -} -data DbConcurrency = SingleWriter | MultiWriter - {- Opens the database, but does not perform any migrations. Only use - once the database is known to exist and have the right tables. -} -openDb :: DbConcurrency -> RawFilePath -> TableName -> IO DbHandle -openDb dbconcurrency db tablename = do +openDb :: RawFilePath -> TableName -> IO DbHandle +openDb db tablename = do jobs <- newEmptyMVar worker <- async (workerThread (T.pack (fromRawFilePath db)) tablename jobs) -- work around https://github.com/yesodweb/persistent/issues/474 liftIO $ fileEncoding stderr - return $ DbHandle dbconcurrency worker jobs + return $ DbHandle worker jobs {- This is optional; when the DbHandle gets garbage collected it will - auto-close. -} closeDb :: DbHandle -> IO () -closeDb (DbHandle _ worker jobs) = do +closeDb (DbHandle worker jobs) = do putMVar jobs CloseJob wait worker @@ -85,7 +71,7 @@ closeDb (DbHandle _ worker jobs) = do - it is able to run. -} queryDb :: DbHandle -> SqlPersistM a -> IO a -queryDb (DbHandle _ _ jobs) a = do +queryDb (DbHandle _ jobs) a = do res <- newEmptyMVar putMVar jobs $ QueryJob $ liftIO . putMVar res =<< tryNonAsync a @@ -94,10 +80,9 @@ queryDb (DbHandle _ _ jobs) a = do {- Writes a change to the database. - - - In MultiWriter mode, writes can fail if another write is happening - - concurrently. So write failures are caught and retried repeatedly - - for up to 10 seconds, which should avoid all but the most exceptional - - problems. + - Writes can fail if another write is happening concurrently. + - So write failures are caught and retried repeatedly for up to 10 + - seconds, which should avoid all but the most exceptional problems. -} commitDb :: DbHandle -> SqlPersistM () -> IO () commitDb h wa = robustly Nothing 100 (commitDb' h wa) @@ -113,22 +98,15 @@ commitDb h wa = robustly Nothing 100 (commitDb' h wa) robustly (Just e) (n-1) a commitDb' :: DbHandle -> SqlPersistM () -> IO (Either SomeException ()) -commitDb' (DbHandle MultiWriter _ jobs) a = do +commitDb' (DbHandle _ jobs) a = do res <- newEmptyMVar - putMVar jobs $ RobustChangeJob $ \runner -> + putMVar jobs $ ChangeJob $ \runner -> liftIO $ putMVar res =<< tryNonAsync (runner a) takeMVar res -commitDb' (DbHandle SingleWriter _ jobs) a = do - res <- newEmptyMVar - putMVar jobs $ ChangeJob $ - liftIO . putMVar res =<< tryNonAsync a - takeMVar res - `catchNonAsync` (const $ error "sqlite commit crashed") data Job = QueryJob (SqlPersistM ()) - | ChangeJob (SqlPersistM ()) - | RobustChangeJob ((SqlPersistM () -> IO ()) -> IO ()) + | ChangeJob ((SqlPersistM () -> IO ()) -> IO ()) | CloseJob workerThread :: T.Text -> TableName -> MVar Job -> IO () @@ -150,16 +128,11 @@ workerThread db tablename jobs = newconn Left BlockedIndefinitelyOnMVar -> return (return ()) Right CloseJob -> return (return ()) Right (QueryJob a) -> a >> loop - Right (ChangeJob a) -> do - a - -- Exit this sqlite connection so the - -- database gets updated on disk. - return newconn -- Change is run in a separate database connection -- since sqlite only supports a single writer at a -- time, and it may crash the database connection -- that the write is made to. - Right (RobustChangeJob a) -> do + Right (ChangeJob a) -> do liftIO (a (runSqliteRobustly tablename db)) -- Exit this sqlite connection so the -- change that was just written, using diff --git a/Database/Keys.hs b/Database/Keys.hs index afd6048ada..386c3245b1 100644 --- a/Database/Keys.hs +++ b/Database/Keys.hs @@ -134,7 +134,7 @@ openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKe | otherwise = return DbUnavailable open db = do - qh <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable + qh <- liftIO $ H.openDbQueue db SQL.containedTable reconcileStaged qh return $ DbOpen qh diff --git a/Database/Queue.hs b/Database/Queue.hs index 434acfc9a7..7793904365 100644 --- a/Database/Queue.hs +++ b/Database/Queue.hs @@ -9,7 +9,6 @@ module Database.Queue ( DbQueue, - DbConcurrency(..), openDbQueue, queryDbQueue, closeDbQueue, @@ -37,9 +36,9 @@ data DbQueue = DQ DbHandle (MVar Queue) {- Opens the database queue, but does not perform any migrations. Only use - if the database is known to exist and have the right tables; ie after - running initDb. -} -openDbQueue :: DbConcurrency -> RawFilePath -> TableName -> IO DbQueue -openDbQueue dbconcurrency db tablename = DQ - <$> openDb dbconcurrency db tablename +openDbQueue :: RawFilePath -> TableName -> IO DbQueue +openDbQueue db tablename = DQ + <$> openDb db tablename <*> (newMVar =<< emptyQueue) {- This or flushDbQueue must be called, eg at program exit to ensure -- 2.30.2