webapp and assistant glacier support

6 files changed, 26 insertions, 18 deletions

diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs
index 66e738a6f..4551f49ba 100644
--- a/Assistant/Drop.hs
+++ b/Assistant/Drop.hs
@@ -19,18 +19,19 @@ import Annex.Wanted
 import Config
 
 {- Drop from local and/or remote when allowed by the preferred content and
- - numcopies settings. -}
-handleDrops :: Bool -> Key -> AssociatedFile -> Assistant ()
-handleDrops _ _ Nothing = noop
-handleDrops fromhere key f = do
+ - numcopies settings. If it's known to be present on a particular remote,
+ -  -}
+handleDrops :: Bool -> Key -> AssociatedFile -> Maybe Remote -> Assistant ()
+handleDrops _ _ Nothing _ = noop
+handleDrops fromhere key f knownpresentremote = do
 	syncrs <- syncDataRemotes <$> getDaemonStatus
 	liftAnnex $ do
 		locs <- loggedLocations key
-		handleDrops' locs syncrs fromhere key f
+		handleDrops' locs syncrs fromhere key f knownpresentremote
 
-handleDrops' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Annex ()
-handleDrops' _ _ _ _ Nothing = noop
-handleDrops' locs rs fromhere key (Just f)
+handleDrops' :: [UUID] -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
+handleDrops' _ _ _ _ Nothing _ = noop
+handleDrops' locs rs fromhere key (Just f) knownpresentremote
 	| fromhere = do
 		n <- getcopies
 		if checkcopies n
@@ -59,7 +60,7 @@ handleDrops' locs rs fromhere key (Just f)
 		)
 
 	dropl n = checkdrop n Nothing $ \numcopies ->
-		Command.Drop.startLocal f numcopies key
+		Command.Drop.startLocal f numcopies key knownpresentremote
 
 	dropr r n  = checkdrop n (Just $ Remote.uuid r) $ \numcopies ->
 		Command.Drop.startRemote f numcopies key r
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 918a266c7..6cbb5cc89 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/Assistant/Threads/TransferScanner.hs
@@ -119,7 +119,7 @@ expensiveScan rs = unless onlyweb $ do
 			locs <- loggedLocations key
 			present <- inAnnex key
 
-			handleDrops' locs syncrs present key (Just f)
+			handleDrops' locs syncrs present key (Just f) Nothing
 
 			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 7deafb14d..6f040ba91 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -102,11 +102,11 @@ onDel file = case parseTransferFile file of
 			threadDelay 10000000 -- 10 seconds
 			finished t minfo
 
-{- Queue uploads of files we successfully downloaded, spreading them
+{- Queue uploads of files downloaded to us, spreading them
  - out to other reachable remotes.
  -
  - Downloading a file may have caused a remote to not want it;
- - so drop it from the remote.
+ - so check for drops from remotes.
  -
  - Uploading a file may cause the local repo, or some other remote to not
  - want it; handle that too.
@@ -115,9 +115,9 @@ finishedTransfer :: Transfer -> Maybe TransferInfo -> Assistant ()
 finishedTransfer t (Just info)
 	| transferDirection t == Download =
 		whenM (liftAnnex $ inAnnex $ transferKey t) $ do
-			handleDrops False (transferKey t) (associatedFile info)
+			handleDrops False (transferKey t) (associatedFile info) Nothing
 			queueTransfersMatching (/= transferUUID t) Later
 				(transferKey t) (associatedFile info) Upload
-	| otherwise = handleDrops True (transferKey t) (associatedFile info)
+	| otherwise = handleDrops True (transferKey t) (associatedFile info) Nothing
 finishedTransfer _ _ = noop
 
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 1d23487fa..5c7056568 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -13,6 +13,7 @@ import Assistant.TransferQueue
 import Assistant.TransferSlots
 import Assistant.Alert
 import Assistant.Commits
+import Assistant.Drop
 import Logs.Transfer
 import Logs.Location
 import Annex.Content
@@ -65,6 +66,10 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
 		 - so there's no point in bothering the user about
 		 - those. The assistant should recover.
 		 -
+		 - After a successful upload, handle dropping it from
+		 - here, if desired. In this case, the remote it was
+		 - uploaded to is known to have it.
+		 -
 		 - Also, after a successful transfer, the location
 		 - log has changed. Indicate that a commit has been
 		 - made, in order to queue a push of the git-annex
@@ -74,6 +79,10 @@ startTransfer program t info = case (transferRemote info, associatedFile info) o
 		whenM (liftIO $ (==) ExitSuccess <$> waitForProcess pid) $ do
 			void $ addAlert $ makeAlertFiller True $
 				transferFileAlert direction True file
+			unless isdownload $
+				handleDrops True (transferKey t)
+					(associatedFile info)
+					(Just remote)
 			recordCommit
 	  where
 		params =
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index e56e47aea..f7e4e2df2 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -187,7 +187,7 @@ onAddSymlink file filestatus = go =<< liftAnnex (Backend.lookupFile file)
 			if present
 				then queueTransfers Next key (Just file) Upload
 				else queueTransfers Next key (Just file) Download
-			handleDrops present key (Just file)
+			handleDrops present key (Just file) Nothing
 		| otherwise = noop
 
 onDel :: Handler
diff --git a/Assistant/Threads/WebApp.hs b/Assistant/Threads/WebApp.hs
index 9108c9307..cbe0e4aac 100644
--- a/Assistant/Threads/WebApp.hs
+++ b/Assistant/Threads/WebApp.hs
@@ -21,9 +21,7 @@ import Assistant.WebApp.Configurators.Edit
 import Assistant.WebApp.Configurators.Local
 import Assistant.WebApp.Configurators.Ssh
 import Assistant.WebApp.Configurators.Pairing
-#ifdef WITH_S3
-import Assistant.WebApp.Configurators.S3
-#endif
+import Assistant.WebApp.Configurators.AWS
 #ifdef WITH_WEBDAV
 import Assistant.WebApp.Configurators.WebDAV
 #endif