fix case where keys db was not initialized in time

When the keys db is opened for read, and did not exist yet, it used to
skip creating it, and return mempty values. But that prevents
reconcileStaged from populating associated files information in time for
the read. This fixes the one remaining case I know of where
the fix in a56b151f90 didn't work.

Note that, when there is a permissions error, it still avoids creating
the db and returns mempty for all queries. This does mean that
reconcileStaged does not run and so it may want to drop files that it
should not. However, presumably a permissions error on the keys database
also means that the user does not have permission to delete annex
objects, so they won't be able to drop the files anyway.

Sponsored-by: Dartmouth College's Datalad project

Annex/Wanted.hs

@@ -44,8 +44,9 @@ wantDrop d from key file others = do
 			others' <- case others of
 				Just afs -> pure (filter (/= file) afs)
 				Nothing -> case key of
-					Just k -> mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
+					Just k ->
-						=<< Database.Keys.getAssociatedFiles k
+						mapM (\f -> AssociatedFile . Just <$> fromRepo (fromTopFilePath f))
+							=<< Database.Keys.getAssociatedFiles k
 					Nothing -> pure []
 			l <- filterM checkwant others'
 			if null l

Database/Keys.hs

@@ -55,10 +55,6 @@ import qualified Data.ByteString.Char8 as S8
 import qualified System.FilePath.ByteString as P
 
 {- Runs an action that reads from the database.
- -
- - If the database doesn't already exist, it's not created; mempty is
- - returned instead. This way, when the keys database is not in use,
- - there's minimal overhead in checking it.
  -
  - If the database is already open, any writes are flushed to it, to ensure
  - consistency.
@@ -76,7 +72,7 @@ runReader a = do
 		v <- a (SQL.ReadHandle qh)
 		return (v, st)
 	go DbClosed = do
-		st' <- openDb False DbClosed
+		st' <- openDb True DbClosed
 		v <- case st' of
 			(DbOpen qh) -> a (SQL.ReadHandle qh)
 			_ -> return mempty
@@ -98,7 +94,7 @@ runWriter a = do
 		v <- a (SQL.WriteHandle qh)
 		return (v, st)
 	go st = do
-		st' <- openDb True st
+		st' <- openDb False st
 		v <- case st' of
 			DbOpen qh -> a (SQL.WriteHandle qh)
 			_ -> error "internal"
@@ -107,7 +103,7 @@ runWriter a = do
 runWriterIO :: (SQL.WriteHandle -> IO ()) -> Annex ()
 runWriterIO a = runWriter (liftIO . a)
 
-{- Opens the database, perhaps creating it if it doesn't exist yet.
+{- Opens the database, creating it if it doesn't exist yet.
  -
  - Multiple readers and writers can have the database open at the same
  - time. Database.Handle deals with the concurrency issues.
@@ -118,22 +114,21 @@ runWriterIO a = runWriter (liftIO . a)
 openDb :: Bool -> DbState -> Annex DbState
 openDb _ st@(DbOpen _) = return st
 openDb False DbUnavailable = return DbUnavailable
-openDb createdb _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
+openDb forwrite _ = catchPermissionDenied permerr $ withExclusiveLock gitAnnexKeysDbLock $ do
 	dbdir <- fromRepo gitAnnexKeysDb
 	let db = dbdir P.</> "db"
 	dbexists <- liftIO $ R.doesPathExist db
-	case (dbexists, createdb) of
+	case dbexists of
-		(True, _) -> open db
+		True -> open db
-		(False, True) -> do
+		False -> do
 			initDb db SQL.createTables
 			open db
-		(False, False) -> return DbUnavailable
   where
-	-- If permissions don't allow opening the database, treat it as if
+	-- If permissions don't allow opening the database, and it's being
-	-- it does not exist.
+	-- opened for read, treat it as if it does not exist.
-	permerr e = case createdb of
+	permerr e
-		False -> return DbUnavailable
+		| forwrite = throwM e
-		True -> throwM e
+		| otherwise = return DbUnavailable
 	
 	open db = do
 		qh <- liftIO $ H.openDbQueue H.MultiWriter db SQL.containedTable