moved code out of webapp

No code changes, aside from some changes to lifting in code that turned out
to be able to run in Assistant rather than Handler.

3 files changed, 5 insertions, 134 deletions

diff --git a/Assistant/Threads/TransferWatcher.hs b/Assistant/Threads/TransferWatcher.hs
index 9bc851d4e..fc09373e7 100644
--- a/Assistant/Threads/TransferWatcher.hs
+++ b/Assistant/Threads/TransferWatcher.hs
@@ -9,9 +9,7 @@ module Assistant.Threads.TransferWatcher where
 
 import Assistant.Common
 import Assistant.DaemonStatus
-import Assistant.TransferQueue
-import Assistant.Drop
-import Annex.Content
+import Assistant.TransferSlots
 import Logs.Transfer
 import Utility.DirWatcher
 import Utility.DirWatcher.Types
@@ -98,28 +96,3 @@ onDel file = case parseTransferFile file of
 			 - runs. -}
 			threadDelay 10000000 -- 10 seconds
 			finished t minfo
-
-{- 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 check for drops from remotes.
- -
- - Uploading a file may cause the local repo, or some other remote to not
- - want it; handle that too.
- -}
-finishedTransfer :: Transfer -> Maybe TransferInfo -> Assistant ()
-finishedTransfer t (Just info)
-	| transferDirection t == Download =
-		whenM (liftAnnex $ inAnnex $ transferKey t) $ do
-			dodrops False
-			queueTransfersMatching (/= transferUUID t)
-				"newly received object"
-				Later (transferKey t) (associatedFile info) Upload
-	| otherwise = dodrops True
-  where
-	dodrops fromhere = handleDrops
-		("drop wanted after " ++ describeTransfer t info)
-		fromhere (transferKey t) (associatedFile info) Nothing
-finishedTransfer _ _ = noop
-
diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 98f8b6ad7..82f3f3e10 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -36,105 +36,3 @@ transfererThread = namedThread "Transferrer" $ do
   where
 	{- Skip transfers that are already running. -}
 	notrunning = isNothing . startedTime
-
-{- By the time this is called, the daemonstatus's currentTransfers map should
- - already have been updated to include the transfer. -}
-genTransfer :: Transfer -> TransferInfo -> TransferGenerator
-genTransfer t info = case (transferRemote info, associatedFile info) of
-	(Just remote, Just file) 
-		| Git.repoIsLocalUnknown (Remote.repo remote) -> do
-			-- optimisation for removable drives not plugged in
-			liftAnnex $ recordFailedTransfer t info
-			void $ removeTransfer t
-			return Nothing
-		| otherwise -> ifM (liftAnnex $ shouldTransfer t info)
-			( do
-				debug [ "Transferring:" , describeTransfer t info ]
-				notifyTransfer
-				return $ Just (t, info, go remote file)
-			, do
-				debug [ "Skipping unnecessary transfer:",
-					describeTransfer t info ]
-				void $ removeTransfer t
-				finishedTransfer t (Just info)
-				return Nothing
-			)
-	_ -> return Nothing
-  where
-	direction = transferDirection t
-	isdownload = direction == Download
-
-	{- Alerts are only shown for successful transfers.
-	 - Transfers can temporarily fail for many reasons,
-	 - 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
-	 - branch out to remotes that did not participate
-	 - in the transfer.
-	 -
-	 - If the process failed, it could have crashed,
-	 - so remove the transfer from the list of current
-	 - transfers, just in case it didn't stop
-	 - in a way that lets the TransferWatcher do its
-	 - usual cleanup. However, first check if something else is
-	 - running the transfer, to avoid removing active transfers.
-	 -}
-	go remote file transferrer = ifM (liftIO $ performTransfer transferrer t $ associatedFile info)
-		( do
-			void $ addAlert $ makeAlertFiller True $
-				transferFileAlert direction True file
-			unless isdownload $
-				handleDrops
-					("object uploaded to " ++ show remote)
-					True (transferKey t)
-					(associatedFile info)
-					(Just remote)
-			void recordCommit
-		, whenM (liftAnnex $ isNothing <$> checkTransfer t) $
-			void $ removeTransfer t
-		)
-
-{- Called right before a transfer begins, this is a last chance to avoid
- - unnecessary transfers.
- -
- - For downloads, we obviously don't need to download if the already
- - have the object.
- -
- - Smilarly, for uploads, check if the remote is known to already have
- - the object.
- -
- - Also, uploads get queued to all remotes, in order of cost.
- - This may mean, for example, that an object is uploaded over the LAN
- - to a locally paired client, and once that upload is done, a more
- - expensive transfer remote no longer wants the object. (Since
- - all the clients have it already.) So do one last check if this is still
- - preferred content.
- -
- - We'll also do one last preferred content check for downloads. An
- - example of a case where this could be needed is if a download is queued
- - for a file that gets moved out of an archive directory -- but before
- - that download can happen, the file is put back in the archive.
- -}
-shouldTransfer :: Transfer -> TransferInfo -> Annex Bool
-shouldTransfer t info
-	| transferDirection t == Download =
-		(not <$> inAnnex key) <&&> wantGet True file
-	| transferDirection t == Upload = case transferRemote info of
-		Nothing -> return False
-		Just r -> notinremote r
-			<&&> wantSend True file (Remote.uuid r)
-	| otherwise = return False
-  where
-	key = transferKey t
-	file = associatedFile info
-
-	{- Trust the location log to check if the remote already has
-	 - the key. This avoids a roundtrip to the remote. -}
-	notinremote r = notElem (Remote.uuid r) <$> loggedLocations key
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index a44664639..3eedbe145 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -9,7 +9,7 @@
 
 module Assistant.Threads.Watcher (
 	watchThread,
-	WatcherException(..),
+	WatcherControl(..),
 	checkCanWatch,
 	needLsof,
 	onAddSymlink,
@@ -64,10 +64,10 @@ needLsof = error $ unlines
 	]
 
 {- A special exception that can be thrown to pause or resume the watcher. -}
-data WatcherException = PauseWatcher | ResumeWatcher
+data WatcherControl = PauseWatcher | ResumeWatcher
         deriving (Show, Eq, Typeable)
 
-instance E.Exception WatcherException
+instance E.Exception WatcherControl
 
 watchThread :: NamedThread
 watchThread = namedThread "Watcher" $
@@ -107,7 +107,7 @@ runWatcher = do
   where
 	hook a = Just <$> asIO2 (runHandler a)
 
-waitFor :: WatcherException -> Assistant () -> Assistant ()
+waitFor :: WatcherControl -> Assistant () -> Assistant ()
 waitFor sig next = do
 	r <- liftIO (E.try pause :: IO (Either E.SomeException ()))
 	case r of