add Database.ContentIdentifier
Does not yet have a way to update with new information from the git-annex branch, which will be needed when multiple repos are importing from the same remote.
This commit is contained in:
parent
ccc0684d21
commit
a818bc5e73
6 changed files with 132 additions and 3 deletions
89
Database/ContentIdentifier.hs
Normal file
89
Database/ContentIdentifier.hs
Normal file
|
@ -0,0 +1,89 @@
|
|||
{- Sqlite database of ContentIdentifiers imported from special remotes.
|
||||
-
|
||||
- This contains a mapping from ContentIdentifier to Key.
|
||||
- The reverse mapping from Key to ContentIdentifier is stored in the
|
||||
- git-annex branch, see Logs.ContentIdentifier.
|
||||
-
|
||||
- Copyright 2019 Joey Hess <id@joeyh.name>
|
||||
-:
|
||||
- Licensed under the GNU AGPL version 3 or higher.
|
||||
-}
|
||||
|
||||
{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
|
||||
{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
|
||||
module Database.ContentIdentifier (
|
||||
ContentIdentifierHandle,
|
||||
openDb,
|
||||
closeDb,
|
||||
flushDbQueue,
|
||||
recordContentIdentifier,
|
||||
getContentIdentifierKeys,
|
||||
ContentIdentifiersId,
|
||||
) where
|
||||
|
||||
import Database.Types
|
||||
import qualified Database.Queue as H
|
||||
import Database.Init
|
||||
import Annex.Locations
|
||||
import Annex.Common hiding (delete)
|
||||
import Types.Remote (ContentIdentifier(..))
|
||||
|
||||
import Database.Persist.Sql hiding (Key)
|
||||
import Database.Persist.TH
|
||||
|
||||
data ContentIdentifierHandle = ContentIdentifierHandle H.DbQueue
|
||||
|
||||
share [mkPersist sqlSettings, mkMigrate "migrateContentIdentifier"] [persistLowerCase|
|
||||
ContentIdentifiers
|
||||
remote UUID
|
||||
cid ContentIdentifier
|
||||
key SKey
|
||||
ContentIdentifiersIndex remote cid
|
||||
UniqueRemoteCidKey remote cid key
|
||||
|]
|
||||
|
||||
{- Opens the database, creating it if it doesn't exist yet.
|
||||
-
|
||||
- Only a single process should write to the database at a time, so guard
|
||||
- any writes with the gitAnnexContentIdentifierLock.
|
||||
-}
|
||||
openDb :: Annex ContentIdentifierHandle
|
||||
openDb = do
|
||||
dbdir <- fromRepo gitAnnexContentIdentifierDbDir
|
||||
let db = dbdir </> "db"
|
||||
unlessM (liftIO $ doesFileExist db) $ do
|
||||
initDb db $ void $
|
||||
runMigrationSilent migrateContentIdentifier
|
||||
h <- liftIO $ H.openDbQueue H.SingleWriter db "contentidentifiers"
|
||||
return $ ContentIdentifierHandle h
|
||||
|
||||
closeDb :: ContentIdentifierHandle -> Annex ()
|
||||
closeDb (ContentIdentifierHandle h) = liftIO $ H.closeDbQueue h
|
||||
|
||||
queueDb :: ContentIdentifierHandle -> SqlPersistM () -> IO ()
|
||||
queueDb (ContentIdentifierHandle h) = H.queueDb h checkcommit
|
||||
where
|
||||
-- commit queue after 1000 changes
|
||||
checkcommit sz _lastcommittime
|
||||
| sz > 1000 = return True
|
||||
| otherwise = return False
|
||||
|
||||
flushDbQueue :: ContentIdentifierHandle -> IO ()
|
||||
flushDbQueue (ContentIdentifierHandle h) = H.flushDbQueue h
|
||||
|
||||
-- Be sure to also update the git-annex branch when using this.
|
||||
recordContentIdentifier :: ContentIdentifierHandle -> UUID -> ContentIdentifier -> Key -> IO ()
|
||||
recordContentIdentifier h u cid k = queueDb h $ do
|
||||
void $ insertUnique $ ContentIdentifiers u cid (toSKey k)
|
||||
|
||||
getContentIdentifierKeys :: ContentIdentifierHandle -> UUID -> ContentIdentifier -> IO [Key]
|
||||
getContentIdentifierKeys (ContentIdentifierHandle h) u cid =
|
||||
H.queryDbQueue h $ do
|
||||
l <- selectList
|
||||
[ ContentIdentifiersCid ==. cid
|
||||
, ContentIdentifiersRemote ==. u
|
||||
] []
|
||||
return $ map (fromSKey . contentIdentifiersKey . entityVal) l
|
Loading…
Add table
Add a link
Reference in a new issue