cleaned up AnnexState handling in transports

1 files changed, 15 insertions, 18 deletions

diff --git a/RemoteDaemon/Transport/Ssh.hs b/RemoteDaemon/Transport/Ssh.hs
index 8f4d007e8..557a3dce9 100644
--- a/RemoteDaemon/Transport/Ssh.hs
+++ b/RemoteDaemon/Transport/Ssh.hs
@@ -8,13 +8,11 @@
 module RemoteDaemon.Transport.Ssh (transport) where
 
 import Common.Annex
-import qualified Annex
 import RemoteDaemon.Types
-import qualified RemoteDaemon.Transport.Ssh.Types as SshRemote
+import RemoteDaemon.Common
 import Remote.Helper.Ssh
+import qualified RemoteDaemon.Transport.Ssh.Types as SshRemote
 import Utility.SimpleProtocol
-import qualified Git
-import Annex.CatFile
 import Git.Command
 
 import Control.Concurrent.Chan
@@ -22,13 +20,12 @@ import Control.Concurrent.Async
 import System.Process (std_in, std_out)
 
 transport :: Transport
-transport r remotename annexstate ichan ochan = Annex.eval annexstate $ do
-	v <- git_annex_shell r "notifychanges" [] []
+transport r remotename transporthandle ichan ochan = do
+	v <- liftAnnex transporthandle $ git_annex_shell r "notifychanges" [] []
 	case v of
 		Nothing -> noop
-		Just (cmd, params) -> liftIO $ go cmd (toCommand params)
+		Just (cmd, params) -> go cmd (toCommand params)
   where
-	send msg = writeChan ochan (msg remotename)
 	go cmd params = do
 		(Just toh, Just fromh, _, pid) <- createProcess (proc cmd params)
 			{ std_in = CreatePipe
@@ -45,9 +42,9 @@ transport r remotename annexstate ichan ochan = Annex.eval annexstate $ do
 			l <- hGetLine fromh
 			case parseMessage l of
 				Just SshRemote.READY -> send CONNECTED
-				Just (SshRemote.CHANGED refs) ->
-					Annex.eval annexstate $
-						fetchNew remotename refs
+				Just (SshRemote.CHANGED shas) ->
+					whenM (checkNewShas transporthandle shas) $
+						fetch
 				Nothing -> shutdown
 
 		-- The only control message that matters is STOP.
@@ -66,10 +63,10 @@ transport r remotename annexstate ichan ochan = Annex.eval annexstate $ do
 		void $ tryIO $ concurrently fromshell handlecontrol
 		shutdown
 
--- Check if any of the shas are actally new, to avoid unnecessary fetching.
-fetchNew :: RemoteName -> [Git.Sha] -> Annex ()
-fetchNew remotename = check
-  where
-	check [] = void $ inRepo $ runBool [Param "fetch", Param remotename]
-	check (r:rs) = maybe (check rs) (const noop)
-		=<< catObjectDetails r
+	send msg = writeChan ochan (msg remotename)
+
+	fetch = do
+		send SYNCING
+		ok <- inLocalRepo transporthandle $
+			runBool [Param "fetch", Param remotename]
+		send (DONESYNCING ok)