moved transfer queueing out of watcher and into committer

This cleaned up the code quite a bit; now the committer just looks at the
Change to see if it's a change that needs to have a transfer queued for it.
If I later want to add dropping keys for files that were removed, or
something like that, this should make it straightforward.

This also fixes a bug. In direct mode, moving a file out of an archive
directory failed to start a transfer to get its content. The problem
was that the file had not been committed to git yet, and so the transfer
code didn't want to touch it, since fileKey failed to get its key.
Only starting transfers after a commit avoids this problem.

4 files changed, 49 insertions, 42 deletions

diff --git a/Assistant/Changes.hs b/Assistant/Changes.hs
index 3d3956899..9114f5124 100644
--- a/Assistant/Changes.hs
+++ b/Assistant/Changes.hs
@@ -14,7 +14,7 @@ import Utility.TSet
 import Data.Time.Clock
 
 {- Handlers call this when they made a change that needs to get committed. -}
-madeChange :: FilePath -> ChangeType -> Assistant (Maybe Change)
+madeChange :: FilePath -> ChangeInfo -> Assistant (Maybe Change)
 madeChange f t = Just <$> (Change <$> liftIO getCurrentTime <*> pure f <*> pure t)
 
 noChange :: Assistant (Maybe Change)
diff --git a/Assistant/Threads/Committer.hs b/Assistant/Threads/Committer.hs
index 5887f5e43..1d2c5b63d 100644
--- a/Assistant/Threads/Committer.hs
+++ b/Assistant/Threads/Committer.hs
@@ -16,6 +16,7 @@ import Assistant.Commits
 import Assistant.Alert
 import Assistant.DaemonStatus
 import Assistant.TransferQueue
+import Assistant.Drop
 import Logs.Transfer
 import Logs.Location
 import qualified Annex.Queue
@@ -64,6 +65,7 @@ commitThread = namedThread "Committer" $ do
 						void $ alertWhile commitAlert $
 							liftAnnex commitStaged
 						recordCommit
+						mapM_ checkChangeContent readychanges
 					else refill readychanges
 			else refill changes
   where
@@ -196,7 +198,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 					key <- liftAnnex $ do
 						showStart "add" $ keyFilename ks
 						Command.Add.ingest $ Just ks
-					done (finishedChange change) (keyFilename ks) key
+					maybe failedingest (done change $ keyFilename ks) key
 	  where
 		{- Add errors tend to be transient and will be automatically
 		 - dealt with, so don't pass to the alert code. -}
@@ -204,10 +206,11 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 		ret _ = (True, Nothing)
 	add _ = return Nothing
 
-	done _ _ Nothing = do
+	failedingest = do
 		liftAnnex showEndFail
 		return Nothing
-	done change file (Just key) = do
+
+	done change file key = do
 		liftAnnex $ do
 			logStatus key InfoPresent
 			link <- ifM isDirect
@@ -217,8 +220,7 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 			whenM (pure DirWatcher.eventsCoalesce <||> isDirect) $ do
 				stageSymlink file =<< hashSymlink link
 				showEndOk
-		queueTransfers "newly added file" Next key (Just file) Upload
-		return $ Just change
+		return $ Just $ finishedChange change key
 
 	{- Check that the keysource's keyFilename still exists,
 	 - and is still a hard link to its contentLocation,
@@ -299,3 +301,22 @@ safeToAdd delayadd pending inprocess = do
 			tmpdir <- fromRepo gitAnnexTmpDir
 			liftIO $ Lsof.queryDir tmpdir
 		)
+
+{- After a Change is committed, queue any necessary transfers or drops
+ - of the content of the key.
+ -
+ - This is not done during the startup scan, because the expensive
+ - transfer scan does the same thing then.
+ -}
+checkChangeContent :: Change -> Assistant ()
+checkChangeContent (Change { changeInfo = i , changeFile = f }) =
+	case changeInfoKey i of
+		Nothing -> noop
+		Just k -> whenM (scanComplete <$> getDaemonStatus) $ do
+			present <- liftAnnex $ inAnnex k
+			if present
+				then queueTransfers "new file created" Next k (Just f) Upload
+				else queueTransfers "new or renamed file wanted" Next k (Just f) Download
+			handleDrops "file renamed" present k (Just f) Nothing
+checkChangeContent _ = noop
+
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 38c5c138f..ce308b3a3 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -20,10 +20,7 @@ import Assistant.Common
 import Assistant.DaemonStatus
 import Assistant.Changes
 import Assistant.Types.Changes
-import Assistant.TransferQueue
 import Assistant.Alert
-import Assistant.Drop
-import Logs.Transfer
 import Utility.DirWatcher
 import Utility.Types.DirWatcher
 import Utility.Lsof
@@ -178,6 +175,7 @@ onAdd file filestatus
  - really been modified. -}
 onAddDirect :: Handler
 onAddDirect file fs = do
+	debug ["add direct", file]
 	v <- liftAnnex $ catKeyFile file
 	case (v, fs) of
 		(Just key, Just filestatus) ->
