mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

show when a buddy is already paired

Browse source
This commit is contained in:
Joey Hess 2012-11-10 16:35:09 -04:00
parent d303190979
commit fd22734392
5 changed files with 30 additions and 20 deletions
Download patch file Download diff file Expand all files Collapse all files

12
Assistant/NetMessager.hs
View file

@ -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))