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.

diff --git a/Database/Benchmark.hs b/Database/Benchmark.hs
index f895defdf67f85fb08031a97b12807919c18fe0c..613a30e5089348d575fb69d52a654086a29ad10a 100644 (file)
--- 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 a65b4bc569d16722dace211ba490c054f36ea689..9dce98d10429afc228a39b3491908b370b713ac5 100644 (file)
--- 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 18f7b2fed94ce745bfcba05eb03cb736c750cf07..5caf312e195ad9264668f2892f75743ae05ab276 100644 (file)
--- 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 ab7a14c95e9fd5c02f6f745bd83558fbd7833bf3..4023390aceb37ae4ccd68ad941020def6b35871c 100644 (file)
--- 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 b2ae6ed5a7431295bb2fd6c7fcee2ef8ba8d4792..f06cd0b08dfe8b1cbc5131b0322012139ecb12bd 100644 (file)
--- 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 afd6048adaff6bb96c18d2d1b3d166d2aa6b8137..386c3245b12b2d7d17a7e8e9c86bc33e771f1063 100644 (file)
--- 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 434acfc9a7b1623ab361e38e26f81ea8cb9d8472..77939043651e294489074b27c76553c83d2c5875 100644 (file)
--- 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