diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-10-28 17:07:29 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-10-28 17:07:29 -0400 |
| commit | b64f43388c7b2c69ec0e930553363d6a419d2f45 (patch) | |
| tree | a443cd05e1e14e8a79760d0ae2f035f90e190e33 /Assistant | |
| parent | cb5d8cea0c8b36a87954625add50477a74b06fe4 (diff) | |
send git-annex tag in initial presence
Will be used for finding other git-annex clients for pairing
Diffstat (limited to 'Assistant')
| -rw-r--r-- | Assistant/Threads/PushNotifier.hs | 6 | ||||
| -rw-r--r-- | Assistant/XMPP.hs | 15 |
2 files changed, 13 insertions, 8 deletions
diff --git a/Assistant/Threads/PushNotifier.hs b/Assistant/Threads/PushNotifier.hs index f6058b465..dc7099e3d 100644 --- a/Assistant/Threads/PushNotifier.hs +++ b/Assistant/Threads/PushNotifier.hs @@ -46,6 +46,7 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $ void $ connectXMPP c $ \jid -> do fulljid <- bindJID jid liftIO $ debug thisThread ["XMPP connected", show fulljid] + putStanza $ gitAnnexPresence gitAnnexSignature s <- getSession _ <- liftIO $ forkIO $ void $ runXMPP s $ receivenotifications @@ -62,10 +63,7 @@ pushNotifierThread st dstatus pushnotifier = NamedThread thisThread $ sendnotifications = forever $ do us <- liftIO $ waitPush pushnotifier - let payload = [extendedAway, encodePushNotification us] - let notification = (emptyPresence PresenceAvailable) - { presencePayloads = payload } - putStanza notification + putStanza $ gitAnnexPresence $ encodePushNotification us receivenotifications = forever $ do s <- getStanza diff --git a/Assistant/XMPP.hs b/Assistant/XMPP.hs index 2e38189ea..e599e2072 100644 --- a/Assistant/XMPP.hs +++ b/Assistant/XMPP.hs @@ -84,16 +84,23 @@ xmppCredsFile = do dir <- fromRepo gitAnnexCredsDir return $ dir </> "notify-xmpp" -{- Marks the client as extended away. -} -extendedAway :: Element -extendedAway = Element (Name (T.pack "show") Nothing Nothing) [] - [NodeContent $ ContentText $ T.pack "xa"] +{- A presence with a git-annex tag in it. -} +gitAnnexPresence :: Element -> Presence +gitAnnexPresence tag = (emptyPresence PresenceAvailable) + { presencePayloads = [extendedAway, tag] } + where + extendedAway = Element (Name (T.pack "show") Nothing Nothing) [] + [NodeContent $ ContentText $ T.pack "xa"] {- Name of a git-annex tag, in our own XML namespace. - (Not using a namespace URL to avoid unnecessary bloat.) -} gitAnnexTagName :: Name gitAnnexTagName = Name (T.pack "git-annex") (Just $ T.pack "git-annex") Nothing +{- A git-annex tag, to let other clients know we're a git-annex client too. -} +gitAnnexSignature :: Element +gitAnnexSignature = Element gitAnnexTagName [] [] + pushAttr :: Name pushAttr = Name (T.pack "push") Nothing Nothing |