use TopFilePath for associated files

Fixes several bugs with updates of pointer files. When eg, running
git annex drop --from localremote
it was updating the pointer file in the local repository, not the remote.
Also, fixes drop ../foo when run in a subdir, and probably lots of other
problems. Test suite drops from ~30 to 11 failures now.

TopFilePath is used to force thinking about what the filepath is relative
to.

The data stored in the sqlite db is still just a plain string, and
TopFilePath is a newtype, so there's no overhead involved in using it in
DataBase.Keys.

Annex/AutoMerge.hs

@@ -24,6 +24,7 @@ import qualified Git.Ref
 import qualified Git
 import qualified Git.Branch
 import Git.Types (BlobType(..))
+import Git.FilePath
 import Config
 import Annex.ReplaceFile
 import Annex.VariantFile
@@ -188,7 +189,7 @@ resolveMerge' unstagedmap (Just us) them u = do
 					writeFile dest (formatPointer key)
 				_ -> noop
 		stagePointerFile dest =<< hashPointerFile key
-		Database.Keys.addAssociatedFile key dest
+		Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath dest)
 
 	{- Stage a graft of a directory or file from a branch.
 	 -

Annex/Content.hs

@@ -65,6 +65,7 @@ import Utility.DataUnits
 import Utility.CopyFile
 import Utility.Metered
 import Config
+import Git.FilePath
 import Git.SharedRepository
 import Annex.Perms
 import Annex.Link
@@ -471,7 +472,9 @@ moveAnnex key src = withObjectLoc key storeobject storedirect
 		, modifyContent dest $ do
 			freezeContent src
 			liftIO $ moveFile src dest
-			fs <- Database.Keys.getAssociatedFiles key
+			g <- Annex.gitRepo 
+			fs <- map (`fromTopFilePath` g)
+				<$> Database.Keys.getAssociatedFiles key
 			unless (null fs) $ do
 				mapM_ (populatePointerFile key dest) fs
 				Database.Keys.storeInodeCaches key (dest:fs)
@@ -722,7 +725,8 @@ removeAnnex (ContentRemovalLock key) = withObjectLoc key remove removedirect
 	remove file = cleanObjectLoc key $ do
 		secureErase file
 		liftIO $ nukeFile file
-		mapM_ (void . tryIO . resetpointer)
+		g <- Annex.gitRepo 
+		mapM_ (\f -> void $ tryIO $ resetpointer $ fromTopFilePath f g)
 			=<< Database.Keys.getAssociatedFiles key
 		Database.Keys.removeInodeCaches key
 		Direct.removeInodeCache key

Annex/Drop.hs

@@ -19,6 +19,7 @@ import Annex.Wanted
 import Config
 import Annex.Content.Direct
 import qualified Database.Keys
+import Git.FilePath
 
 import qualified Data.Set as S
 import System.Log.Logger (debugM)
@@ -49,7 +50,7 @@ handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile
 handleDropsFrom locs rs reason fromhere key afile preverified runner = do
 	l <- ifM isDirect
 		( associatedFilesRelative key
-		, Database.Keys.getAssociatedFiles key
+		, mapM getTopFilePath <$> Database.Keys.getAssociatedFiles key
 		)
 	let fs = if null l then maybeToList afile else l
 	n <- getcopies fs

Annex/Ingest.hs

@@ -37,6 +37,7 @@ import Utility.InodeCache
 import Annex.ReplaceFile
 import Utility.Tmp
 import Utility.CopyFile
+import Git.FilePath
 import Annex.InodeSentinal
 #ifdef WITH_CLIBS
 #ifndef __ANDROID__
@@ -186,15 +187,18 @@ finishIngestUnlocked key source = do
 
 finishIngestUnlocked' :: Key -> KeySource -> Annex ()
 finishIngestUnlocked' key source = do
-	Database.Keys.addAssociatedFile key (keyFilename source)
+	Database.Keys.addAssociatedFile key =<< inRepo (toTopFilePath (keyFilename source))
 	populateAssociatedFiles key source
 
 {- Copy to any other locations using the same key. -}
 populateAssociatedFiles :: Key -> KeySource -> Annex ()
 populateAssociatedFiles key source = do
-	otherfs <- filter (/= keyFilename source) <$> Database.Keys.getAssociatedFiles key
 	obj <- calcRepo (gitAnnexLocation key)
-	forM_ otherfs $
+	g <- Annex.gitRepo
+	ingestedf <- flip fromTopFilePath g
+		<$> inRepo (toTopFilePath (keyFilename source))
+	afs <- map (`fromTopFilePath` g) <$> Database.Keys.getAssociatedFiles key
+	forM_ (filter (/= ingestedf) afs) $
 		populatePointerFile key obj
 
 cleanCruft :: KeySource -> Annex ()
@@ -206,16 +210,18 @@ cleanCruft source = when (contentLocation source /= keyFilename source) $
 -- content. Clean up from that.
 cleanOldKeys :: FilePath -> Key -> Annex ()
 cleanOldKeys file newkey = do
+	g <- Annex.gitRepo
+	ingestedf <- flip fromTopFilePath g <$> inRepo (toTopFilePath file)
+	topf <- inRepo (toTopFilePath file)
 	oldkeys <- filter (/= newkey)
-		<$> Database.Keys.getAssociatedKey file
+		<$> Database.Keys.getAssociatedKey topf
-	mapM_ go oldkeys
+	forM_ oldkeys $ \key -> do
-  where
-	go key = do
 		obj <- calcRepo (gitAnnexLocation key)
 		caches <- Database.Keys.getInodeCaches key
 		unlessM (sameInodeCache obj caches) $ do
 			unlinkAnnex key
-			fs <- filter (/= file)
+			fs <- filter (/= ingestedf)
+				. map (`fromTopFilePath` g)
 				<$> Database.Keys.getAssociatedFiles key
 			fs' <- filterM (`sameInodeCache` caches) fs
 			case fs' of
@@ -225,9 +231,7 @@ cleanOldKeys file newkey = do
 				(f:_) -> do
 					ic <- withTSDelta (liftIO . genInodeCache f)
 					void $ linkToAnnex key f ic
-				_ -> lostcontent
+				_ -> logStatus key InfoMissing
-	  where
-		lostcontent = logStatus key InfoMissing
 
 {- On error, put the file back so it doesn't seem to have vanished.
  - This can be called before or after the symlink is in place. -}

Assistant/Threads/Watcher.hs

@@ -41,6 +41,7 @@ import Annex.ReplaceFile
 import Annex.Version
 import Annex.InodeSentinal
 import Git.Types
+import Git.FilePath
 import Config
 import Utility.ThreadScheduler
 import Logs.Location
@@ -225,8 +226,11 @@ shouldRestage :: DaemonStatus -> Bool
 shouldRestage ds = scanComplete ds || forceRestage ds
 
 onAddUnlocked :: Bool -> FileMatcher Annex -> Handler
-onAddUnlocked = onAddUnlocked' False contentchanged Database.Keys.addAssociatedFile samefilestatus
+onAddUnlocked = onAddUnlocked' False contentchanged addassociatedfile samefilestatus
   where
+	addassociatedfile key file = 
+		Database.Keys.addAssociatedFile key
+			=<< inRepo (toTopFilePath file)
 	samefilestatus key file status = do
 		cache <- Database.Keys.getInodeCaches key
 		curr <- withTSDelta $ \delta -> liftIO $ toInodeCache delta file status
@@ -235,7 +239,8 @@ onAddUnlocked = onAddUnlocked' False contentchanged Database.Keys.addAssociatedF
 			([], Nothing) -> return True
 			_ -> return False
 	contentchanged oldkey file = do
-		Database.Keys.removeAssociatedFile oldkey file
+		Database.Keys.removeAssociatedFile oldkey
+			=<< inRepo (toTopFilePath file)
 		unlessM (inAnnex oldkey) $
 			logStatus oldkey InfoMissing
 
@@ -356,8 +361,9 @@ onDel file _ = do
 
 onDel' :: FilePath -> Annex ()
 onDel' file = do
+	topfile <- inRepo (toTopFilePath file)
 	ifM versionSupportsUnlockedPointers
-		( withkey $ flip Database.Keys.removeAssociatedFile file
+		( withkey $ flip Database.Keys.removeAssociatedFile topfile
 		, whenM isDirect $
 			withkey $ \key -> void $ removeAssociatedFile key file
 		)

Command/Lock.hs

@@ -21,6 +21,7 @@ import Utility.InodeCache
 import qualified Database.Keys
 import Annex.Ingest
 import Logs.Location
+import Git.FilePath
 	
 cmd :: Command
 cmd = notDirect $ withGlobalOptions annexedMatchingOptions $
@@ -85,7 +86,9 @@ performNew file key filemodified = do
 	-- Try to repopulate obj from an unmodified associated file.
 	repopulate obj
 		| filemodified = modifyContent obj $ do
-			fs <- Database.Keys.getAssociatedFiles key
+			g <- Annex.gitRepo
+			fs <- mapM (`fromTopFilePath` g)
+				<$> Database.Keys.getAssociatedFiles key
 			mfile <- firstM (isUnmodified key) fs
 			liftIO $ nukeFile obj
 			case mfile of
@@ -99,7 +102,7 @@ performNew file key filemodified = do
 
 cleanupNew :: FilePath -> Key -> CommandCleanup
 cleanupNew file key = do
-	Database.Keys.removeAssociatedFile key file
+	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
 	return True
 
 startOld :: FilePath -> CommandStart

Command/Smudge.hs

@@ -15,6 +15,7 @@ import Annex.FileMatcher
 import Annex.Ingest
 import Logs.Location
 import qualified Database.Keys
+import Git.FilePath
 
 import qualified Data.ByteString.Lazy as B
 
@@ -58,7 +59,7 @@ smudge file = do
 						=<< catchMaybeIO (B.readFile content)
 				, liftIO $ B.putStr b
 				)
-			Database.Keys.addAssociatedFile k file
+			Database.Keys.addAssociatedFile k =<< inRepo (toTopFilePath file)
 	stop
 
 -- Clean filter is fed file content on stdin, decides if a file

Command/Unannex.hs

@@ -23,6 +23,7 @@ import qualified Git.DiffTree as DiffTree
 import Utility.CopyFile
 import Command.PreCommit (lockPreCommitHook)
 import qualified Database.Keys
+import Git.FilePath
 
 cmd :: Command
 cmd = withGlobalOptions annexedMatchingOptions $
@@ -87,7 +88,7 @@ performIndirect file key = do
 
 cleanupIndirect :: FilePath -> Key -> CommandCleanup
 cleanupIndirect file key = do
-	Database.Keys.removeAssociatedFile key file
+	Database.Keys.removeAssociatedFile key =<< inRepo (toTopFilePath file)
 	src <- calcRepo $ gitAnnexLocation key
 	ifM (Annex.getState Annex.fast)
 		( do

Database/Keys.hs

@@ -165,50 +165,50 @@ openDb createdb _ = withExclusiveLock gitAnnexKeysDbLock $ do
   where
 	open db = liftIO $ DbOpen <$> H.openDbQueue db "content"
 
-addAssociatedFile :: Key -> FilePath -> Annex ()
+addAssociatedFile :: Key -> TopFilePath -> Annex ()
 addAssociatedFile k f = runWriter $ addAssociatedFile' k f
 
-addAssociatedFile' :: Key -> FilePath -> Writer
+addAssociatedFile' :: Key -> TopFilePath -> Writer
 addAssociatedFile' k f = queueDb $ 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)
+		where_ (r ^. AssociatedFile ==. val (getTopFilePath f) &&. r ^. AssociatedKey ==. val sk)
-	void $ insertUnique $ Associated sk f
+	void $ insertUnique $ Associated sk (getTopFilePath f)
   where
 	sk = toSKey k
 
 {- Note that the files returned were once associated with the key, but
  - some of them may not be any longer. -}
-getAssociatedFiles :: Key -> Annex [FilePath]
+getAssociatedFiles :: Key -> Annex [TopFilePath]
 getAssociatedFiles = runReader . getAssociatedFiles' . toSKey
 
-getAssociatedFiles' :: SKey -> Reader [FilePath]
+getAssociatedFiles' :: SKey -> Reader [TopFilePath]
 getAssociatedFiles' sk = readDb $ do
 	l <- select $ from $ \r -> do
 		where_ (r ^. AssociatedKey ==. val sk)
 		return (r ^. AssociatedFile)
-	return $ map unValue l
+	return $ map (TopFilePath . 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 :: TopFilePath -> Annex [Key]
 getAssociatedKey = runReader . getAssociatedKey'
 
-getAssociatedKey' :: FilePath -> Reader [Key]
+getAssociatedKey' :: TopFilePath -> Reader [Key]
 getAssociatedKey' f = readDb $ do
 	l <- select $ from $ \r -> do
-		where_ (r ^. AssociatedFile ==. val f)
+		where_ (r ^. AssociatedFile ==. val (getTopFilePath f))
 		return (r ^. AssociatedKey)
 	return $ map (fromSKey . unValue) l
 
-removeAssociatedFile :: Key -> FilePath -> Annex ()
+removeAssociatedFile :: Key -> TopFilePath -> Annex ()
 removeAssociatedFile k = runWriter . removeAssociatedFile' (toSKey k)
 
-removeAssociatedFile' :: SKey -> FilePath -> Writer
+removeAssociatedFile' :: SKey -> TopFilePath -> Writer
 removeAssociatedFile' sk f = queueDb $ 
 	delete $ from $ \r -> do
-		where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val f)
+		where_ (r ^. AssociatedKey ==. val sk &&. r ^. AssociatedFile ==. val (getTopFilePath f))
 	
 {- Find all unlocked associated files. This is expensive, and so normally
  - the associated files are updated incrementally when changes are noticed. -}

Git/FilePath.hs

@@ -13,9 +13,8 @@
 {-# LANGUAGE CPP #-}
 
 module Git.FilePath (
-	TopFilePath,
+	TopFilePath(..),
 	fromTopFilePath,
-	getTopFilePath,
 	toTopFilePath,
 	asTopFilePath,
 	InternalGitPath,

Upgrade/V5.hs

@@ -20,6 +20,7 @@ import qualified Annex.Content.Direct as Direct
 import qualified Git
 import qualified Git.LsFiles
 import qualified Git.Branch
+import Git.FilePath
 import Git.FileMode
 import Git.Config
 import Utility.InodeCache
@@ -89,7 +90,8 @@ upgradeDirectWorkTree = do
 					, fromdirect f k
 					)
 				stagePointerFile f =<< hashPointerFile k
-				Database.Keys.addAssociatedFile k f
+				Database.Keys.addAssociatedFile k
+					=<< inRepo (toTopFilePath f)
 				return ()
 	go _ = noop