check and drop unwanted content from remotes after receiving a transfer

4 files changed, 33 insertions, 28 deletions

diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs
index b3dca3929..dea5934ee 100644
--- a/Assistant/Drop.hs
+++ b/Assistant/Drop.hs
@@ -8,24 +8,30 @@
 module Assistant.Drop where
 
 import Assistant.Common
+import Assistant.DaemonStatus
 import Logs.Location
 import Logs.Trust
+import Types.Remote (AssociatedFile)
 import qualified Remote
 import qualified Command.Drop
 import Command
 import Annex.Wanted
 import Config
 
-{- Drop from local or remote when allowed by the preferred content and
+{- Drop from syncable remotes when allowed by the preferred content and
  - numcopies settings. -}
-handleDrops :: [Remote] -> Bool -> FilePath -> Key -> Annex ()
-handleDrops rs present f key = do
+handleRemoteDrops :: DaemonStatusHandle -> Key -> AssociatedFile -> Annex ()
+handleRemoteDrops dstatus key (Just f) = do
+	syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
 	locs <- loggedLocations key
-	handleDrops' locs rs present f key
+	handleDrops locs syncrs False f key
+handleRemoteDrops _ _ _ = noop
 
-handleDrops' :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex ()
-handleDrops' locs rs present f key
-	| present = do
+{- Drop from local and/or remote when allowed by the preferred content and
+ - numcopies settings. -}
+handleDrops :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex ()
+handleDrops locs rs fromhere f key
+	| fromhere = do
 		n <- getcopies
 		if checkcopies n
 			then go rs =<< dropl n
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 5eb3784bd..4cd6915f5 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -125,7 +125,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
 			syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
 			present <- inAnnex key
 
-			handleDrops' locs syncrs present f key
+			handleDrops locs syncrs present f key
 
 			let slocs = S.fromList locs
 			let use a = return $ catMaybes $ map (a key slocs) syncrs
diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index a54128cb6..19009756b 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -11,6 +11,7 @@ import Assistant.Common
 import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
+import Assistant.Drop
 import Annex.Content
 import Logs.Transfer
 import Utility.DirWatcher
@@ -102,16 +103,21 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of
 			, show t
 			]
 		minfo <- removeTransfer dstatus t
+		finishedTransfer st dstatus transferqueue t minfo
 
-		{- Queue uploads of files we successfully downloaded,
-		 - spreading them out to other reachable remotes. -}
-		case (minfo, transferDirection t) of
-			(Just info, Download) -> runThreadState st $
-				whenM (inAnnex $ transferKey t) $
-					queueTransfersMatching 
-						(/= transferUUID t)
-						Later transferqueue dstatus
-						(transferKey t)
-						(associatedFile info)
-						Upload
-			_ -> noop
+{- Queue uploads of files we successfully downloaded, spreading them
+ - out to other reachable remotes.
+ -
+ - Also, downloading a file may have caused a remote to not want it,
+ - so drop it from the remote. -}
+finishedTransfer :: ThreadState -> DaemonStatusHandle -> TransferQueue -> Transfer -> Maybe TransferInfo -> IO ()
+finishedTransfer st dstatus transferqueue t (Just info)
+	| transferDirection t == Download = runThreadState st $
+		whenM (inAnnex $ transferKey t) $ do
+			handleRemoteDrops dstatus 
+				(transferKey t) (associatedFile info)
+			queueTransfersMatching (/= transferUUID t)
+				Later transferqueue dstatus
+				(transferKey t) (associatedFile info) Upload
+	| otherwise = noop
+finishedTransfer _ _ _ _ _ = noop
diff --git a/doc/design/assistant/transfer_control.mdwn b/doc/design/assistant/transfer_control.mdwn
index 390812320..6e66f6cfe 100644
--- a/doc/design/assistant/transfer_control.mdwn
+++ b/doc/design/assistant/transfer_control.mdwn
@@ -32,7 +32,7 @@ the same content, this gets tricky. Let's assume there are not.)
    with this is an expensive scan. (The rest of the items below come from
    analizing the terminals used in preferred content expressions.) **done**
 2. renaming of a file (ie, moved to `archive/`)
-3. we get a file (`in`, `copies`)
+3. we get a file (`in`, `copies`) **done**
 4. some other repository drops the file (`in`, `copies` .. However, it's
    unlikely that an expression would prefer content when *more* copies
    exisited, and want to drop it when less do. That's nearly a pathological
@@ -41,13 +41,6 @@ the same content, this gets tricky. Let's assume there are not.)
 
 That's all! Of these, 1, 2 and 3 are by far the most important.
 
-Rename handling should certianly check 2. 
-
-One place to check for 3 is after transferring a file; but that does not
-cover all its cases, as some other repo could transfer the file. To fully
-handle 3, need to either use a full scan, or examine location log history
-when receiving a git-annex branch push.
-
 ## specifying what data a remote prefers to contain **done**
 
 Imagine a per-remote preferred content setting, that matches things that