summaryrefslogtreecommitdiff
path: root/Database
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-12-07 13:42:03 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-12-07 14:35:37 -0400
commitd71bdba6009d522db726121b17980a3d32919f74 (patch)
tree7ba7471e865781f8dd0e67b217b9e6fb20de634d /Database
parent386b62174bcf97b3c319e786130da8ce617dff23 (diff)
associated files database
Diffstat (limited to 'Database')
-rw-r--r--Database/AssociatedFiles.hs94
-rw-r--r--Database/Fsck.hs2
2 files changed, 95 insertions, 1 deletions
diff --git a/Database/AssociatedFiles.hs b/Database/AssociatedFiles.hs
new file mode 100644
index 000000000..8244f15e8
--- /dev/null
+++ b/Database/AssociatedFiles.hs
@@ -0,0 +1,94 @@
+{- Sqlite database used for tracking a key's associated files.
+ -
+ - Copyright 2015 Joey Hess <id@joeyh.name>
+ -:
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+{-# LANGUAGE QuasiQuotes, TypeFamilies, TemplateHaskell #-}
+{-# LANGUAGE OverloadedStrings, GADTs, FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Database.AssociatedFiles (
+ DbHandle,
+ openDb,
+ closeDb,
+ addDb,
+ getDb,
+ removeDb,
+ AssociatedId,
+) where
+
+import Database.Types
+import qualified Database.Handle as H
+import Locations
+import Common hiding (delete)
+import Annex
+import Types.Key
+import Annex.Perms
+import Annex.LockFile
+import Messages
+
+import Database.Persist.TH
+import Database.Esqueleto hiding (Key)
+
+newtype DbHandle = DbHandle H.DbHandle
+
+share [mkPersist sqlSettings, mkMigrate "migrateAssociated"] [persistLowerCase|
+Associated
+ key SKey
+ file FilePath
+ KeyFileIndex key file
+|]
+
+{- Opens the database, creating it if it doesn't exist yet. -}
+openDb :: Annex DbHandle
+openDb = withExclusiveLock gitAnnexAssociatedFilesDbLock $ do
+ dbdir <- fromRepo gitAnnexAssociatedFilesDb
+ let db = dbdir </> "db"
+ unlessM (liftIO $ doesFileExist db) $ do
+ liftIO $ do
+ createDirectoryIfMissing True dbdir
+ H.initDb db $ void $
+ runMigrationSilent migrateAssociated
+ setAnnexDirPerm dbdir
+ setAnnexFilePerm db
+ h <- liftIO $ H.openDb db "associated"
+
+ -- work around https://github.com/yesodweb/persistent/issues/474
+ liftIO setConsoleEncoding
+
+ return $ DbHandle h
+
+closeDb :: DbHandle -> IO ()
+closeDb (DbHandle h) = H.closeDb h
+
+addDb :: DbHandle -> Key -> FilePath -> IO ()
+addDb (DbHandle h) k f = H.queueDb h (\_ _ -> pure True) $ do
+ -- If the same file was associated with a different key before,
+ -- remove that.
+ delete $ from $ \r -> do
+ where_ (r ^. AssociatedFile ==. val f &&. r ^. AssociatedKey ==. val sk)
+ void $ insertUnique $ Associated sk f
+ where
+ sk = toSKey k
+
+{- Note that the files returned used to be associated with the key, but
+ - some of them may not be any longer. -}
+getDb :: DbHandle -> Key -> IO [FilePath]
+getDb (DbHandle h) = H.queryDb h . getDb' . toSKey
+
+getDb' :: SKey -> SqlPersistM [FilePath]
+getDb' sk = do
+ l <- select $ from $ \r -> do
+ where_ (r ^. AssociatedKey ==. val sk)
+ return (r ^. AssociatedFile)
+ return $ map unValue l
+
+removeDb :: DbHandle -> Key -> FilePath -> IO ()
+removeDb (DbHandle h) k f = H.queueDb h (\_ _ -> pure True) $
+ delete $ from $ \r -> do
+ where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
+ where
+ sk = toSKey k
diff --git a/Database/Fsck.hs b/Database/Fsck.hs
index ed00e62d8..b0e56f6c0 100644
--- a/Database/Fsck.hs
+++ b/Database/Fsck.hs
@@ -59,7 +59,7 @@ newPass u = isJust <$> tryExclusiveLock (gitAnnexFsckDbLock u) go
go = liftIO . void . tryIO . removeDirectoryRecursive
=<< fromRepo (gitAnnexFsckDbDir u)
-{- Opens the database, creating it atomically if it doesn't exist yet. -}
+{- Opens the database, creating it if it doesn't exist yet. -}
openDb :: UUID -> Annex FsckHandle
openDb u = do
dbdir <- fromRepo (gitAnnexFsckDbDir u)