use InodeCache when dropping a key to see if a pointer file can be safely reset

The Keys database can hold multiple inode caches for a given key. One for
the annex object, and one for each pointer file, which may not be hard
linked to it.

Inode caches for a key are recorded when its content is added to the annex,
but only if it has known pointer files. This is to avoid the overhead of
maintaining the database when not needed.

When the smudge filter outputs a file's content, the inode cache is not
updated, because git's smudge interface doesn't let us write the file. So,
dropping will fall back to doing an expensive verification then. Ideally,
git's interface would be improved, and then the inode cache could be
updated then too.

1 files changed, 40 insertions, 20 deletions

diff --git a/Database/Keys.hs b/Database/Keys.hs
index 092c0d900..78d583d63 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -13,15 +13,17 @@
 module Database.Keys (
 	DbHandle,
 	openDb,
-	flushDb,
 	closeDb,
+	shutdown,
 	addAssociatedFile,
 	getAssociatedFiles,
 	removeAssociatedFile,
-	setInodeCache,
-	getInodeCache,
+	storeInodeCaches,
+	addInodeCaches,
+	getInodeCaches,
+	removeInodeCaches,
 	AssociatedId,
-	DataId,
+	ContentId,
 ) where
 
 import Database.Types
@@ -35,6 +37,7 @@ import Annex.Perms
 import Annex.LockFile
 import Messages
 import Utility.InodeCache
+import Annex.InodeSentinal
 
 import Database.Persist.TH
 import Database.Esqueleto hiding (Key)
@@ -44,10 +47,10 @@ Associated
   key SKey
   file FilePath
   KeyFileIndex key file
-Data
+Content
   key SKey
-  inodeCache SInodeCache
-  KeyIndex key
+  cache SInodeCache
+  KeyCacheIndex key cache
 |]
 
 {- Opens the database, creating it if it doesn't exist yet. -}
@@ -62,7 +65,7 @@ openDb = withExclusiveLock gitAnnexKeysDbLock $ do
 				runMigrationSilent migrateKeysDb
 		setAnnexDirPerm dbdir
 		setAnnexFilePerm db
-	h <- liftIO $ H.openDb db "data"
+	h <- liftIO $ H.openDb db "content"
 
 	-- work around https://github.com/yesodweb/persistent/issues/474
 	liftIO setConsoleEncoding
@@ -85,9 +88,12 @@ dbHandle = maybe startup return =<< Annex.getState Annex.keysdbhandle
 		Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
 		return h
 
-{- Flushes any changes made to the database. -}
-flushDb :: Annex ()
-flushDb = withDbHandle H.flushQueueDb
+shutdown :: Annex ()
+shutdown = maybe noop go =<< Annex.getState Annex.keysdbhandle
+  where
+	go h = do
+		Annex.changeState $ \s -> s { Annex.keysdbhandle = Nothing }
+		liftIO $ closeDb h
 
 addAssociatedFile :: Key -> FilePath -> Annex ()
 addAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
@@ -113,21 +119,35 @@ getAssociatedFiles' sk = do
 	return $ map unValue l
 
 removeAssociatedFile :: Key -> FilePath -> Annex ()
-removeAssociatedFile k f =  withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+removeAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
 	delete $ from $ \r -> do
 		where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
   where
 	sk = toSKey k
 
-setInodeCache :: Key -> InodeCache -> Annex ()
-setInodeCache k i = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
-	void $ upsert (Data (toSKey k) (toSInodeCache i)) []
+{- Stats the files, and stores their InodeCaches. -}
+storeInodeCaches :: Key -> [FilePath] -> Annex ()
+storeInodeCaches k fs = withTSDelta $ \d ->
+	addInodeCaches k . catMaybes =<< liftIO (mapM (`genInodeCache` d) fs)
+
+addInodeCaches :: Key -> [InodeCache] -> Annex ()
+addInodeCaches k is = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+	forM_ is $ \i -> insertUnique $ Content (toSKey k) (toSInodeCache i)
 
-getInodeCache :: Key -> Annex (Maybe (InodeCache))
-getInodeCache k = withDbHandle $ \h -> H.queryDb h $ do
+{- A key may have multiple InodeCaches; one for the annex object, and one
+ - for each pointer file that is a copy of it. -}
+getInodeCaches :: Key -> Annex [InodeCache]
+getInodeCaches k = withDbHandle $ \h -> H.queryDb h $ do
 	l <- select $ from $ \r -> do
-		where_ (r ^. DataKey ==. val sk)
-		return (r ^. DataInodeCache)
-	return $ headMaybe $ map (fromSInodeCache . unValue) l
+		where_ (r ^. ContentKey ==. val sk)
+		return (r ^. ContentCache)
+	return $ map (fromSInodeCache . unValue) l
+  where
+	sk = toSKey k
+
+removeInodeCaches :: Key -> Annex ()
+removeInodeCaches k = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+	delete $ from $ \r -> do
+		where_ (r ^. ContentKey ==. val sk)
   where
 	sk = toSKey k