diff options
-rw-r--r-- | Presence/XMPP.hs | 17 | ||||
-rw-r--r-- | Presence/XMPPTypes.hs | 8 | ||||
-rw-r--r-- | Presence/main.hs | 25 |
3 files changed, 41 insertions, 9 deletions
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs index c4e4d7f6..fb53c2fb 100644 --- a/Presence/XMPP.hs +++ b/Presence/XMPP.hs | |||
@@ -331,6 +331,11 @@ iq_service_unavailable host iq_id mjid req = | |||
331 | , EventEndElement "{jabber:client}iq" | 331 | , EventEndElement "{jabber:client}iq" |
332 | ] | 332 | ] |
333 | 333 | ||
334 | getRoster session = do | ||
335 | budies <- getMyBuddies session | ||
336 | subscribers <- getMySubscribers session | ||
337 | return ([]::[Event]) -- TODO | ||
338 | |||
334 | handleIQGet session cmdChan tag = do | 339 | handleIQGet session cmdChan tag = do |
335 | withJust (lookupAttrib "id" (tagAttrs tag)) $ \stanza_id -> do | 340 | withJust (lookupAttrib "id" (tagAttrs tag)) $ \stanza_id -> do |
336 | whenJust nextElement $ \child -> do | 341 | whenJust nextElement $ \child -> do |
@@ -356,6 +361,18 @@ handleIQGet session cmdChan tag = do | |||
356 | , EventEndElement "{jabber:client}iq" | 361 | , EventEndElement "{jabber:client}iq" |
357 | ] | 362 | ] |
358 | atomically . writeTChan cmdChan . Send $ pong | 363 | atomically . writeTChan cmdChan . Send $ pong |
364 | "{jabber:iq:roster}query" -> liftIO $ do | ||
365 | putStrLn $ "REQUESTED ROSTER " ++ show tag | ||
366 | -- REQUESTED ROSTER EventBeginElement | ||
367 | -- (Name {nameLocalName = "iq", nameNamespace = Just "jabber:client", namePrefix = Nothing}) | ||
368 | -- [(Name { nameLocalName = "id" | ||
369 | -- , nameNamespace = Nothing | ||
370 | -- , namePrefix = Nothing}, | ||
371 | -- [ContentText "32a337c2-7b22-45b6-9d21-15ded0d079ec"]) | ||
372 | -- ,(Name {nameLocalName = "type", nameNamespace = Nothing, namePrefix = Nothing}, | ||
373 | -- [ContentText "get"])] | ||
374 | roster <- getRoster session | ||
375 | atomically . writeTChan cmdChan . Send $ roster | ||
359 | req -> unhandledGet req | 376 | req -> unhandledGet req |
360 | 377 | ||
361 | 378 | ||
diff --git a/Presence/XMPPTypes.hs b/Presence/XMPPTypes.hs index c6925aa4..747ceb0e 100644 --- a/Presence/XMPPTypes.hs +++ b/Presence/XMPPTypes.hs | |||
@@ -39,6 +39,11 @@ class JabberClientSession session where | |||
39 | closeSession :: session -> IO () | 39 | closeSession :: session -> IO () |
40 | subscribe :: session -> Maybe JID -> IO (TChan Presence) | 40 | subscribe :: session -> Maybe JID -> IO (TChan Presence) |
41 | forCachedPresence :: session -> (Presence -> IO ()) -> IO () | 41 | forCachedPresence :: session -> (Presence -> IO ()) -> IO () |
42 | getMyBuddies :: session -> IO [ByteString] | ||
43 | getMySubscribers :: session -> IO [ByteString] | ||
44 | getMyOthers :: session -> IO [ByteString] | ||
45 | getMyPending :: session -> IO [ByteString] | ||
46 | getMySolicited :: session -> IO [ByteString] | ||
42 | 47 | ||
43 | class JabberPeerSession session where | 48 | class JabberPeerSession session where |
44 | data XMPPPeerClass session | 49 | data XMPPPeerClass session |
@@ -50,9 +55,6 @@ class JabberPeerSession session where | |||
50 | peerSessionFactory :: session -> XMPPPeerClass session | 55 | peerSessionFactory :: session -> XMPPPeerClass session |
51 | getBuddies :: XMPPPeerClass session -> ByteString -> IO [ByteString] | 56 | getBuddies :: XMPPPeerClass session -> ByteString -> IO [ByteString] |
52 | getSubscribers :: XMPPPeerClass session -> ByteString -> IO [ByteString] | 57 | getSubscribers :: XMPPPeerClass session -> ByteString -> IO [ByteString] |
53 | getOthers :: XMPPPeerClass session -> ByteString -> IO [ByteString] | ||
54 | getPending :: XMPPPeerClass session -> ByteString -> IO [ByteString] | ||
55 | getSolicited :: XMPPPeerClass session -> ByteString -> IO [ByteString] | ||
56 | 58 | ||
57 | -- | Jabber ID (JID) datatype | 59 | -- | Jabber ID (JID) datatype |
58 | data JID = JID { name :: Maybe ByteString | 60 | data JID = JID { name :: Maybe ByteString |
diff --git a/Presence/main.hs b/Presence/main.hs index 25ac994b..0eae8677 100644 --- a/Presence/main.hs +++ b/Presence/main.hs | |||
@@ -86,7 +86,7 @@ data PresenceState = PresenceState | |||
86 | 86 | ||
87 | getJabberUserForId muid = | 87 | getJabberUserForId muid = |
88 | maybe (return "nobody") | 88 | maybe (return "nobody") |
89 | (\uid -> | 89 | (\(uid,_) -> |
90 | handle (\(SomeException _) -> | 90 | handle (\(SomeException _) -> |
91 | return . L.append "uid." . L.pack . show $ uid) | 91 | return . L.append "uid." . L.pack . show $ uid) |
92 | $ do | 92 | $ do |
@@ -129,8 +129,7 @@ instance JabberClientSession ClientSession where | |||
129 | 129 | ||
130 | getJID s = do | 130 | getJID s = do |
131 | let host = localhost s | 131 | let host = localhost s |
132 | muid <- fmap (fmap fst) $ readIORef (unix_uid s) | 132 | user <- readIORef (unix_uid s) >>= getJabberUserForId |
133 | user <- getJabberUserForId muid | ||
134 | 133 | ||
135 | rsc <- readIORef (unix_resource s) | 134 | rsc <- readIORef (unix_resource s) |
136 | -- let jid = user <++> "@" <++> host <++?> "/" <++$> rsc | 135 | -- let jid = user <++> "@" <++> host <++?> "/" <++$> rsc |
@@ -169,6 +168,23 @@ instance JabberClientSession ClientSession where | |||
169 | L.putStrLn $ "cached presence: " <++> bshow p | 168 | L.putStrLn $ "cached presence: " <++> bshow p |
170 | action p | 169 | action p |
171 | 170 | ||
171 | getMyBuddies s = do | ||
172 | user <- readIORef (unix_uid s) >>= getJabberUserForId | ||
173 | ConfigFiles.getBuddies user | ||
174 | getMySubscribers s = do | ||
175 | user <- readIORef (unix_uid s) >>= getJabberUserForId | ||
176 | ConfigFiles.getSubscribers user | ||
177 | getMyOthers s = do | ||
178 | user <- readIORef (unix_uid s) >>= getJabberUserForId | ||
179 | ConfigFiles.getOthers user | ||
180 | getMyPending s = do | ||
181 | user <- readIORef (unix_uid s) >>= getJabberUserForId | ||
182 | ConfigFiles.getPending user | ||
183 | getMySolicited s = do | ||
184 | user <- readIORef (unix_uid s) >>= getJabberUserForId | ||
185 | ConfigFiles.getSolicited user | ||
186 | |||
187 | |||
172 | tupleToJID (user,tty,pid) = jid user LocalHost tty | 188 | tupleToJID (user,tty,pid) = jid user LocalHost tty |
173 | 189 | ||
174 | data PeerSession = PeerSession { | 190 | data PeerSession = PeerSession { |
@@ -229,9 +245,6 @@ instance JabberPeerSession PeerSession where | |||
229 | 245 | ||
230 | getBuddies _ user = ConfigFiles.getBuddies user | 246 | getBuddies _ user = ConfigFiles.getBuddies user |
231 | getSubscribers _ user = ConfigFiles.getSubscribers user | 247 | getSubscribers _ user = ConfigFiles.getSubscribers user |
232 | getOthers _ user = ConfigFiles.getOthers user | ||
233 | getPending _ user = ConfigFiles.getPending user | ||
234 | getSolicited _ user = ConfigFiles.getSolicited user | ||
235 | 248 | ||
236 | 249 | ||
237 | subscribeToChan tmvar = | 250 | subscribeToChan tmvar = |