diff options
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r-- | Presence/XMPPServer.hs | 20 |
1 files changed, 16 insertions, 4 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index 45dc282e..aab689ad 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs | |||
@@ -86,6 +86,15 @@ data LangSpecificMessage = | |||
86 | } | 86 | } |
87 | deriving (Show,Eq) | 87 | deriving (Show,Eq) |
88 | 88 | ||
89 | data RosterEventType | ||
90 | = RequestedSubscription | ||
91 | | NewBuddy -- preceded by PresenceInformSubscription True | ||
92 | | RemovedBuddy -- preceded by PresenceInformSubscription False | ||
93 | | PendingSubscriber -- same as PresenceRequestSubscription | ||
94 | | NewSubscriber | ||
95 | | RejectSubscriber | ||
96 | deriving (Show,Read,Ord,Eq,Enum) | ||
97 | |||
89 | data StanzaType | 98 | data StanzaType |
90 | = Unrecognized | 99 | = Unrecognized |
91 | | Ping | 100 | | Ping |
@@ -96,6 +105,9 @@ data StanzaType | |||
96 | | UnrecognizedQuery Name | 105 | | UnrecognizedQuery Name |
97 | | RequestRoster | 106 | | RequestRoster |
98 | | Roster | 107 | | Roster |
108 | | RosterEvent { rosterEventType :: RosterEventType | ||
109 | , rosterUser :: Text | ||
110 | , rosterContact :: Text } | ||
99 | | Error | 111 | | Error |
100 | | PresenceStatus { presenceShow :: JabberShow | 112 | | PresenceStatus { presenceShow :: JabberShow |
101 | , presencePriority :: Maybe Int8 | 113 | , presencePriority :: Maybe Int8 |
@@ -137,7 +149,7 @@ data XMPPServerParameters = | |||
137 | , xmppRosterSolicited :: ConnectionKey -> IO [Text] | 149 | , xmppRosterSolicited :: ConnectionKey -> IO [Text] |
138 | , xmppRosterOthers :: ConnectionKey -> IO [Text] | 150 | , xmppRosterOthers :: ConnectionKey -> IO [Text] |
139 | , xmppSubscribeToRoster :: ConnectionKey -> IO () | 151 | , xmppSubscribeToRoster :: ConnectionKey -> IO () |
140 | , xmppLookupClientJID :: ConnectionKey -> IO Text | 152 | -- , xmppLookupClientJID :: ConnectionKey -> IO Text |
141 | , xmppLookupPeerName :: ConnectionKey -> IO Text | 153 | , xmppLookupPeerName :: ConnectionKey -> IO Text |
142 | , xmppDeliverMessage :: (IO ()) -> Stanza -> IO () | 154 | , xmppDeliverMessage :: (IO ()) -> Stanza -> IO () |
143 | , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () | 155 | , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () |
@@ -740,8 +752,8 @@ peerKey (sock,addr) = do | |||
740 | return $ (PeerKey (peer `withPort` fromIntegral peerport),laddr) | 752 | return $ (PeerKey (peer `withPort` fromIntegral peerport),laddr) |
741 | 753 | ||
742 | clientKey (sock,addr) = do | 754 | clientKey (sock,addr) = do |
743 | laddr <- getSocketName sock | 755 | paddr <- getPeerName sock |
744 | return $ (ClientKey addr,laddr) | 756 | return $ (ClientKey addr,paddr) |
745 | 757 | ||
746 | stanzaToConduit :: MonadIO m => Stanza -> ConduitM i Event m () | 758 | stanzaToConduit :: MonadIO m => Stanza -> ConduitM i Event m () |
747 | stanzaToConduit stanza = do | 759 | stanzaToConduit stanza = do |
@@ -783,7 +795,7 @@ sendRoster query xmpp replyto = do | |||
783 | LocalPeer -> Nothing -- local peer requested roster? | 795 | LocalPeer -> Nothing -- local peer requested roster? |
784 | flip (maybe $ return ()) k $ \k -> do | 796 | flip (maybe $ return ()) k $ \k -> do |
785 | jid <- case k of | 797 | jid <- case k of |
786 | ClientKey {} -> xmppLookupClientJID xmpp k | 798 | ClientKey {} -> xmppTellClientHisName xmpp k -- LookupClientJID xmpp k |
787 | PeerKey {} -> xmppLookupPeerName xmpp k | 799 | PeerKey {} -> xmppLookupPeerName xmpp k |
788 | let getlist f = do | 800 | let getlist f = do |
789 | bs <- f xmpp k | 801 | bs <- f xmpp k |