summaryrefslogtreecommitdiff
path: root/Database/Keys.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-12-09 17:47:05 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-12-09 17:54:54 -0400
commitd2d501503d9aa19787466129394141c794bb84e6 (patch)
tree3a0e3982e420ec42e2d90672628c4d63c7f78eff /Database/Keys.hs
parent76ccac53916d308aa4806d38bb8cfb6a9d1f9081 (diff)
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.
Diffstat (limited to 'Database/Keys.hs')
-rw-r--r--Database/Keys.hs60
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