From bbfa4e907944942630336e76f425a6ee2b9d742f Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Tue, 19 Nov 2013 15:35:25 +0100
Subject: [PATCH] add Text parameter to Gone and Redirect error conditions

---
 source/Network/Xmpp/Marshal.hs | 26 ++++++++++++++++++--------
 source/Network/Xmpp/Types.hs   |  4 ++--
 2 files changed, 20 insertions(+), 10 deletions(-)

diff --git a/source/Network/Xmpp/Marshal.hs b/source/Network/Xmpp/Marshal.hs
index 9a457a4..29f668b 100644
--- a/source/Network/Xmpp/Marshal.hs
+++ b/source/Network/Xmpp/Marshal.hs
@@ -107,14 +107,24 @@ xpIQResult = ("xpIQResult" , "") <?+> xpWrap
 ----------------------------------------------------------
 
 xpErrorCondition :: PU [Node] StanzaErrorCondition
-xpErrorCondition = ("xpErrorCondition" , "") <?+> xpWrap
-    (\(cond, (), ()) -> cond)
-    (\cond -> (cond, (), ()))
+xpErrorCondition = ("xpErrorCondition" , "") <?+> xpWrapEither
+                   (\(cond, (),cont) -> case (cond, cont) of
+                         (Gone _, x) -> Right $ Gone x
+                         (Redirect _, x) -> Right $ Redirect x
+                         (x , Nothing) -> Right x
+                         _ -> Left
+                              ("Only Gone and Redirect may have character data"
+                                 :: String)
+                              )
+                   (\x -> case x of
+                         (Gone t) -> (Gone Nothing, (),  t)
+                         (Redirect t) -> (Redirect Nothing, () , t)
+                         c -> (c, (), Nothing))
     (xpElemByNamespace
         "urn:ietf:params:xml:ns:xmpp-stanzas"
         xpStanzaErrorCondition
         xpUnit
-        xpUnit
+        (xpOption $ xpContent xpId)
     )
 
 xpStanzaError :: PU [Node] StanzaError
@@ -376,7 +386,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
     stanzaErrorConditionToText Conflict = "conflict"
     stanzaErrorConditionToText FeatureNotImplemented = "feature-not-implemented"
     stanzaErrorConditionToText Forbidden = "forbidden"
-    stanzaErrorConditionToText Gone = "gone"
+    stanzaErrorConditionToText (Gone _) = "gone"
     stanzaErrorConditionToText InternalServerError = "internal-server-error"
     stanzaErrorConditionToText ItemNotFound = "item-not-found"
     stanzaErrorConditionToText JidMalformed = "jid-malformed"
@@ -385,7 +395,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
     stanzaErrorConditionToText NotAuthorized = "not-authorized"
     stanzaErrorConditionToText PaymentRequired = "payment-required"
     stanzaErrorConditionToText RecipientUnavailable = "recipient-unavailable"
-    stanzaErrorConditionToText Redirect = "redirect"
+    stanzaErrorConditionToText (Redirect _) = "redirect"
     stanzaErrorConditionToText RegistrationRequired = "registration-required"
     stanzaErrorConditionToText RemoteServerNotFound = "remote-server-not-found"
     stanzaErrorConditionToText RemoteServerTimeout = "remote-server-timeout"
@@ -398,7 +408,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
     stanzaErrorConditionFromText "conflict" = Just Conflict
     stanzaErrorConditionFromText "feature-not-implemented" = Just FeatureNotImplemented
     stanzaErrorConditionFromText "forbidden" = Just Forbidden
-    stanzaErrorConditionFromText "gone" = Just Gone
+    stanzaErrorConditionFromText "gone" = Just $ Gone Nothing
     stanzaErrorConditionFromText "internal-server-error" = Just InternalServerError
     stanzaErrorConditionFromText "item-not-found" = Just ItemNotFound
     stanzaErrorConditionFromText "jid-malformed" = Just JidMalformed
@@ -407,7 +417,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
     stanzaErrorConditionFromText "not-authorized" = Just NotAuthorized
     stanzaErrorConditionFromText "payment-required" = Just PaymentRequired
     stanzaErrorConditionFromText "recipient-unavailable" = Just RecipientUnavailable
-    stanzaErrorConditionFromText "redirect" = Just Redirect
+    stanzaErrorConditionFromText "redirect" = Just $ Redirect Nothing
     stanzaErrorConditionFromText "registration-required" = Just RegistrationRequired
     stanzaErrorConditionFromText "remote-server-not-found" = Just RemoteServerNotFound
     stanzaErrorConditionFromText "remote-server-timeout" = Just RemoteServerTimeout
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
index 57d9a76..6b958ba 100644
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -289,7 +289,7 @@ data StanzaErrorCondition = BadRequest            -- ^ Malformed XML.
                                                   --   name already exists.
                           | FeatureNotImplemented
                           | Forbidden             -- ^ Insufficient permissions.
-                          | Gone                  -- ^ Entity can no longer be
+                          | Gone (Maybe Text)     -- ^ Entity can no longer be
                                                   --   contacted at this
                                                   --   address.
                           | InternalServerError
@@ -303,7 +303,7 @@ data StanzaErrorCondition = BadRequest            -- ^ Malformed XML.
                                                   --   credentials.
                           | PaymentRequired
                           | RecipientUnavailable  -- ^ Temporarily unavailable.
-                          | Redirect              -- ^ Redirecting to other
+                          | Redirect (Maybe Text) -- ^ Redirecting to other
                                                   --   entity, usually
                                                   --   temporarily.
                           | RegistrationRequired