diff options
| -rw-r--r-- | Assistant/NetMessager.hs | 12 | ||||
| -rw-r--r-- | Assistant/Sync.hs | 10 | ||||
| -rw-r--r-- | Assistant/XMPP/Buddies.hs | 7 |
3 files changed, 16 insertions, 13 deletions
diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs index 5a2746cc7..c3bd73c57 100644 --- a/Assistant/NetMessager.hs +++ b/Assistant/NetMessager.hs @@ -9,12 +9,15 @@ module Assistant.NetMessager where import Assistant.Common import Assistant.Types.NetMessager +import qualified Types.Remote as Remote +import qualified Git import Control.Concurrent import Control.Concurrent.STM import Control.Concurrent.MSampleVar import Control.Exception as E import qualified Data.Set as S +import qualified Data.Text as T sendNetMessage :: NetMessage -> Assistant () sendNetMessage m = @@ -93,3 +96,12 @@ queueNetPushMessage m = do waitNetPushMessage :: Assistant (NetMessage) waitNetPushMessage = (atomically . readTChan) <<~ (netMessagesPush . netMessager) + +{- Remotes using the XMPP transport have urls like xmpp::user@host -} +isXMPPRemote :: Remote -> Bool +isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r + where + r = Remote.repo remote + +getXMPPClientID :: Remote -> ClientID +getXMPPClientID r = T.pack $ drop (length "xmpp::") (Git.repoLocation (Remote.repo r)) diff --git a/Assistant/Sync.hs b/Assistant/Sync.hs index 8815f40c8..ae2b5ea36 100644 --- a/Assistant/Sync.hs +++ b/Assistant/Sync.hs @@ -27,7 +27,6 @@ import Annex.UUID import Data.Time.Clock import qualified Data.Map as M -import qualified Data.Text as T import Control.Concurrent {- Syncs with remotes that may have been disconnected for a while. @@ -176,12 +175,3 @@ syncNewRemote remote = do thread <- asIO $ do reconnectRemotes False [remote] void $ liftIO $ forkIO $ thread - -{- Remotes using the XMPP transport have urls like xmpp::user@host -} -isXMPPRemote :: Remote -> Bool -isXMPPRemote remote = Git.repoIsUrl r && "xmpp::" `isPrefixOf` Git.repoLocation r - where - r = Remote.repo remote - -getXMPPClientID :: Remote -> ClientID -getXMPPClientID r = T.pack $ drop (length "xmpp::") (Git.repoLocation (Remote.repo r)) diff --git a/Assistant/XMPP/Buddies.hs b/Assistant/XMPP/Buddies.hs index fdc307972..7383c38d9 100644 --- a/Assistant/XMPP/Buddies.hs +++ b/Assistant/XMPP/Buddies.hs @@ -26,14 +26,15 @@ buddyName j = maybe (T.pack "") strNode (jidNode j) {- Summary of info about a buddy. - - 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, genBuddyKey j) +buddySummary :: [JID] -> Buddy -> Maybe (Text, Bool, Bool, Bool, BuddyKey) +buddySummary pairedwith b = case clients of + ((Client j):_) -> Just (buddyName j, away, canpair, alreadypaired j, genBuddyKey j) [] -> Nothing where 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 + alreadypaired j = baseJID j `elem` pairedwith {- Updates the buddies with XMPP presence info. -} updateBuddies :: Presence -> Buddies -> Buddies |