summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Presence/XMPPServer.hs32
1 files changed, 20 insertions, 12 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 79167267..2e3c0a37 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -170,8 +170,11 @@ type Stanza = StanzaWrap (LockedChan XML.Event)
170 170
171data XMPPServerParameters = 171data XMPPServerParameters =
172 XMPPServerParameters 172 XMPPServerParameters
173 { xmppChooseResourceName :: ConnectionKey -> SockAddr -> Maybe Text -> IO Text 173 { -- | Called when a client requests a resource id. The Maybe value is the
174 , xmppTellMyNameToClient :: IO Text 174 -- client's preference.
175 xmppChooseResourceName :: ConnectionKey -> SockAddr -> Maybe Text -> IO Text
176 , -- | This should indicate the server's hostname that all client's see.
177 xmppTellMyNameToClient :: IO Text
175 , xmppTellMyNameToPeer :: SockAddr -> IO Text 178 , xmppTellMyNameToPeer :: SockAddr -> IO Text
176 , xmppTellClientHisName :: ConnectionKey -> IO Text 179 , xmppTellClientHisName :: ConnectionKey -> IO Text
177 , xmppTellPeerHisName :: ConnectionKey -> IO Text 180 , xmppTellPeerHisName :: ConnectionKey -> IO Text
@@ -181,7 +184,9 @@ data XMPPServerParameters =
181 , xmppRosterSubscribers :: ConnectionKey -> IO [Text] 184 , xmppRosterSubscribers :: ConnectionKey -> IO [Text]
182 , xmppRosterSolicited :: ConnectionKey -> IO [Text] 185 , xmppRosterSolicited :: ConnectionKey -> IO [Text]
183 , xmppRosterOthers :: ConnectionKey -> IO [Text] 186 , xmppRosterOthers :: ConnectionKey -> IO [Text]
184 , xmppSubscribeToRoster :: ConnectionKey -> IO () 187 , -- | Called when after sending a roster to a client. Usually this means
188 -- the client status should change from "available" to "interested".
189 xmppSubscribeToRoster :: ConnectionKey -> IO ()
185 -- , xmppLookupClientJID :: ConnectionKey -> IO Text 190 -- , xmppLookupClientJID :: ConnectionKey -> IO Text
186 , xmppTellClientNameOfPeer :: ConnectionKey -> [Text] -> IO Text 191 , xmppTellClientNameOfPeer :: ConnectionKey -> [Text] -> IO Text
187 , xmppDeliverMessage :: (IO ()) -> Stanza -> IO () 192 , xmppDeliverMessage :: (IO ()) -> Stanza -> IO ()
@@ -189,11 +194,14 @@ data XMPPServerParameters =
189 , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () 194 , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO ()
190 -- | Called whenever a remote peer's presence changes. 195 -- | Called whenever a remote peer's presence changes.
191 , xmppInformPeerPresence :: ConnectionKey -> Stanza -> IO () 196 , xmppInformPeerPresence :: ConnectionKey -> Stanza -> IO ()
192 , xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO () 197 , -- | Called when a remote peer requests our status.
198 xmppAnswerProbe :: ConnectionKey -> Stanza -> TChan Stanza -> IO ()
193 , xmppClientSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 199 , xmppClientSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
194 , xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO () 200 , -- | Called when a remote peer sends subscription request.
201 xmppPeerSubscriptionRequest :: IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
195 , xmppClientInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO () 202 , xmppClientInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
196 , xmppPeerInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO () 203 , -- | Called when a remote peer informs us of our subscription status.
204 xmppPeerInformSubscription :: IO () -> ConnectionKey -> Stanza -> IO ()
197 , xmppVerbosity :: IO Int 205 , xmppVerbosity :: IO Int
198 } 206 }
199 207
@@ -647,15 +655,15 @@ grokPresence ns stanzaTag = do
647 let typ = lookupAttrib "type" (tagAttrs stanzaTag) 655 let typ = lookupAttrib "type" (tagAttrs stanzaTag)
648 case typ of 656 case typ of
649 Nothing -> parsePresenceStatus ns stanzaTag 657 Nothing -> parsePresenceStatus ns stanzaTag
650 Just "unavailable" -> fmap (fmap (\p -> p {presenceShow=Offline})) 658 Just "unavailable" -> fmap (fmap (\p -> p {presenceShow=Offline}))
651 $ parsePresenceStatus ns stanzaTag 659 $ parsePresenceStatus ns stanzaTag
652 Just "error" -> return . Just $ PresenceInformError 660 Just "error" -> return . Just $ PresenceInformError
653 Just "unsubscribed" -> return . Just $ PresenceInformSubscription False 661 Just "unsubscribed" -> return . Just $ PresenceInformSubscription False
654 Just "subscribed" -> return . Just $ PresenceInformSubscription True 662 Just "subscribed" -> return . Just $ PresenceInformSubscription True
655 Just "probe" -> return . Just $ PresenceRequestStatus 663 Just "probe" -> return . Just $ PresenceRequestStatus
656 Just "unsubscribe" -> return . Just $ PresenceRequestSubscription False 664 Just "unsubscribe" -> return . Just $ PresenceRequestSubscription False
657 Just "subscribe" -> return . Just $ PresenceRequestSubscription True 665 Just "subscribe" -> return . Just $ PresenceRequestSubscription True
658 _ -> return Nothing 666 _ -> return Nothing
659 667
660parseMessage 668parseMessage
661 :: ( MonadThrow m 669 :: ( MonadThrow m