From 9c89924c059a644396020a3e8ee2c80f3e8aabfe Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Thu, 18 Oct 2012 16:05:43 -0400
Subject: [PATCH] check and drop after uploads

---
 Assistant/Drop.hs                          | 21 ++++++++++-----------
 Assistant/Threads/TransferScanner.hs       |  2 +-
 Assistant/Threads/TransferWatcher.hs       | 13 +++++++++----
 doc/design/assistant/transfer_control.mdwn |  2 +-
 4 files changed, 21 insertions(+), 17 deletions(-)

diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs
index dea5934eec..cf20ef5b1d 100644
--- a/Assistant/Drop.hs
+++ b/Assistant/Drop.hs
@@ -18,19 +18,18 @@ import Command
 import Annex.Wanted
 import Config
 
-{- Drop from syncable remotes when allowed by the preferred content and
- - numcopies settings. -}
-handleRemoteDrops :: DaemonStatusHandle -> Key -> AssociatedFile -> Annex ()
-handleRemoteDrops dstatus key (Just f) = do
-	syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
-	locs <- loggedLocations key
-	handleDrops locs syncrs False f key
-handleRemoteDrops _ _ _ = noop
-
 {- 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
+handleDrops :: DaemonStatusHandle -> Bool -> Key -> AssociatedFile -> Annex ()
+handleDrops _ _ _ Nothing = noop
+handleDrops dstatus fromhere key f = do
+	syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
+	locs <- loggedLocations key
+	handleDrops' locs syncrs fromhere key f
+
+handleDrops' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Annex ()
+handleDrops' _ _ _ _ Nothing = noop
+handleDrops' locs rs fromhere key (Just f)
 	| fromhere = do
 		n <- getcopies
 		if checkcopies n
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 4cd6915f52..631c36b022 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 key (Just f)
 
 			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 19009756bd..e82e4fb084 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -108,16 +108,21 @@ onDel st dstatus transferqueue file _ = case parseTransferFile file of
 {- 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. -}
+ - Downloading a file may have caused a remote to not want it;
+ - so drop it from the remote.
+ -
+ - Uploading a file may cause the local repo, or some other remote to not
+ - want it; handle that too.
+ -}
 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 
+			handleDrops dstatus False
 				(transferKey t) (associatedFile info)
 			queueTransfersMatching (/= transferUUID t)
 				Later transferqueue dstatus
 				(transferKey t) (associatedFile info) Upload
-	| otherwise = noop
+	| otherwise = runThreadState st $
+		handleDrops dstatus True (transferKey t) (associatedFile info)
 finishedTransfer _ _ _ _ _ = noop
diff --git a/doc/design/assistant/transfer_control.mdwn b/doc/design/assistant/transfer_control.mdwn
index d21081d345..129a2304d0 100644
--- a/doc/design/assistant/transfer_control.mdwn
+++ b/doc/design/assistant/transfer_control.mdwn
@@ -35,7 +35,7 @@ the same content, this gets tricky. Let's assume there are not.)
    again, and should cause it to be transferred in that case, which doesn't
    happen either..)
 3. we get a file (`in`, `copies`) **done**
-4. we sent a file to a remote (`in`, `copies`)
+4. we sent a file (`in`, `copies`) **done**
 5. 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