check and drop unwanted content from remotes after receiving a transfer

3 files changed, 32 insertions, 20 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