diff options
Diffstat (limited to 'xmppServer.hs')
-rw-r--r-- | xmppServer.hs | 27 |
1 files changed, 23 insertions, 4 deletions
diff --git a/xmppServer.hs b/xmppServer.hs index 41f0012e..7f610587 100644 --- a/xmppServer.hs +++ b/xmppServer.hs | |||
@@ -613,15 +613,33 @@ sendCachedPresence state k = do | |||
613 | -- send local buddies. | 613 | -- send local buddies. |
614 | return () | 614 | return () |
615 | 615 | ||
616 | clientSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> IO () | 616 | clientSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () |
617 | clientSubscriptionRequest state fail k stanza = do | 617 | clientSubscriptionRequest state fail k stanza chan = do |
618 | flip (maybe fail) (stanzaTo stanza) $ \to -> do | 618 | flip (maybe fail) (stanzaTo stanza) $ \to -> do |
619 | -- TODO: resolve hostname | 619 | -- TODO: resolve hostname |
620 | -- TODO: add to solicitors | 620 | -- TODO: add to solicited |
621 | -- TODO; if already connected, send solicitation | 621 | -- TODO; if already connected, send solicitation |
622 | -- TODO: addPeer | 622 | -- TODO: addPeer |
623 | return () | 623 | return () |
624 | 624 | ||
625 | peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () | ||
626 | peerSubscriptionRequest state fail k stanza chan = do | ||
627 | -- TODO: if already subscribed, reply and quit | ||
628 | |||
629 | -- TODO: add to pending | ||
630 | |||
631 | -- TODO: send to clients | ||
632 | -- "all available resources in accordence with section 8" | ||
633 | -- Section 8 says (for presence of type "subscribe", the server MUST | ||
634 | -- adhere to the rules defined under Section 3 and summarized under | ||
635 | -- Appendix A. | ||
636 | -- Appendex A.3.1 says | ||
637 | -- contact ∈ subscribers --> SHOULD NOT, already handled | ||
638 | -- contact ∉ subscribers & contact ∈ pending --> SHOULD NOT | ||
639 | -- contact ∉ subscribers & contact ∉ pending --> MUST | ||
640 | |||
641 | return () | ||
642 | |||
625 | main = runResourceT $ do | 643 | main = runResourceT $ do |
626 | state <- liftIO . atomically $ do | 644 | state <- liftIO . atomically $ do |
627 | clients <- newTVar Map.empty | 645 | clients <- newTVar Map.empty |
@@ -658,6 +676,7 @@ main = runResourceT $ do | |||
658 | , xmppInformPeerPresence = informPeerPresence state | 676 | , xmppInformPeerPresence = informPeerPresence state |
659 | , xmppAnswerProbe = answerProbe state | 677 | , xmppAnswerProbe = answerProbe state |
660 | , xmppClientSubscriptionRequest = clientSubscriptionRequest state | 678 | , xmppClientSubscriptionRequest = clientSubscriptionRequest state |
679 | , xmppPeerSubscriptionRequest = peerSubscriptionRequest state | ||
661 | } | 680 | } |
662 | liftIO $ do | 681 | liftIO $ do |
663 | atomically $ putTMVar (server state) sv | 682 | atomically $ putTMVar (server state) sv |