add getAssociatedKey

I guess this is just as efficient as the getAssociatedFiles query, but I
have not tried to optimise the database yet.

1 files changed, 14 insertions, 0 deletions

diff --git a/Database/Keys.hs b/Database/Keys.hs
index 78d583d63..62c7c25eb 100644
--- a/Database/Keys.hs
+++ b/Database/Keys.hs
@@ -17,6 +17,7 @@ module Database.Keys (
 	shutdown,
 	addAssociatedFile,
 	getAssociatedFiles,
+	getAssociatedKey,
 	removeAssociatedFile,
 	storeInodeCaches,
 	addInodeCaches,
@@ -118,6 +119,19 @@ getAssociatedFiles' sk = do
 		return (r ^. AssociatedFile)
 	return $ map unValue l
 
+{- Gets any keys that are on record as having a particular associated file.
+ - (Should be one or none but the database doesn't enforce that.) -}
+getAssociatedKey :: FilePath -> Annex [Key]
+getAssociatedKey f = withDbHandle $ \h -> H.queryDb h $
+	getAssociatedKey' f
+
+getAssociatedKey' :: FilePath -> SqlPersistM [Key]
+getAssociatedKey' f = do
+	l <- select $ from $ \r -> do
+		where_ (r ^. AssociatedFile ==. val f)
+		return (r ^. AssociatedKey)
+	return $ map (fromSKey . unValue) l
+
 removeAssociatedFile :: Key -> FilePath -> Annex ()
 removeAssociatedFile k f = withDbHandle $ \h -> H.queueDb h (\_ _ -> pure True) $
 	delete $ from $ \r -> do