diff options
Diffstat (limited to 'Presence/XMPPServer.hs')
-rw-r--r-- | Presence/XMPPServer.hs | 12 |
1 files changed, 7 insertions, 5 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs index 1d527246..f6df1525 100644 --- a/Presence/XMPPServer.hs +++ b/Presence/XMPPServer.hs | |||
@@ -947,12 +947,13 @@ iq_session_reply mid host = | |||
947 | iq_service_unavailable :: Maybe Text -> Text -> XML.Name -> [XML.Event] | 947 | iq_service_unavailable :: Maybe Text -> Text -> XML.Name -> [XML.Event] |
948 | iq_service_unavailable mid host {- mjid -} req = | 948 | iq_service_unavailable mid host {- mjid -} req = |
949 | [ EventBeginElement "{jabber:client}iq" | 949 | [ EventBeginElement "{jabber:client}iq" |
950 | (consid mid [("type",[ContentText "error"]) | 950 | (consid mid [attr "type" "error" |
951 | -- , TODO: set "from" if isJust mjid | 951 | ,attr "from" host]) |
952 | ]) | ||
953 | , EventBeginElement req [] | 952 | , EventBeginElement req [] |
954 | , EventEndElement req | 953 | , EventEndElement req |
955 | , EventBeginElement "{jabber:client}error" [("type",[ContentText "cancel"])] | 954 | , EventBeginElement "{jabber:client}error" |
955 | [ attr "type" "cancel" | ||
956 | , attr "code" "503" ] | ||
956 | , EventBeginElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable" [] | 957 | , EventBeginElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable" [] |
957 | , EventEndElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable" | 958 | , EventEndElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable" |
958 | , EventEndElement "{jabber:client}error" | 959 | , EventEndElement "{jabber:client}error" |
@@ -1513,7 +1514,8 @@ monitor sv params xmpp = do | |||
1513 | let reply = iq_bind_reply (stanzaId stanza) rsc | 1514 | let reply = iq_bind_reply (stanzaId stanza) rsc |
1514 | -- sendReply quitVar SetResource reply replyto | 1515 | -- sendReply quitVar SetResource reply replyto |
1515 | hostname <- xmppTellMyNameToClient xmpp | 1516 | hostname <- xmppTellMyNameToClient xmpp |
1516 | let requestVersion = do | 1517 | let requestVersion :: Producer IO XML.Event |
1518 | requestVersion = do | ||
1517 | yield $ EventBeginElement "{jabber:client}iq" | 1519 | yield $ EventBeginElement "{jabber:client}iq" |
1518 | [ attr "to" rsc | 1520 | [ attr "to" rsc |
1519 | , attr "from" hostname | 1521 | , attr "from" hostname |