aboutsummaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
Diffstat (limited to 'Database')
-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