summaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-12-09 17:00:37 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-12-09 17:00:37 -0400
commit76ccac53916d308aa4806d38bb8cfb6a9d1f9081 (patch)
tree10f7618585df73c335c459f9562b04f37a7eb03f /Database
parentb5c8ba7db3ea2eb4f1cd28e49cadb5fd348ca738 (diff)
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.
Diffstat (limited to 'Database')
-rw-r--r--Database/Keys.hs (renamed from Database/AssociatedFiles.hs)66
-rw-r--r--Database/Keys/Types.hs (renamed from Database/AssociatedFiles/Types.hs)4
-rw-r--r--Database/Types.hs15
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"