From e96ec958977a5f47f9d512b5ca615e99a1e6ef11 Mon Sep 17 00:00:00 2001
From: Philipp Balzarek <p.balzarek@googlemail.com>
Date: Tue, 19 Nov 2013 17:02:50 +0100
Subject: [PATCH] add associatedErrorType and iqErrorResponse

---
 source/Network/Xmpp/Internal.hs |  8 +++---
 source/Network/Xmpp/Stanza.hs   | 43 +++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 3 deletions(-)

diff --git a/source/Network/Xmpp/Internal.hs b/source/Network/Xmpp/Internal.hs
index 85774e0..256eabf 100644
--- a/source/Network/Xmpp/Internal.hs
+++ b/source/Network/Xmpp/Internal.hs
@@ -33,13 +33,15 @@ module Network.Xmpp.Internal
   , SaslHandler
   , Stanza(..)
   , TlsBehaviour(..)
+  , iqErrorResponse
+  , associatedErrorType
  )
-
        where
 
-import Network.Xmpp.Stream
+import Network.Xmpp.Concurrent.Basic
 import Network.Xmpp.Sasl
 import Network.Xmpp.Sasl.Types
+import Network.Xmpp.Stanza
+import Network.Xmpp.Stream
 import Network.Xmpp.Tls
 import Network.Xmpp.Types
-import Network.Xmpp.Concurrent.Basic
diff --git a/source/Network/Xmpp/Stanza.hs b/source/Network/Xmpp/Stanza.hs
index c5cc124..232bc83 100644
--- a/source/Network/Xmpp/Stanza.hs
+++ b/source/Network/Xmpp/Stanza.hs
@@ -54,3 +54,46 @@ answerMessage _ _ = Nothing
 -- | Add a recipient to a presence notification.
 presTo :: Presence -> Jid -> Presence
 presTo pres to = pres{presenceTo = Just to}
+
+-- | Create an IQ error response to an IQ request using the given condition. The
+-- error type is derived from the condition using 'associatedErrorType' and
+-- both text and the application specific condition are left empty
+iqErrorResponse :: StanzaErrorCondition -> IQRequest -> IQError
+iqErrorResponse condition (IQRequest iqid from _to lang _tp bd) =
+    IQError iqid Nothing from lang err Nothing
+  where
+    err = StanzaError (associatedErrorType condition) condition Nothing Nothing
+
+-- | The RECOMMENDED error type associated with an error condition. The
+-- following conditions allow for multiple types
+--
+-- * 'FeatureNotImplemented': 'Cancel' or 'Modify' (returns 'Cancel')
+--
+-- * 'PolicyViolation': 'Modify' or 'Wait' ('Modify')
+--
+-- * 'RemoteServerTimeout': Wait or unspecified other ('Wait')
+--
+-- * 'UndefinedCondition': Any condition ('Cancel')
+associatedErrorType :: StanzaErrorCondition -> StanzaErrorType
+associatedErrorType BadRequest            = Modify
+associatedErrorType Conflict              = Cancel
+associatedErrorType FeatureNotImplemented = Cancel -- Or Modify
+associatedErrorType Forbidden             = Auth
+associatedErrorType Gone{}                = Cancel
+associatedErrorType InternalServerError   = Cancel
+associatedErrorType ItemNotFound          = Cancel
+associatedErrorType JidMalformed          = Modify
+associatedErrorType NotAcceptable         = Modify
+associatedErrorType NotAllowed            = Cancel
+associatedErrorType NotAuthorized         = Auth
+associatedErrorType PolicyViolation       = Modify -- Or Wait
+associatedErrorType RecipientUnavailable  = Wait
+associatedErrorType Redirect{}            = Modify
+associatedErrorType RegistrationRequired  = Auth
+associatedErrorType RemoteServerNotFound  = Cancel
+associatedErrorType RemoteServerTimeout   = Wait -- Possibly Others
+associatedErrorType ResourceConstraint    = Wait
+associatedErrorType ServiceUnavailable    = Cancel
+associatedErrorType SubscriptionRequired  = Auth
+associatedErrorType UndefinedCondition    = Cancel -- This can be anything
+associatedErrorType UnexpectedRequest     = Modify