diff options
| author |  Joey Hess <joeyh@joeyh.name> | 2015-02-18 16:56:52 -0400 |
|---|---|---|
| committer | Joey Hess <joeyh@joeyh.name> | 2015-02-18 16:56:52 -0400 |
| commit | 814a3ea8c651f66a55638e0c40f13c1897b29a32 (patch) | |
| tree | 6f46f53c612b6610eb49b9a16b9d6fe5483166ef | |
| parent | d8125c9ea6d00b41f994162a0060f39e56107b12 (diff) | |
deal with rare SELECT ErrorBusy failures
I think they might be a sqlite bug. In discussions with sqlite devs.
| -rw-r--r-- | Database/Fsck.hs | 2 | ||||
| -rw-r--r-- | Database/Handle.hs | 19 |
2 files changed, 14 insertions, 7 deletions
diff --git a/Database/Fsck.hs b/Database/Fsck.hs index 92c814cf1..d249c8de6 100644 --- a/Database/Fsck.hs +++ b/Database/Fsck.hs @@ -96,7 +96,7 @@ addDb (FsckHandle h _) k = H.queueDb h 1000 $ sk = toSKey k inDb :: FsckHandle -> Key -> IO Bool -inDb (FsckHandle h _) = H.queryDb h . inDb' . toSKey +inDb (FsckHandle h _) = H.queryDb h False . inDb' . toSKey inDb' :: SKey -> SqlPersistM Bool inDb' sk = do diff --git a/Database/Handle.hs b/Database/Handle.hs index 578bea31d..5d33105f2 100644 --- a/Database/Handle.hs +++ b/Database/Handle.hs @@ -100,13 +100,20 @@ workerThread db jobs = catchNonAsync loop showerr - Only one action can be run at a time against a given DbHandle. - If called concurrently in the same process, this will block until - it is able to run. + - + - Warning: Under heavy traffic, this can fail with an exception + - that contains "ErrorBusy". WAL mode does not entirely prevent this. + - The fallback value is returned in this case. -} -queryDb :: DbHandle -> SqlPersistM a -> IO a -queryDb (DbHandle _ jobs _) a = do - res <- newEmptyMVar - putMVar jobs $ QueryJob $ - liftIO . putMVar res =<< tryNonAsync a - either throwIO return =<< takeMVar res +queryDb :: DbHandle -> a -> SqlPersistM a -> IO a +queryDb (DbHandle _ jobs _) fallback a = + catchNonAsync go (\_ -> return fallback ) + where + go = do + res <- newEmptyMVar + putMVar jobs $ QueryJob $ + liftIO . putMVar res =<< tryNonAsync a + either throwIO return =<< takeMVar res closeDb :: DbHandle -> IO () closeDb h@(DbHandle worker jobs _) = do |