Add from attribute to service-unavalible to satisfy Pidgin.

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 =
 iq_service_unavailable :: Maybe Text -> Text -> XML.Name -> [XML.Event]
 iq_service_unavailable mid host {- mjid -} req =
     [ EventBeginElement "{jabber:client}iq" 
-        (consid mid [("type",[ContentText "error"])
-                    -- , TODO: set "from" if isJust mjid
-                    ])
+        (consid mid [attr "type" "error"
+                    ,attr "from" host])
     , EventBeginElement req []
     , EventEndElement req
-    , EventBeginElement "{jabber:client}error" [("type",[ContentText "cancel"])]
+    , EventBeginElement "{jabber:client}error" 
+        [ attr "type" "cancel"
+        , attr "code" "503" ]
     , EventBeginElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable" []
     , EventEndElement "{urn:ietf:params:xml:ns:xmpp-stanzas}service-unavailable"
     , EventEndElement "{jabber:client}error"
@@ -1513,7 +1514,8 @@ monitor sv params xmpp = do
                             let reply = iq_bind_reply (stanzaId stanza) rsc
                             -- sendReply quitVar SetResource reply replyto
                             hostname <- xmppTellMyNameToClient xmpp
-                            let requestVersion = do
+                            let requestVersion :: Producer IO XML.Event
+                                requestVersion = do
                                   yield $ EventBeginElement "{jabber:client}iq"
                                               [ attr "to" rsc 
                                               , attr "from" hostname