From 7f4929c28942b2a0f7cc237251690d7563bdc35c Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Fri, 15 Jun 2012 20:24:23 +0200 Subject: [PATCH 1/2] document StremErrorCondition some minor documentation improvements --- source/Network/Xmpp.hs | 2 +- source/Network/Xmpp/IM/Message.hs | 4 +- source/Network/Xmpp/Types.hs | 144 ++++++++++++++++++++++++------ 3 files changed, 118 insertions(+), 32 deletions(-) diff --git a/source/Network/Xmpp.hs b/source/Network/Xmpp.hs index abaad61..3a1233e 100644 --- a/source/Network/Xmpp.hs +++ b/source/Network/Xmpp.hs @@ -123,7 +123,7 @@ module Network.Xmpp -- is defined by the schema or other structural definition associated with the -- XML namespace that qualifies the direct child element of the IQ element. IQ -- interactions follow a common pattern of structured data exchange such as - -- get/result or set/result (although an error can be returned in reply to a + -- get\/result or set\/result (although an error can be returned in reply to a -- request if appropriate) -- -- diff --git a/source/Network/Xmpp/IM/Message.hs b/source/Network/Xmpp/IM/Message.hs index 45463a9..45b5193 100644 --- a/source/Network/Xmpp/IM/Message.hs +++ b/source/Network/Xmpp/IM/Message.hs @@ -14,8 +14,8 @@ import Network.Xmpp.Pickle data MessageBody = MessageBody (Maybe LangTag) Text data MessageThread = MessageThread - Text -- ^ Thread ID - (Maybe Text) -- ^ Parent Thread + Text -- Thread ID + (Maybe Text) -- Parent Thread data MessageSubject = MessageSubject (Maybe LangTag) Text xpMessageSubject :: PU [Element] MessageSubject diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 704e4ca..cd683bb 100644 --- a/source/Network/Xmpp/Types.hs +++ b/source/Network/Xmpp/Types.hs @@ -89,7 +89,7 @@ data Stanza = IQRequestS IQRequest deriving Show -- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as --- type. They are guaranteed to always contain a payload. +-- type. It always contains an xml payload. data IQRequest = IQRequest { iqRequestID :: StanzaId , iqRequestFrom :: Maybe Jid , iqRequestTo :: Maybe Jid @@ -375,8 +375,6 @@ instance Read StanzaErrorCondition where -- OTHER STUFF -- ============================================================================= -data SaslMechanism = DigestMD5 deriving Show - data SaslFailure = SaslFailure { saslFailureCondition :: SaslError , saslFailureText :: Maybe ( Maybe LangTag , Text @@ -438,33 +436,121 @@ instance Read SaslError where readsPrec _ "temporary-auth-failure" = [(SaslTemporaryAuthFailure , "")] readsPrec _ _ = [] --- TODO: document the error cases +-- The documentation of StreamErrorConditions is copied from +-- http://xmpp.org/rfcs/rfc6120.html#streams-error-conditions data StreamErrorCondition - = StreamBadFormat - | StreamBadNamespacePrefix - | StreamConflict - | StreamConnectionTimeout - | StreamHostGone - | StreamHostUnknown - | StreamImproperAddressing - | StreamInternalServerError - | StreamInvalidFrom - | StreamInvalidNamespace - | StreamInvalidXml - | StreamNotAuthorized - | StreamNotWellFormed - | StreamPolicyViolation - | StreamRemoteConnectionFailed - | StreamReset - | StreamResourceConstraint - | StreamRestrictedXml - | StreamSeeOtherHost - | StreamSystemShutdown - | StreamUndefinedCondition - | StreamUnsupportedEncoding - | StreamUnsupportedFeature - | StreamUnsupportedStanzaType - | StreamUnsupportedVersion + = StreamBadFormat -- ^ The entity has sent XML that cannot be processed. + | StreamBadNamespacePrefix -- ^ The entity has sent a namespace prefix that + -- is unsupported, or has sent no namespace + -- prefix on an element that needs such a prefix + | StreamConflict -- ^ The server either (1) is closing the existing stream + -- for this entity because a new stream has been initiated + -- that conflicts with the existing stream, or (2) is + -- refusing a new stream for this entity because allowing + -- the new stream would conflict with an existing stream + -- (e.g., because the server allows only a certain number + -- of connections from the same IP address or allows only + -- one server-to-server stream for a given domain pair as a + -- way of helping to ensure in-order processing + | StreamConnectionTimeout -- ^ One party is closing the stream because it + -- has reason to believe that the other party has + -- permanently lost the ability to communicate + -- over the stream. + | StreamHostGone -- ^ The value of the 'to' attribute provided in the + -- initial stream header corresponds to an FQDN that is no + -- longer serviced by the receiving entity + | StreamHostUnknown -- ^ The value of the 'to' attribute provided in the + -- initial stream header does not correspond to an FQDN + -- that is serviced by the receiving entity. + | StreamImproperAddressing -- ^ A stanza sent between two servers lacks a + -- 'to' or 'from' attribute, the 'from' or 'to' + -- attribute has no value, or the value violates + -- the rules for XMPP addresses + | StreamInternalServerError -- ^ The server has experienced a + -- misconfiguration or other internal error that + -- prevents it from servicing the stream. + | StreamInvalidFrom -- ^ The data provided in a 'from' attribute does not + -- match an authorized JID or validated domain as + -- negotiated (1) between two servers using SASL or + -- Server Dialback, or (2) between a client and a server + -- via SASL authentication and resource binding. + | StreamInvalidNamespace -- ^ The stream namespace name is something other + -- than "http://etherx.jabber.org/streams" (see + -- Section 11.2) or the content namespace declared + -- as the default namespace is not supported (e.g., + -- something other than "jabber:client" or + -- "jabber:server"). + | StreamInvalidXml -- ^ The entity has sent invalid XML over the stream to a + -- server that performs validation + | StreamNotAuthorized -- ^ The entity has attempted to send XML stanzas or + -- other outbound data before the stream has been + -- authenticated, or otherwise is not authorized to + -- perform an action related to stream negotiation; + -- the receiving entity MUST NOT process the offending + -- data before sending the stream error. + | StreamNotWellFormed -- ^ The initiating entity has sent XML that violates + -- the well-formedness rules of [XML] or [XML‑NAMES]. + | StreamPolicyViolation -- ^ The entity has violated some local service + -- policy (e.g., a stanza exceeds a configured size + -- limit); the server MAY choose to specify the + -- policy in the \ element or in an + -- application-specific condition element. + | StreamRemoteConnectionFailed -- ^ The server is unable to properly connect + -- to a remote entity that is needed for + -- authentication or authorization (e.g., in + -- certain scenarios related to Server + -- Dialback [XEP‑0220]); this condition is + -- not to be used when the cause of the error + -- is within the administrative domain of the + -- XMPP service provider, in which case the + -- condition is more + -- appropriate. + | StreamReset -- ^ The server is closing the stream because it has new + -- (typically security-critical) features to offer, because + -- the keys or certificates used to establish a secure context + -- for the stream have expired or have been revoked during the + -- life of the stream , because the TLS sequence number has + -- wrapped, etc. The reset applies to the stream and to any + -- security context established for that stream (e.g., via TLS + -- and SASL), which means that encryption and authentication + -- need to be negotiated again for the new stream (e.g., TLS + -- session resumption cannot be used) + | StreamResourceConstraint -- ^ The server lacks the system resources + -- necessary to service the stream. + | StreamRestrictedXml -- ^ he entity has attempted to send restricted XML + -- features such as a comment, processing instruction, + -- DTD subset, or XML entity reference + | StreamSeeOtherHost -- ^ The server will not provide service to the + -- initiating entity but is redirecting traffic to + -- another host under the administrative control of the + -- same service provider. + | StreamSystemShutdown -- ^ The server is being shut down and all active + -- streams are being closed. + | StreamUndefinedCondition -- ^ The error condition is not one of those + -- defined by the other conditions in this list + | StreamUnsupportedEncoding -- ^ The initiating entity has encoded the + -- stream in an encoding that is not supported + -- by the server or has otherwise improperly + -- encoded the stream (e.g., by violating the + -- rules of the [UTF‑8] encoding). + | StreamUnsupportedFeature -- ^ The receiving entity has advertised a + -- mandatory-to-negotiate stream feature that the + -- initiating entity does not support, and has + -- offered no other mandatory-to-negotiate + -- feature alongside the unsupported feature. + | StreamUnsupportedStanzaType -- ^ The initiating entity has sent a + -- first-level child of the stream that is not + -- supported by the server, either because the + -- receiving entity does not understand the + -- namespace or because the receiving entity + -- does not understand the element name for + -- the applicable namespace (which might be + -- the content namespace declared as the + -- default namespace) + | StreamUnsupportedVersion -- ^ The 'version' attribute provided by the + -- initiating entity in the stream header + -- specifies a version of XMPP that is not + -- supported by the server. deriving Eq instance Show StreamErrorCondition where From fe5da1a5bc01a580631540fc8cefb7cb246a4151 Mon Sep 17 00:00:00 2001 From: Philipp Balzarek Date: Sun, 17 Jun 2012 02:04:29 +0200 Subject: [PATCH 2/2] fix xpLangTag add language tag to stream pickler --- source/Network/Xmpp/Pickle.hs | 2 +- source/Network/Xmpp/Stream.hs | 20 ++++++++++++-------- 2 files changed, 13 insertions(+), 9 deletions(-) diff --git a/source/Network/Xmpp/Pickle.hs b/source/Network/Xmpp/Pickle.hs index 3c5bbc8..9937e72 100644 --- a/source/Network/Xmpp/Pickle.hs +++ b/source/Network/Xmpp/Pickle.hs @@ -38,7 +38,7 @@ xpElemEmpty name = xpWrap (\((),()) -> ()) xpElem name xpUnit xpUnit xmlLang :: Name -xmlLang = Name "lang" Nothing (Just "xml") +xmlLang = Name "lang" (Just "http://www.w3.org/XML/1998/namespace") (Just "xml") xpLangTag :: PU [Attribute] (Maybe LangTag) xpLangTag = xpAttrImplied xmlLang xpPrim diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 52fba97..eecd4f5 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/source/Network/Xmpp/Stream.hs @@ -64,7 +64,8 @@ xmppStartStream = runErrorT $ do Just hostname -> lift $ do pushXmlDecl pushOpenElement $ - pickleElem pickleStream ("1.0", Nothing, Just hostname) + -- TODO: set lang tag + pickleElem xpStream ("1.0", Nothing, Just hostname, Nothing) features <- ErrorT . pullToSink $ runErrorT xmppStream modify (\s -> s {sFeatures = features}) return () @@ -87,7 +88,9 @@ xmppStream = do xmppStreamHeader :: StreamSink () xmppStreamHeader = do lift $ throwOutJunk - (ver, _, _) <- streamUnpickleElem pickleStream =<< openElementFromEvents + -- TODO: Do somehting with the lang tag + (ver, _, _, lang) <- streamUnpickleElem xpStream + =<< openElementFromEvents unless (ver == "1.0") . throwError $ StreamWrongVersion ver return () xmppStreamFeatures :: StreamSink ServerFeatures @@ -95,21 +98,22 @@ xmppStream = do e <- lift $ elements =$ CL.head case e of Nothing -> liftIO $ Ex.throwIO StreamConnectionError - Just r -> streamUnpickleElem pickleStreamFeatures r + Just r -> streamUnpickleElem xpStreamFeatures r -- Pickler/Unpickler for the stream, with the version, from and to attributes. -pickleStream :: PU [Node] (Text, Maybe Text, Maybe Text) -pickleStream = xpElemAttrs +xpStream :: PU [Node] (Text, Maybe Text, Maybe Text, Maybe LangTag) +xpStream = xpElemAttrs (Name "stream" (Just "http://etherx.jabber.org/streams") (Just "stream")) - (xpTriple + (xp4Tuple (xpAttr "version" xpId) (xpOption $ xpAttr "from" xpId) (xpOption $ xpAttr "to" xpId) + xpLangTag ) -- Pickler/Unpickler for the stream features - TLS, SASL, and the rest. -pickleStreamFeatures :: PU [Node] ServerFeatures -pickleStreamFeatures = xpWrap +xpStreamFeatures :: PU [Node] ServerFeatures +xpStreamFeatures = xpWrap (\(tls, sasl, rest) -> SF tls (mbl sasl) rest) (\(SF tls sasl rest) -> (tls, lmb sasl, rest)) (xpElemNodes