Merge branch 'master' of https://github.com/Philonous/pontarius

Conflicts:
	source/Network/Xmpp/Stream.hs

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)
   --
   -- <http://xmpp.org/rfcs/rfc6120.html#stanzas-semantics-iq>

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
+                        Text          -- Thread ID
-                        (Maybe Text)  -- ^ Parent Thread
+                        (Maybe Text)  -- Parent Thread
 data MessageSubject = MessageSubject (Maybe LangTag) Text
 
 xpMessageSubject :: PU [Element] MessageSubject

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

source/Network/Xmpp/Stream.hs

@@ -67,7 +67,7 @@ xmppStartStream = runErrorT $ do
         Just hostname -> lift $ do
             pushXmlDecl
             pushOpenElement $
-                pickleElem pickleOutStream (Nothing, Just hostname, (pack . show) <$> lang)
+                pickleElem pickleOutStream (Nothing, Just hostname, lang)
     (lt, features) <- ErrorT . pullToSink $ runErrorT xmppStream
     modify (\s -> s {sFeatures = features, sStreamLang = Just lt})
     return ()
@@ -102,7 +102,6 @@ xmppStream = do
         unless (prefix == Just "stream") $ throwError $ StreamInvalidStreamPrefix prefix
         unless (ver == Just "1.0") $ throwError $ StreamWrongVersion ver
         -- TODO: Verify id, to, from, and stream:xmlns.
-        liftIO $ print (from, id, to, ver, lang, xns)
         let lang_ = maybe Nothing langTag lang
         when (isNothing lang_) $ throwError $ StreamWrongLangTag lang
         return $ fromJust lang_
@@ -111,7 +110,7 @@ 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 for the stream element to be sent to the server. Version "1.0" is
 -- assumed, and so is the "jabber:client" xmlns and
@@ -119,7 +118,7 @@ xmppStream = do
 -- RFC 6120 calls the "content-namespace-as-default-namespace".)
 pickleOutStream :: PU [Node] ( Maybe Text -- from
                              , Maybe Text -- to
-                             , Maybe Text -- xml:lang
+                             , Maybe LangTag -- xml:lang
                              )
 pickleOutStream = xpWrap
     (\(from, to, _ver, lang) -> (from, to, lang))
@@ -136,7 +135,7 @@ pickleOutStream = xpWrap
               (xpAttrImplied "from" xpId)
               (xpAttrImplied "to" xpId)
               (xpAttr "version" xpId)
-              (xpAttrImplied (Name "lang" (Just "http://www.w3.org/XML/1998/namespace") (Just "xml")) xpId)
+              xpLangTag
          )
     )
 
@@ -166,8 +165,8 @@ pickleInStream = xpElemWithName
     xpUnit
  
 -- Pickler/Unpickler for the stream features - TLS, SASL, and the rest.
-pickleStreamFeatures :: PU [Node] ServerFeatures
+xpStreamFeatures :: PU [Node] ServerFeatures
-pickleStreamFeatures = xpWrap
+xpStreamFeatures = xpWrap
     (\(tls, sasl, rest) -> SF tls (mbl sasl) rest)
     (\(SF tls sasl rest) -> (tls, lmb sasl, rest))
     (xpElemNodes

source/Network/Xmpp/Types.hs

@@ -91,7 +91,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
@@ -377,8 +377,6 @@ instance Read StanzaErrorCondition where
 --  OTHER STUFF
 -- =============================================================================
 
-data SaslMechanism = DigestMD5 deriving Show
-
 data SaslFailure = SaslFailure { saslFailureCondition :: SaslError
                                , saslFailureText :: Maybe ( Maybe LangTag
                                                           , Text
@@ -440,33 +438,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
+    = StreamBadFormat -- ^ The entity has sent XML that cannot be processed.
-    | StreamBadNamespacePrefix
+    | StreamBadNamespacePrefix -- ^ The entity has sent a namespace prefix that
-    | StreamConflict
+                               -- is unsupported, or has sent no namespace
-    | StreamConnectionTimeout
+                               -- prefix on an element that needs such a prefix
-    | StreamHostGone
+    | StreamConflict -- ^ The server either (1) is closing the existing stream
-    | StreamHostUnknown
+                     -- for this entity because a new stream has been initiated
-    | StreamImproperAddressing
+                     -- that conflicts with the existing stream, or (2) is
-    | StreamInternalServerError
+                     -- refusing a new stream for this entity because allowing
-    | StreamInvalidFrom
+                     -- the new stream would conflict with an existing stream
-    | StreamInvalidNamespace
+                     -- (e.g., because the server allows only a certain number
-    | StreamInvalidXml
+                     -- of connections from the same IP address or allows only
-    | StreamNotAuthorized
+                     -- one server-to-server stream for a given domain pair as a
-    | StreamNotWellFormed
+                     -- way of helping to ensure in-order processing
-    | StreamPolicyViolation
+    | StreamConnectionTimeout -- ^ One party is closing the stream because it
-    | StreamRemoteConnectionFailed
+                              -- has reason to believe that the other party has
-    | StreamReset
+                              -- permanently lost the ability to communicate
-    | StreamResourceConstraint
+                              -- over the stream.
-    | StreamRestrictedXml
+    | StreamHostGone -- ^ The value of the 'to' attribute provided in the
-    | StreamSeeOtherHost
+                     -- initial stream header corresponds to an FQDN that is no
-    | StreamSystemShutdown
+                     -- longer serviced by the receiving entity
-    | StreamUndefinedCondition
+    | StreamHostUnknown -- ^ The value of the 'to' attribute provided in the
-    | StreamUnsupportedEncoding
+                        -- initial stream header does not correspond to an FQDN
-    | StreamUnsupportedFeature
+                        -- that is serviced by the receiving entity.
-    | StreamUnsupportedStanzaType
+    | StreamImproperAddressing -- ^ A stanza sent between two servers lacks a
-    | StreamUnsupportedVersion
+                               -- '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 \<text/\> 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
+                                   -- <internal-server-error/> 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