diff options
Diffstat (limited to 'Database/Keys.hs')
-rw-r--r-- | Database/Keys.hs | 60 |
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 |