diff options
-rw-r--r-- | Presence/XMPPServer.hs | 4 | ||||
-rw-r--r-- | xmppServer.hs | 13 |
2 files changed, 16 insertions, 1 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index 3d4120fa..a118ce88 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs | |||
@@ -190,6 +190,7 @@ data XMPPServerParameters = | |||
190 | , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () | 190 | , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () |
191 | , xmppInformPeerPresence :: ConnectionKey -> Stanza -> IO () | 191 | , xmppInformPeerPresence :: ConnectionKey -> Stanza -> IO () |
192 | , xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO () | 192 | , xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO () |
193 | , xmppClientSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> IO () | ||
193 | } | 194 | } |
194 | 195 | ||
195 | 196 | ||
@@ -1607,6 +1608,9 @@ monitor sv params xmpp = do | |||
1607 | xmppSubscribeToRoster xmpp k | 1608 | xmppSubscribeToRoster xmpp k |
1608 | PresenceStatus {} -> do | 1609 | PresenceStatus {} -> do |
1609 | xmppInformClientPresence xmpp k stanza | 1610 | xmppInformClientPresence xmpp k stanza |
1611 | PresenceRequestSubscription {} -> do | ||
1612 | let fail = return () -- todo | ||
1613 | xmppClientSubscriptionRequest xmpp fail k stanza | ||
1610 | NotifyClientVersion name version -> do | 1614 | NotifyClientVersion name version -> do |
1611 | enableClientHacks name version replyto | 1615 | enableClientHacks name version replyto |
1612 | UnrecognizedQuery query -> do | 1616 | UnrecognizedQuery query -> do |
diff --git a/xmppServer.hs b/xmppServer.hs index 823e1aba..41f0012e 100644 --- a/xmppServer.hs +++ b/xmppServer.hs | |||
@@ -609,7 +609,17 @@ sendCachedPresence state k = do | |||
609 | sendModifiedStanzaToClient (dup { stanzaFrom=Just from' }) | 609 | sendModifiedStanzaToClient (dup { stanzaFrom=Just from' }) |
610 | (connChan con) | 610 | (connChan con) |
611 | 611 | ||
612 | -- TODO: send local buddies in clientsByUser | 612 | -- Note: relying on self peer connection to send |
613 | -- send local buddies. | ||
614 | return () | ||
615 | |||
616 | clientSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> IO () | ||
617 | clientSubscriptionRequest state fail k stanza = do | ||
618 | flip (maybe fail) (stanzaTo stanza) $ \to -> do | ||
619 | -- TODO: resolve hostname | ||
620 | -- TODO: add to solicitors | ||
621 | -- TODO; if already connected, send solicitation | ||
622 | -- TODO: addPeer | ||
613 | return () | 623 | return () |
614 | 624 | ||
615 | main = runResourceT $ do | 625 | main = runResourceT $ do |
@@ -647,6 +657,7 @@ main = runResourceT $ do | |||
647 | , xmppInformClientPresence = informClientPresence state | 657 | , xmppInformClientPresence = informClientPresence state |
648 | , xmppInformPeerPresence = informPeerPresence state | 658 | , xmppInformPeerPresence = informPeerPresence state |
649 | , xmppAnswerProbe = answerProbe state | 659 | , xmppAnswerProbe = answerProbe state |
660 | , xmppClientSubscriptionRequest = clientSubscriptionRequest state | ||
650 | } | 661 | } |
651 | liftIO $ do | 662 | liftIO $ do |
652 | atomically $ putTMVar (server state) sv | 663 | atomically $ putTMVar (server state) sv |