diff options
-rw-r--r-- | Presence/XMPPServer.hs | 11 |
1 files changed, 6 insertions, 5 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index ba542909..ace36f80 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs | |||
@@ -97,14 +97,14 @@ astring (AttValue [Left s]) = [s] | |||
97 | tagcontent tag content = Prelude.concatMap (\(CElem (Elem _ _ c) _)->c) | 97 | tagcontent tag content = Prelude.concatMap (\(CElem (Elem _ _ c) _)->c) |
98 | $ Prelude.filter (bindElem tag) content | 98 | $ Prelude.filter (bindElem tag) content |
99 | 99 | ||
100 | iqresult host id (Just rsrc) = L.unlines $ | 100 | iq_bind_reply id jid = L.unlines $ |
101 | [ "<iq type='result' id='" <++> id <++> "'>" | 101 | [ "<iq type='result' id='" <++> id <++> "'>" |
102 | , "<bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'>" | 102 | , "<bind xmlns='urn:ietf:params:xml:ns:xmpp-bind'>" |
103 | , "<jid>" <++> id <++> "@" <++> host <++> "/" <++> rsrc <++> "</jid>" | 103 | , "<jid>" <++> jid <++> "</jid>" |
104 | , "</bind>" | 104 | , "</bind>" |
105 | , "</iq> " | 105 | , "</iq> " |
106 | ] | 106 | ] |
107 | iqresult host id Nothing = L.unlines $ | 107 | iq_session_reply host id = L.unlines $ |
108 | [ "<iq type='result'" | 108 | [ "<iq type='result'" |
109 | , " id='" <++> id <++> "'" | 109 | , " id='" <++> id <++> "'" |
110 | , " from='" <++> host <++> "'" | 110 | , " from='" <++> host <++> "'" |
@@ -136,10 +136,11 @@ iqresponse host (Elem _ attrs content) = do | |||
136 | let string (CString _ s _) = [s] | 136 | let string (CString _ s _) = [s] |
137 | mplus (do | 137 | mplus (do |
138 | rsrc <- listToMaybe . Prelude.concatMap string . tagcontent "resource" . tagcontent "bind" $ content | 138 | rsrc <- listToMaybe . Prelude.concatMap string . tagcontent "resource" . tagcontent "bind" $ content |
139 | Just $ iqresult host id (Just (pack rsrc)) ) | 139 | let jid = "TODO" <++> "@" <++> host <++> "/" <++> pack rsrc |
140 | Just $ iq_bind_reply id jid ) | ||
140 | (do | 141 | (do |
141 | guard (hasElem "session" content) | 142 | guard (hasElem "session" content) |
142 | Just (iqresult host id Nothing)) | 143 | Just (iq_session_reply host id)) |
143 | 144 | ||
144 | "get" -> {- trace ("iq-get "++show (attrs,content)) $ -} do | 145 | "get" -> {- trace ("iq-get "++show (attrs,content)) $ -} do |
145 | (tag,as) <- lookup (N "xmlns") (anytagattrs content) | 146 | (tag,as) <- lookup (N "xmlns") (anytagattrs content) |