summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs20
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
89data 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
89data StanzaType 98data 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
742clientKey (sock,addr) = do 754clientKey (sock,addr) = do
743 laddr <- getSocketName sock 755 paddr <- getPeerName sock
744 return $ (ClientKey addr,laddr) 756 return $ (ClientKey addr,paddr)
745 757
746stanzaToConduit :: MonadIO m => Stanza -> ConduitM i Event m () 758stanzaToConduit :: MonadIO m => Stanza -> ConduitM i Event m ()
747stanzaToConduit stanza = do 759stanzaToConduit 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