From 24f0f7a50653223ea72c846a56817760a0bd63b9 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 17 Feb 2014 09:53:04 -0500 Subject: Get username and tty for jid --- Presence/XMPPServer.hs | 20 ++++++++++++++++---- 1 file changed, 16 insertions(+), 4 deletions(-) (limited to 'Presence') 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 = } deriving (Show,Eq) +data RosterEventType + = RequestedSubscription + | NewBuddy -- preceded by PresenceInformSubscription True + | RemovedBuddy -- preceded by PresenceInformSubscription False + | PendingSubscriber -- same as PresenceRequestSubscription + | NewSubscriber + | RejectSubscriber + deriving (Show,Read,Ord,Eq,Enum) + data StanzaType = Unrecognized | Ping @@ -96,6 +105,9 @@ data StanzaType | UnrecognizedQuery Name | RequestRoster | Roster + | RosterEvent { rosterEventType :: RosterEventType + , rosterUser :: Text + , rosterContact :: Text } | Error | PresenceStatus { presenceShow :: JabberShow , presencePriority :: Maybe Int8 @@ -137,7 +149,7 @@ data XMPPServerParameters = , xmppRosterSolicited :: ConnectionKey -> IO [Text] , xmppRosterOthers :: ConnectionKey -> IO [Text] , xmppSubscribeToRoster :: ConnectionKey -> IO () - , xmppLookupClientJID :: ConnectionKey -> IO Text + -- , xmppLookupClientJID :: ConnectionKey -> IO Text , xmppLookupPeerName :: ConnectionKey -> IO Text , xmppDeliverMessage :: (IO ()) -> Stanza -> IO () , xmppInformClientPresence :: ConnectionKey -> Stanza -> IO () @@ -740,8 +752,8 @@ peerKey (sock,addr) = do return $ (PeerKey (peer `withPort` fromIntegral peerport),laddr) clientKey (sock,addr) = do - laddr <- getSocketName sock - return $ (ClientKey addr,laddr) + paddr <- getPeerName sock + return $ (ClientKey addr,paddr) stanzaToConduit :: MonadIO m => Stanza -> ConduitM i Event m () stanzaToConduit stanza = do @@ -783,7 +795,7 @@ sendRoster query xmpp replyto = do LocalPeer -> Nothing -- local peer requested roster? flip (maybe $ return ()) k $ \k -> do jid <- case k of - ClientKey {} -> xmppLookupClientJID xmpp k + ClientKey {} -> xmppTellClientHisName xmpp k -- LookupClientJID xmpp k PeerKey {} -> xmppLookupPeerName xmpp k let getlist f = do bs <- f xmpp k -- cgit v1.2.3