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.
This commit is contained in:
parent
3311c48631
commit
5e8c628d2e
9 changed files with 117 additions and 53 deletions
|
@ -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
|
|
@ -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
|
||||
|
|
@ -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"
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue