add buddy list to pairing UI

4 files changed, 49 insertions, 30 deletions

diff --git a/Assistant/Threads/PairListener.hs b/Assistant/Threads/PairListener.hs
index 90fce8777..cd297fad3 100644
--- a/Assistant/Threads/PairListener.hs
+++ b/Assistant/Threads/PairListener.hs
@@ -103,7 +103,7 @@ pairListenerThread urlrenderer = NamedThread "PairListener" $ do
 pairReqReceived :: Bool -> UrlRenderer -> PairMsg -> Assistant ()
 pairReqReceived True _ _ = noop -- ignore our own PairReq
 pairReqReceived False urlrenderer msg = do
-	url <- liftIO $ renderUrl urlrenderer (FinishPairR msg) []
+	url <- liftIO $ renderUrl urlrenderer (FinishLocalPairR msg) []
 	close <- asIO1 removeAlert
 	void $ addAlert $ pairRequestReceivedAlert repo
 		AlertButton
diff --git a/Assistant/Types/Buddies.hs b/Assistant/Types/Buddies.hs
index 06ac5526d..9c070aa6a 100644
--- a/Assistant/Types/Buddies.hs
+++ b/Assistant/Types/Buddies.hs
@@ -14,16 +14,37 @@ import Common.Annex
 import qualified Data.Map as M
 import Control.Concurrent.STM
 import Utility.NotificationBroadcaster
+import Data.Text as T
 
-{- When XMPP is enabled, this is an XMPP buddy map.
- - Otherwise, it's an empty map, for simplicity. -}
+{- For simplicity, dummy types are defined even when XMPP is disabled. -}
 #ifdef WITH_XMPP
-import Assistant.XMPP.Buddies
+import Network.Protocol.XMPP
+import Data.Set as S
+import Data.Ord
+
+newtype Client = Client JID
+	deriving (Eq, Show)
+
+instance Ord Client where
+	compare = comparing show
+
+data Buddy = Buddy
+	{ buddyPresent :: S.Set Client
+	, buddyAway :: S.Set Client
+	, buddyAssistants :: S.Set Client
+	}
 #else
-type Buddies = M.Map String Buddy
 data Buddy
-	deriving (Eq)
 #endif
+	deriving (Eq, Show)
+
+data BuddyID = BuddyID T.Text
+	deriving (Eq, Ord, Show, Read)
+
+data BuddyKey = BuddyKey T.Text
+	deriving (Eq, Ord, Show)
+
+type Buddies = M.Map BuddyKey Buddy
 
 {- A list of buddies, and a way to notify when it changes. -}
 type BuddyList = (TMVar Buddies, NotificationBroadcaster)
@@ -39,6 +60,9 @@ newBuddyList = (,)
 getBuddyList :: BuddyList -> IO [Buddy]
 getBuddyList (v, _) = M.elems <$> atomically (readTMVar v)
 
+getBuddyBroadcaster :: BuddyList -> NotificationBroadcaster
+getBuddyBroadcaster (_, h) = h
+
 {- Applies a function to modify the buddy list, and if it's changed,
  - sends notifications to any listeners. -}
 updateBuddyList :: (Buddies -> Buddies) -> BuddyList -> IO ()
@@ -50,8 +74,3 @@ updateBuddyList a (v, caster) = do
 		return $ buds /= buds'
 	when changed $
 		sendNotification caster
-
-{- Allocates a notification handle for a client to use to listen for
- - changes to the buddy list. -}
-newBuddyListNotificationHandle :: BuddyList -> IO NotificationHandle
-newBuddyListNotificationHandle (_, caster) = newNotificationHandle caster
diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs
index de2b570c6..db56235c7 100644
--- a/Assistant/XMPP/Buddies.hs
+++ b/Assistant/XMPP/Buddies.hs
@@ -9,32 +9,32 @@ module Assistant.XMPP.Buddies where
 
 import Assistant.XMPP
 import Common.Annex
+import Assistant.Types.Buddies
 
 import Network.Protocol.XMPP
 import qualified Data.Map as M
 import qualified Data.Set as S
-import Data.Ord
+import Data.Text (Text)
+import qualified Data.Text as T
 
-newtype Client = Client JID
-	deriving (Eq, Show)
+genBuddyID :: JID -> BuddyID
+genBuddyID j = BuddyID $ formatJID j
 
-instance Ord Client where
-	compare = comparing show
+genKey :: JID -> BuddyKey
+genKey j = BuddyKey $ formatJID $ JID (jidNode j) (jidDomain j) Nothing
 
-data Buddy = Buddy
-	{ buddyPresent :: S.Set Client
-	, buddyAway :: S.Set Client
-	, buddyAssistants :: S.Set Client
-	}
-	deriving (Eq, Show)
-
-{- Note that the buddy map includes one buddy for the user's own JID,
- - so that we can track other git-annex assistant's sharing the same
- - account. -}
-type Buddies = M.Map String Buddy
-
-genKey :: JID -> String
-genKey j = show $ JID (jidNode j) (jidDomain j) Nothing
+{- Summary of info about a buddy.
+ -
+ - If the buddy has no clients at all anymore, returns Nothing. -}
+buddySummary :: Buddy -> Maybe (Text, Bool, Bool, BuddyID)
+buddySummary b = case clients of
+	((Client j):_) -> Just (buddyname j, away, canpair, genBuddyID j)
+	[] -> Nothing
+  where
+	buddyname j = maybe (T.pack "") strNode (jidNode j)
+	away = S.null (buddyPresent b) && S.null (buddyAssistants b)
+	canpair = not $ S.null (buddyAssistants b)
+	clients = S.toList $ buddyPresent b `S.union` buddyAway b `S.union` buddyAssistants b
 
 {- Updates the buddies with XMPP presence info. -}
 updateBuddies :: Presence -> Buddies -> Buddies
diff --git a/doc/assistant/buddylist.png b/doc/assistant/buddylist.png
new file mode 100644
index 000000000..40b5a9238
--- /dev/null
+++ b/doc/assistant/buddylist.png