add inode cache to the db

Renamed the db to keys, since it is various info about a Keys.

Dropping a key will update its pointer files, as long as their content can
be verified to be unmodified. This falls back to checksum verification, but
I want it to use an InodeCache of the key, for speed. But, I have not made
anything populate that cache yet.

3 files changed, 60 insertions, 25 deletions

diff --git a/Database/AssociatedFiles.hs b/Database/Keys.hs
index d17eb8112..092c0d900 100644
--- a/Database/AssociatedFiles.hs
+++ b/Database/Keys.hs
@@ -1,4 +1,4 @@
-{- Sqlite database used for tracking a key's associated files.
+{- Sqlite database of information about Keys
  -
  - Copyright 2015 Joey Hess <id@joeyh.name>
  -:
@@ -10,19 +10,22 @@
 {-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RankNTypes #-}
 
-module Database.AssociatedFiles (
+module Database.Keys (
 	DbHandle,
 	openDb,
 	flushDb,
 	closeDb,
-	addDb,
-	getDb,
-	removeDb,
+	addAssociatedFile,
+	getAssociatedFiles,
+	removeAssociatedFile,
+	setInodeCache,
+	getInodeCache,
 	AssociatedId,
+	DataId,
 ) where
 
 import Database.Types
-import Database.AssociatedFiles.Types
+import Database.Keys.Types
 import qualified Database.Handle as H
 import Locations
 import Common hiding (delete)
@@ -31,30 +34,35 @@ import Types.Key
 import Annex.Perms
 import Annex.LockFile
 import Messages
+import Utility.InodeCache
 
 import Database.Persist.TH
 import Database.Esqueleto hiding (Key)
 
-share [mkPersist sqlSettings, mkMigrate "migrateAssociated"] [persistLowerCase|
+share [mkPersist sqlSettings, mkMigrate "migrateKeysDb"] [persistLowerCase|
 Associated
   key SKey
   file FilePath
   KeyFileIndex key file
+Data
+  key SKey
+  inodeCache SInodeCache
+  KeyIndex key
 |]
 
 {- Opens the database, creating it if it doesn't exist yet. -}
 openDb :: Annex DbHandle
-openDb = withExclusiveLock gitAnnexAssociatedFilesDbLock $ do
-	dbdir <- fromRepo gitAnnexAssociatedFilesDb
+openDb = withExclusiveLock gitAnnexKeysDbLock $ do
+	dbdir <- fromRepo gitAnnexKeysDb
 	let db = dbdir </> "db"
 	unlessM (liftIO $ doesFileExist db) $ do
 		liftIO $ do
 			createDirectoryIfMissing True dbdir
 			H.initDb db $ void $
-				runMigrationSilent migrateAssociated
+				runMigrationSilent migrateKeysDb
 		setAnnexDirPerm dbdir
 		setAnnexFilePerm db
-	h <- liftIO $ H.openDb db "associated"
+	h <- liftIO $ H.openDb db "data"
 
 	-- work around https://github.com/yesodweb/persistent/issues/474
 	liftIO setConsoleEncoding
@@ -70,19 +78,19 @@ withDbHandle a = do
 	liftIO $ a h
 
 dbHandle :: Annex DbHandle
-dbHandle = maybe startup return =<< Annex.getState Annex.associatedfilesdbhandle
+dbHandle = maybe startup return =<< Annex.getState Annex.keysdbhandle
   where
 	startup = do
 		h <- openDb
-		Annex.changeState $ \s -> s { Annex.associatedfilesdbhandle = Just h }
+		Annex.changeState $ \s -> s { Annex.keysdbhandle = Just h }
 		return h
 
 {- Flushes any changes made to the database. -}
 flushDb :: Annex ()
 flushDb = withDbHandle H.flushQueueDb
 
-addDb :: Key -> FilePath -> Annex ()
-addDb k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
+addAssociatedFile :: Key -> FilePath -> Annex ()
+addAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
 	-- If the same file was associated with a different key before,
 	-- remove that.
 	delete $ from $ \r -> do
@@ -91,21 +99,35 @@ addDb k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $ do
   where
 	sk = toSKey k
 
-{- Note that the files returned used to be associated with the key, but
+{- Note that the files returned were once associated with the key, but
  - some of them may not be any longer. -}
-getDb :: Key -> Annex [FilePath]
-getDb k = withDbHandle $ \h -> H.queryDb h $ getDb' $ toSKey k
+getAssociatedFiles :: Key -> Annex [FilePath]
+getAssociatedFiles k = withDbHandle $ \h -> H.queryDb h $
+	getAssociatedFiles' $ toSKey k
 
-getDb' :: SKey -> SqlPersistM [FilePath]
-getDb' sk = do
+getAssociatedFiles' :: SKey -> SqlPersistM [FilePath]
+getAssociatedFiles' sk = do
 	l <- select $ from $ \r -> do
 		where_ (r ^. AssociatedKey ==. val sk)
 		return (r ^. AssociatedFile)
 	return $ map unValue l
 
-removeDb :: Key -> FilePath -> Annex ()
-removeDb k f =  withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
+removeAssociatedFile :: Key -> FilePath -> Annex ()
+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)) []
+
+getInodeCache :: Key -> Annex (Maybe (InodeCache))
+getInodeCache 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
+	sk = toSKey k
diff --git a/Database/AssociatedFiles/Types.hs b/Database/Keys/Types.hs
index 8c32dcf22..a627b3ca5 100644
--- a/Database/AssociatedFiles/Types.hs
+++ b/Database/Keys/Types.hs
@@ -1,11 +1,11 @@
-{- Sqlite database used for tracking a key's associated files, data types.
+{- Sqlite database of information about Keys, data types.
  -
  - Copyright 2015 Joey Hess <id@joeyh.name>
  -:
  - Licensed under the GNU GPL version 3 or higher.
  -}
 
-module Database.AssociatedFiles.Types (
+module Database.Keys.Types (
 	DbHandle(..)
 ) where
 
diff --git a/Database/Types.hs b/Database/Types.hs
index dee56832b..1476a693a 100644
--- a/Database/Types.hs
+++ b/Database/Types.hs
@@ -13,6 +13,7 @@ import Database.Persist.TH
 import Data.Maybe
 
 import Types.Key
+import Utility.InodeCache
 
 -- A serialized Key
 newtype SKey = SKey String
@@ -22,6 +23,18 @@ toSKey :: Key -> SKey
 toSKey = SKey . key2file
 
 fromSKey :: SKey -> Key
-fromSKey (SKey s) = fromMaybe (error $ "bad serialied key " ++ s) (file2key s)
+fromSKey (SKey s) = fromMaybe (error $ "bad serialied Key " ++ s) (file2key s)
 
 derivePersistField "SKey"
+
+-- A serialized InodeCache
+newtype SInodeCache = I String
+	deriving (Show, Read)
+
+toSInodeCache :: InodeCache -> SInodeCache
+toSInodeCache = I . showInodeCache
+
+fromSInodeCache :: SInodeCache -> InodeCache
+fromSInodeCache (I s) = fromMaybe (error $ "bad serialied InodeCache " ++ s) (readInodeCache s)
+
+derivePersistField "SInodeCache"