@@ -201,20 +199,16 @@ onAddSymlink isdirect file filestatus = go =<< liftAnnex (Backend.lookupFile fil
 			liftAnnex $ void $ addAssociatedFile key file
 		link <- liftAnnex $ calcGitLink file key
 		ifM ((==) (Just link) <$> liftIO (catchMaybeIO $ readSymbolicLink file))
-			( do
-				s <- getDaemonStatus
-				checkcontent key s
-				ensurestaged (Just link) s
+			( ensurestaged (Just link) (Just key) =<< getDaemonStatus
 			, do
 				unless isdirect $ do
 					liftIO $ removeFile file
 					liftAnnex $ Backend.makeAnnexLink link file
-				checkcontent key =<< getDaemonStatus
-				addlink link
+				addlink link (Just key)
 			)
 	go Nothing = do -- other symlink
 		mlink <- liftIO (catchMaybeIO $ readSymbolicLink file)
-		ensurestaged mlink =<< getDaemonStatus
+		ensurestaged mlink Nothing =<< getDaemonStatus
 
 	{- This is often called on symlinks that are already
 	 - staged correctly. A symlink may have been deleted
@@ -227,16 +221,16 @@ onAddSymlink isdirect file filestatus = go =<< liftAnnex (Backend.lookupFile fil
 	 - (If the daemon has never ran before, avoid staging
 	 - links too.)
 	 -}
-	ensurestaged (Just link) daemonstatus
-		| scanComplete daemonstatus = addlink link
+	ensurestaged (Just link) mk daemonstatus
+		| scanComplete daemonstatus = addlink link mk
 		| otherwise = case filestatus of
 			Just s
 				| not (afterLastDaemonRun (statusChangeTime s) daemonstatus) -> noChange
-			_ -> addlink link
-	ensurestaged Nothing _ = noChange
+			_ -> addlink link mk
+	ensurestaged Nothing _ _ = noChange
 
 	{- For speed, tries to reuse the existing blob for symlink target. -}
-	addlink link = do
+	addlink link mk = do
 		debug ["add symlink", file]
 		liftAnnex $ do
 			v <- catObjectDetails $ Ref $ ':':file
@@ -245,20 +239,7 @@ onAddSymlink isdirect file filestatus = go =<< liftAnnex (Backend.lookupFile fil
 					| s2w8 link == L.unpack currlink ->
 						stageSymlink file sha
 				_ -> stageSymlink file =<< hashSymlink link
-		madeChange file LinkChange
-
-	{- When a new link appears, or a link is changed, after the startup
-	 - scan, handle getting or dropping the key's content.
-	 - Also, moving or copying a link may caused it be be transferred
-	 - elsewhere, so check that too. -}
-	checkcontent key daemonstatus
-		| scanComplete daemonstatus = do
-			present <- liftAnnex $ inAnnex key
-			if present
-				then queueTransfers "new file created" Next key (Just file) Upload
-				else queueTransfers "new or renamed file wanted" Next key (Just file) Download
-			handleDrops "file renamed" present key (Just file) Nothing
-		| otherwise = noop
+		madeChange file $ LinkChange mk
 
 onDel :: Handler
 onDel file _ = do
diff --git a/Assistant/Types/Changes.hs b/Assistant/Types/Changes.hs
index 887aa819e..d4e1b28bc 100644
--- a/Assistant/Types/Changes.hs
+++ b/Assistant/Types/Changes.hs
@@ -8,20 +8,26 @@
 module Assistant.Types.Changes where
 
 import Types.KeySource
+import Types.Key
 import Utility.TSet
 
 import Data.Time.Clock
 
-data ChangeType = AddChange | LinkChange | RmChange | RmDirChange
+data ChangeInfo = AddChange Key | LinkChange (Maybe Key) | RmChange | RmDirChange
 	deriving (Show, Eq)
 
+changeInfoKey :: ChangeInfo -> Maybe Key
+changeInfoKey (AddChange k) = Just k
+changeInfoKey (LinkChange (Just k)) = Just k
+changeInfoKey _ = Nothing
+
 type ChangeChan = TSet Change
 
 data Change
 	= Change 
 		{ changeTime :: UTCTime
 		, changeFile :: FilePath
-		, changeType :: ChangeType
+		, changeInfo :: ChangeInfo
 		}
 	| PendingAddChange
 		{ changeTime ::UTCTime
@@ -44,11 +50,10 @@ isInProcessAddChange :: Change -> Bool
 isInProcessAddChange (InProcessAddChange {}) = True
 isInProcessAddChange _ = False
 
-finishedChange :: Change -> Change
-finishedChange c@(InProcessAddChange { keySource = ks }) = Change
+finishedChange :: Change -> Key -> Change
+finishedChange c@(InProcessAddChange { keySource = ks }) k = Change
 	{ changeTime = changeTime c
 	, changeFile = keyFilename ks
-	, changeType = AddChange
+	, changeInfo = AddChange k
 	}
-finishedChange c = c
-
+finishedChange c _ = c