From a4667e3e8cb7fae50b0c2cb8bc1a46df0b289b6c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 5 Nov 2012 17:43:17 -0400
Subject: finished XMPP pairing!

This includes keeping track of which buddies we're pairing with, to know
which PairAck are legitimate.
---
 Assistant/XMPP/Buddies.hs |  9 +++++----
 Assistant/XMPP/Git.hs     | 49 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 54 insertions(+), 4 deletions(-)
 create mode 100644 Assistant/XMPP/Git.hs

(limited to 'Assistant/XMPP')

diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs
index fe5d8c6a9..fdc307972 100644
--- a/Assistant/XMPP/Buddies.hs
+++ b/Assistant/XMPP/Buddies.hs
@@ -17,8 +17,8 @@ import qualified Data.Set as S
 import Data.Text (Text)
 import qualified Data.Text as T
 
-genKey :: JID -> BuddyKey
-genKey j = BuddyKey $ formatJID $ baseJID j
+genBuddyKey :: JID -> BuddyKey
+genBuddyKey j = BuddyKey $ formatJID $ baseJID j
 
 buddyName :: JID -> Text
 buddyName j = maybe (T.pack "") strNode (jidNode j)
@@ -28,7 +28,7 @@ buddyName j = maybe (T.pack "") strNode (jidNode j)
  - If the buddy has no clients at all anymore, returns Nothing. -}
 buddySummary :: Buddy -> Maybe (Text, Bool, Bool, BuddyKey)
 buddySummary b = case clients of
-	((Client j):_) -> Just (buddyName j, away, canpair, genKey j)
+	((Client j):_) -> Just (buddyName j, away, canpair, genBuddyKey j)
 	[] -> Nothing
   where
 	away = S.null (buddyPresent b) && S.null (buddyAssistants b)
@@ -39,7 +39,7 @@ buddySummary b = case clients of
 updateBuddies :: Presence -> Buddies -> Buddies
 updateBuddies p@(Presence { presenceFrom = Just jid }) = M.alter update key
   where
-	key = genKey jid
+	key = genBuddyKey jid
 	update (Just b) = Just $ applyPresence p b
 	update Nothing = newBuddy p
 updateBuddies _ = id
@@ -56,6 +56,7 @@ newBuddy p
 		{ buddyPresent = S.empty
 		, buddyAway = S.empty
 		, buddyAssistants = S.empty
+		, buddyPairing = False
 		}
 
 applyPresence :: Presence -> Buddy -> Buddy
diff --git a/Assistant/XMPP/Git.hs b/Assistant/XMPP/Git.hs
new file mode 100644
index 000000000..154cbc86d
--- /dev/null
+++ b/Assistant/XMPP/Git.hs
@@ -0,0 +1,49 @@
+{- git over XMPP
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.XMPP.Git where
+
+import Assistant.Common
+import Assistant.XMPP
+import Assistant.XMPP.Buddies
+import Assistant.DaemonStatus
+import Assistant.Alert
+import Assistant.MakeRemote
+import Assistant.Sync
+import Annex.UUID
+import Config
+import qualified Types.Remote as Remote
+
+import Network.Protocol.XMPP
+import qualified Data.Text as T
+
+finishXMPPPairing :: JID -> UUID -> Assistant ()
+finishXMPPPairing jid u = void $ alertWhile alert $
+	makeXMPPGitRemote buddy (baseJID jid) u
+  where
+	buddy = T.unpack $ buddyName jid
+	alert = pairRequestAcknowledgedAlert buddy Nothing
+
+{- A git remote for an XMPP user? This is represented as a git remote
+ - that has no location set. The user's XMPP address is stored in the
+ - xmppaddress setting.
+ -
+ - The UUID of their remote is also stored as usual.
+ -}
+makeXMPPGitRemote :: String -> JID -> UUID -> Assistant Bool
+makeXMPPGitRemote buddyname jid u = do
+	remote <- liftAnnex $ addRemote $ makeGitRemote buddyname "" -- no location
+	liftAnnex $ do
+		let r = Remote.repo remote
+		storeUUID (remoteConfig r "uuid") u
+		setConfig (remoteConfig r "xmppaddress") xmppaddress
+	syncNewRemote remote
+	return True
+  where
+	xmppaddress = T.unpack $ formatJID $ baseJID jid
+
+
-- 
cgit v1.2.3