summaryrefslogtreecommitdiff
path: root/Presence/XMPPServer.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r--Presence/XMPPServer.hs11
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]
97tagcontent tag content = Prelude.concatMap (\(CElem (Elem _ _ c) _)->c) 97tagcontent tag content = Prelude.concatMap (\(CElem (Elem _ _ c) _)->c)
98 $ Prelude.filter (bindElem tag) content 98 $ Prelude.filter (bindElem tag) content
99 99
100iqresult host id (Just rsrc) = L.unlines $ 100iq_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 ]
107iqresult host id Nothing = L.unlines $ 107iq_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)