Browse Source

add Text parameter to Gone and Redirect error conditions

master
Philipp Balzarek 12 years ago
parent
commit
bbfa4e9079
  1. 26
      source/Network/Xmpp/Marshal.hs
  2. 4
      source/Network/Xmpp/Types.hs

26
source/Network/Xmpp/Marshal.hs

@ -107,14 +107,24 @@ xpIQResult = ("xpIQResult" , "") <?+> xpWrap
---------------------------------------------------------- ----------------------------------------------------------
xpErrorCondition :: PU [Node] StanzaErrorCondition xpErrorCondition :: PU [Node] StanzaErrorCondition
xpErrorCondition = ("xpErrorCondition" , "") <?+> xpWrap xpErrorCondition = ("xpErrorCondition" , "") <?+> xpWrapEither
(\(cond, (), ()) -> cond) (\(cond, (),cont) -> case (cond, cont) of
(\cond -> (cond, (), ())) (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 (xpElemByNamespace
"urn:ietf:params:xml:ns:xmpp-stanzas" "urn:ietf:params:xml:ns:xmpp-stanzas"
xpStanzaErrorCondition xpStanzaErrorCondition
xpUnit xpUnit
xpUnit (xpOption $ xpContent xpId)
) )
xpStanzaError :: PU [Node] StanzaError xpStanzaError :: PU [Node] StanzaError
@ -376,7 +386,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
stanzaErrorConditionToText Conflict = "conflict" stanzaErrorConditionToText Conflict = "conflict"
stanzaErrorConditionToText FeatureNotImplemented = "feature-not-implemented" stanzaErrorConditionToText FeatureNotImplemented = "feature-not-implemented"
stanzaErrorConditionToText Forbidden = "forbidden" stanzaErrorConditionToText Forbidden = "forbidden"
stanzaErrorConditionToText Gone = "gone" stanzaErrorConditionToText (Gone _) = "gone"
stanzaErrorConditionToText InternalServerError = "internal-server-error" stanzaErrorConditionToText InternalServerError = "internal-server-error"
stanzaErrorConditionToText ItemNotFound = "item-not-found" stanzaErrorConditionToText ItemNotFound = "item-not-found"
stanzaErrorConditionToText JidMalformed = "jid-malformed" stanzaErrorConditionToText JidMalformed = "jid-malformed"
@ -385,7 +395,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
stanzaErrorConditionToText NotAuthorized = "not-authorized" stanzaErrorConditionToText NotAuthorized = "not-authorized"
stanzaErrorConditionToText PaymentRequired = "payment-required" stanzaErrorConditionToText PaymentRequired = "payment-required"
stanzaErrorConditionToText RecipientUnavailable = "recipient-unavailable" stanzaErrorConditionToText RecipientUnavailable = "recipient-unavailable"
stanzaErrorConditionToText Redirect = "redirect" stanzaErrorConditionToText (Redirect _) = "redirect"
stanzaErrorConditionToText RegistrationRequired = "registration-required" stanzaErrorConditionToText RegistrationRequired = "registration-required"
stanzaErrorConditionToText RemoteServerNotFound = "remote-server-not-found" stanzaErrorConditionToText RemoteServerNotFound = "remote-server-not-found"
stanzaErrorConditionToText RemoteServerTimeout = "remote-server-timeout" stanzaErrorConditionToText RemoteServerTimeout = "remote-server-timeout"
@ -398,7 +408,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
stanzaErrorConditionFromText "conflict" = Just Conflict stanzaErrorConditionFromText "conflict" = Just Conflict
stanzaErrorConditionFromText "feature-not-implemented" = Just FeatureNotImplemented stanzaErrorConditionFromText "feature-not-implemented" = Just FeatureNotImplemented
stanzaErrorConditionFromText "forbidden" = Just Forbidden stanzaErrorConditionFromText "forbidden" = Just Forbidden
stanzaErrorConditionFromText "gone" = Just Gone stanzaErrorConditionFromText "gone" = Just $ Gone Nothing
stanzaErrorConditionFromText "internal-server-error" = Just InternalServerError stanzaErrorConditionFromText "internal-server-error" = Just InternalServerError
stanzaErrorConditionFromText "item-not-found" = Just ItemNotFound stanzaErrorConditionFromText "item-not-found" = Just ItemNotFound
stanzaErrorConditionFromText "jid-malformed" = Just JidMalformed stanzaErrorConditionFromText "jid-malformed" = Just JidMalformed
@ -407,7 +417,7 @@ xpStanzaErrorCondition = ("xpStanzaErrorCondition", "") <?>
stanzaErrorConditionFromText "not-authorized" = Just NotAuthorized stanzaErrorConditionFromText "not-authorized" = Just NotAuthorized
stanzaErrorConditionFromText "payment-required" = Just PaymentRequired stanzaErrorConditionFromText "payment-required" = Just PaymentRequired
stanzaErrorConditionFromText "recipient-unavailable" = Just RecipientUnavailable stanzaErrorConditionFromText "recipient-unavailable" = Just RecipientUnavailable
stanzaErrorConditionFromText "redirect" = Just Redirect stanzaErrorConditionFromText "redirect" = Just $ Redirect Nothing
stanzaErrorConditionFromText "registration-required" = Just RegistrationRequired stanzaErrorConditionFromText "registration-required" = Just RegistrationRequired
stanzaErrorConditionFromText "remote-server-not-found" = Just RemoteServerNotFound stanzaErrorConditionFromText "remote-server-not-found" = Just RemoteServerNotFound
stanzaErrorConditionFromText "remote-server-timeout" = Just RemoteServerTimeout stanzaErrorConditionFromText "remote-server-timeout" = Just RemoteServerTimeout

4
source/Network/Xmpp/Types.hs

@ -289,7 +289,7 @@ data StanzaErrorCondition = BadRequest -- ^ Malformed XML.
-- name already exists. -- name already exists.
| FeatureNotImplemented | FeatureNotImplemented
| Forbidden -- ^ Insufficient permissions. | Forbidden -- ^ Insufficient permissions.
| Gone -- ^ Entity can no longer be | Gone (Maybe Text) -- ^ Entity can no longer be
-- contacted at this -- contacted at this
-- address. -- address.
| InternalServerError | InternalServerError
@ -303,7 +303,7 @@ data StanzaErrorCondition = BadRequest -- ^ Malformed XML.
-- credentials. -- credentials.
| PaymentRequired | PaymentRequired
| RecipientUnavailable -- ^ Temporarily unavailable. | RecipientUnavailable -- ^ Temporarily unavailable.
| Redirect -- ^ Redirecting to other | Redirect (Maybe Text) -- ^ Redirecting to other
-- entity, usually -- entity, usually
-- temporarily. -- temporarily.
| RegistrationRequired | RegistrationRequired

Loading…
Cancel
Save