tag xmpp pushes with jid

This fixes the issue mentioned in the last commit.

Turns out just collecting UUID of clients behind a XMPP remote is
insufficient (although I should probably still do it for other reasons),
because a single remote repo might be connected via both XMPP and local
pairing. So a way is needed to know when a push was received from any
client using a given XMPP remote over XMPP, as opposed to via ssh.

2 files changed, 26 insertions, 23 deletions

diff --git a/Assistant/Threads/Merger.hs b/Assistant/Threads/Merger.hs
index d88cf00bd..4a482583f 100644
--- a/Assistant/Threads/Merger.hs
+++ b/Assistant/Threads/Merger.hs
@@ -22,6 +22,7 @@ import Annex.TaggedPush
 import Remote (remoteFromUUID)
 
 import qualified Data.Set as S
+import qualified Data.Text as T
 
 {- This thread watches for changes to .git/refs/, and handles incoming
  - pushes. -}
@@ -89,21 +90,21 @@ onAdd file
 			void $ liftAnnex  $ Command.Sync.mergeFrom changedbranch
 	mergecurrent _ = noop
 
-	handleDesynced = case branchTaggedBy changedbranch of
+	handleDesynced = case fromTaggedBranch changedbranch of
 		Nothing -> return False
-		Just u -> do
-			s <- desynced <$> getDaemonStatus				
-			if S.member u s
-				then do
-					modifyDaemonStatus_ $ \st -> st
-						{ desynced = S.delete u s }
-					mr <- liftAnnex $ remoteFromUUID u
-					case mr of
-						Just r -> do
+		Just (u, info) -> do
+			mr <- liftAnnex $ remoteFromUUID u
+			case mr of
+				Nothing -> return False
+				Just r -> do
+					s <- desynced <$> getDaemonStatus
+					if S.member u s || Just (T.unpack $ getXMPPClientID r) == info
+						then do
+							modifyDaemonStatus_ $ \st -> st
+								{ desynced = S.delete u s }
 							addScanRemotes True [r]
 							return True
-						Nothing -> return False
-				else return False
+						else return False
 
 equivBranches :: Git.Ref -> Git.Ref -> Bool
 equivBranches x y = base x == base y
diff --git a/Assistant/Threads/XMPPClient.hs b/Assistant/Threads/XMPPClient.hs
index ebface796..688d0121b 100644
--- a/Assistant/Threads/XMPPClient.hs
+++ b/Assistant/Threads/XMPPClient.hs
@@ -38,18 +38,20 @@ xmppClientThread urlrenderer = namedThread "XMPPClient" $
 	restartableClient . xmppClient urlrenderer =<< getAssistant id
 
 {- Runs the client, handing restart events. -}
-restartableClient :: IO () -> Assistant ()
-restartableClient a = forever $ do
-	tid <- liftIO $ forkIO a
-	waitNetMessagerRestart
-	liftIO $ killThread tid
+restartableClient :: (XMPPCreds -> IO ()) -> Assistant ()
+restartableClient a = forever $ go =<< liftAnnex getXMPPCreds
+  where
+	go Nothing = waitNetMessagerRestart
+	go (Just creds) = do
+		modifyDaemonStatus_ $ \s -> s
+			{ xmppClientID = Just $ xmppJID creds }
+		tid <- liftIO $ forkIO $ a creds
+		waitNetMessagerRestart
+		liftIO $ killThread tid
 
-xmppClient :: UrlRenderer -> AssistantData -> IO ()
-xmppClient urlrenderer d = do
-	v <- liftAssistant $ liftAnnex getXMPPCreds
-	case v of
-		Nothing -> noop -- will be restarted once creds get configured
-		Just c -> retry (runclient c) =<< getCurrentTime
+xmppClient :: UrlRenderer -> AssistantData -> XMPPCreds -> IO ()
+xmppClient urlrenderer d creds =
+	retry (runclient creds) =<< getCurrentTime
   where
 	liftAssistant = runAssistant d
 	inAssistant = liftIO . liftAssistant