Get username and tty for jid

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 =
                         }
   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