From 38a23928e9d45b56d6836a4eac703862d63cf93c Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Wed, 16 Dec 2015 14:05:26 -0400
Subject: [PATCH] temporarily remove cached keys database connection

The problem is that shutdown is not always called, particularly in the test
suite. So, a database connection would be opened, possibly some changes
queued, and then not shut down.

One way this can happen is when using Annex.eval or Annex.run with a new
state. A better fix might be to make both of them call Keys.shutdown
(and be sure to do it even if the annex action threw an error).

Complication: Sometimes they're run reusing an existing state, so shutting
down a database connection could cause problems for other users of that
same state. I think this would need a MVar holding the database handle,
so it could be emptied once shut down, and another user of the database
connection could then start up a new one if it got shut down. But, what if
2 threads were concurrently using the same database handle and one shut it
down while the other was writing to it? Urgh.

Might have to go that route eventually to get the database access to run
fast enough. For now, a quick fix to get the test suite happier, at the
expense of speed.
---
 Annex.hs         |  3 ---
 Annex/Action.hs  |  2 --
 Database/Keys.hs | 20 +-------------------
 3 files changed, 1 insertion(+), 24 deletions(-)

diff --git a/Annex.hs b/Annex.hs
index c4df0b92f6..c9a4ef6a05 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -60,7 +60,6 @@ import Types.NumCopies
 import Types.LockCache
 import Types.DesktopNotify
 import Types.CleanupActions
-import qualified Database.Keys.Types
 #ifdef WITH_QUVI
 import Utility.Quvi (QuviVersion)
 #endif
@@ -135,7 +134,6 @@ data AnnexState = AnnexState
 	, desktopnotify :: DesktopNotify
 	, workers :: [Either AnnexState (Async AnnexState)]
 	, concurrentjobs :: Maybe Int
-	, keysdbhandle :: Maybe Database.Keys.Types.DbHandle
 	}
 
 newState :: GitConfig -> Git.Repo -> AnnexState
@@ -181,7 +179,6 @@ newState c r = AnnexState
 	, desktopnotify = mempty
 	, workers = []
 	, concurrentjobs = Nothing
-	, keysdbhandle = Nothing
 	}
 
 {- Makes an Annex state object for the specified git repo.
diff --git a/Annex/Action.hs b/Annex/Action.hs
index 348487e7c9..f59c9c2f45 100644
--- a/Annex/Action.hs
+++ b/Annex/Action.hs
@@ -17,7 +17,6 @@ import System.Posix.Signals
 import Common.Annex
 import qualified Annex
 import Annex.Content
-import qualified Database.Keys
 
 {- Actions to perform each time ran. -}
 startup :: Annex ()
@@ -33,5 +32,4 @@ shutdown :: Bool -> Annex ()
 shutdown nocommit = do
 	saveState nocommit
 	sequence_ =<< M.elems <$> Annex.getState Annex.cleanup
-	Database.Keys.shutdown
 	liftIO reapZombies -- zombies from long-running git processes
diff --git a/Database/Keys.hs b/Database/Keys.hs
index d4b5b33574..a0c5b1a04c 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -14,7 +14,6 @@ module Database.Keys (
 	DbHandle,
 	openDb,
 	closeDb,
-	shutdown,
 	addAssociatedFile,
 	getAssociatedFiles,
 	getAssociatedKey,
@@ -84,24 +83,7 @@ closeDb :: DbHandle -> IO ()
 closeDb (DbHandle h) = H.closeDb h
 
 withDbHandle :: (H.DbHandle -> IO a) -> Annex a
-withDbHandle a = do
-	(DbHandle h) <- dbHandle
-	liftIO $ a h
-
-dbHandle :: Annex DbHandle
-dbHandle = maybe startup return =<< Annex.getState Annex.keysdbhandle
-  where
-	startup = do
-		h <- openDb
-		Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
-		return h
-
-shutdown :: Annex ()
-shutdown = maybe noop go =<< Annex.getState Annex.keysdbhandle
-  where
-	go h = do
-		Annex.changeState $ \s -> s { Annex.keysdbhandle = Nothing }
-		liftIO $ closeDb h
+withDbHandle a = bracket openDb (liftIO . closeDb) (\(DbHandle h) -> liftIO (a h))
 
 addAssociatedFile :: Key -> FilePath -> Annex ()
 addAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
-- 
2.30.2