From dcaa93dd5aff1be6e085f689672c2ec35d5f49f1 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Fri, 9 Nov 2012 14:34:06 -0400
Subject: add canpush xmpp command

---
 Assistant/XMPP/Git.hs | 31 ++++++++++++++++---------------
 1 file changed, 16 insertions(+), 15 deletions(-)

(limited to 'Assistant/XMPP/Git.hs')

diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
index 624791597..49adadcfd 100644
--- a/Assistant/XMPP/Git.hs
+++ b/Assistant/XMPP/Git.hs
@@ -34,9 +34,6 @@ import System.Process (std_in, std_out, std_err)
 import Control.Concurrent
 import qualified Data.ByteString as B
 
-configKey :: UnqualifiedConfigKey
-configKey = "xmppaddress"
-
 finishXMPPPairing :: JID -> UUID -> Assistant ()
 finishXMPPPairing jid u = void $ alertWhile alert $
 	makeXMPPGitRemote buddy (baseJID jid) u
@@ -47,10 +44,7 @@ finishXMPPPairing jid u = void $ alertWhile alert $
 makeXMPPGitRemote :: String -> JID -> UUID -> Assistant Bool
 makeXMPPGitRemote buddyname jid u = do
 	remote <- liftAnnex $ addRemote $ makeGitRemote buddyname xmppaddress
-	liftAnnex $ do
-		let r = Remote.repo remote
-		storeUUID (remoteConfig r "uuid") u
-		setConfig (remoteConfig r configKey) xmppaddress
+	liftAnnex $ storeUUID (remoteConfig (Remote.repo remote) "uuid") u
 	syncNewRemote remote
 	return True
   where
@@ -221,22 +215,29 @@ xmppRemotes cid = case baseJID <$> parseJID cid of
 		let want = T.unpack $ formatJID jid
 		liftAnnex $ filterM (matching want) rs
   where
-	matching want r = do
-		v <- getRemoteConfig (Remote.repo r) configKey ""
-		return $ v == want
+	matching want remote = do
+		let r = Remote.repo remote
+		return $ repoIsUrl r && repoLocation r == "xmpp::" ++ want
 
 handleDeferred :: NetMessage -> Assistant ()
-handleDeferred = void . handlePush
+handleDeferred = void . handlePushMessage
 
-handlePush :: NetMessage -> Assistant Bool
-handlePush (PushRequest cid) = do
+handlePushMessage :: NetMessage -> Assistant Bool
+handlePushMessage (CanPush cid) = do
+	rs <- xmppRemotes cid
+	if null rs
+		then return False
+		else do
+			sendNetMessage $ PushRequest cid
+			return True
+handlePushMessage (PushRequest cid) = do
 	rs <- xmppRemotes cid
 	current <- liftAnnex $ inRepo Git.Branch.current
 	let refs = catMaybes [current, Just Annex.Branch.fullname]
 	any id <$> (forM rs $ \r -> xmppPush cid r refs)
-handlePush (StartingPush cid) = do
+handlePushMessage (StartingPush cid) = do
 	rs <- xmppRemotes cid
 	if null rs
 		then return False
 		else xmppReceivePack cid
-handlePush _ = return False
+handlePushMessage _ = return False
-- 
cgit v1.2.3