Merge remote-tracking branch 'nejla/master'

pontarius-xmpp.cabal

@@ -34,7 +34,7 @@ Library
                , binary            >=0.4.1
                , bytestring        >=0.9.1.9
                , conduit           >=0.5
-               , containers        >=0.4.0.0
+               , containers        >=0.5.0.0
                , crypto-api        >=0.9
                , crypto-random-api >=0.2
                , cryptohash        >=0.6.1
@@ -45,7 +45,7 @@ Library
                , iproute           >=1.2.4
                , lifted-base       >=0.1.0.1
                , mtl               >=2.0.0.0
-               , network           >=2.3
+               , network           >=2.4.1.0
                , pureMD5           >=2.1.2.1
                , resourcet         >=0.3.0
                , random            >=1.0.0.0

source/Network/Xmpp.hs

@@ -152,6 +152,7 @@ module Network.Xmpp
   , StanzaError(..)
   , StanzaErrorType(..)
   , StanzaErrorCondition(..)
+  , SaslFailure(..)
   -- * Threads
   , dupSession
   -- * Miscellaneous
@@ -163,6 +164,7 @@ module Network.Xmpp
                , AuthSaslFailure
                , AuthIllegalCredentials
                , AuthOtherFailure )
+  , SaslHandler(..)
   ) where
 
 import Network.Xmpp.Concurrent

source/Network/Xmpp/IM.hs

@@ -6,6 +6,8 @@ module Network.Xmpp.IM
   , MessageBody(..)
   , MessageThread(..)
   , MessageSubject(..)
+  , InstantMessage (..)
+  , Subscription(..)
   , instantMessage
   , simpleIM
   , getIM

source/Network/Xmpp/Internal.hs

@@ -31,6 +31,9 @@ module Network.Xmpp.Internal
   , pushIQ
   , SaslHandler
   , StanzaID(..)
+  , ConnectionState(..)
+  , Stanza(..)
+  , TlsBehaviour(..)
  )
 
        where

source/Network/Xmpp/Marshal.hs

@@ -65,7 +65,7 @@ xpPresence = ("xpPresence" , "") <?+> xpWrap
               (xpAttrImplied "from" xpPrim)
               (xpAttrImplied "to"   xpPrim)
               xpLangTag
-              (xpAttrImplied "type" xpPrim)
+              (xpAttr "type" $ xpWithDefault Available xpPrim)
          )
          (xpAll xpElemVerbatim)
     )

source/Network/Xmpp/Stanza.hs

@@ -27,26 +27,26 @@ presence = Presence { presenceID       = Nothing
                     , presenceFrom     = Nothing
                     , presenceTo       = Nothing
                     , presenceLangTag  = Nothing
-                    , presenceType     = Nothing
+                    , presenceType     = Available
                     , presencePayload  = []
                     }
 
 -- | Request subscription with an entity.
 presenceSubscribe :: Jid -> Presence
 presenceSubscribe to = presence { presenceTo = Just to
-                                , presenceType = Just Subscribe
+                                , presenceType = Subscribe
                                 }
 
 -- | Approve a subscripton of an entity.
 presenceSubscribed :: Jid -> Presence
 presenceSubscribed to = presence { presenceTo = Just to
-                                 , presenceType = Just Subscribed
+                                 , presenceType = Subscribed
                                  }
 
 -- | End a subscription with an entity.
 presenceUnsubscribe :: Jid -> Presence
 presenceUnsubscribe to = presence { presenceTo = Just to
-                                  , presenceType = Just Unsubscribed
+                                  , presenceType = Unsubscribed
                                   }
 
 -- | Signal to the server that the client is available for communication.
@@ -56,14 +56,15 @@ presenceOnline = presence
 -- | Signal to the server that the client is no longer available for
 -- communication.
 presenceOffline :: Presence
-presenceOffline = presence {presenceType = Just Unavailable}
+presenceOffline = presence {presenceType = Unavailable}
 
--- | Produce an answer message with the given payload, switching the "from" and
+-- | Produce an answer message with the given payload, setting "from" to the
 -- "to" attributes in the original message. Produces a 'Nothing' value of the
--- provided message message has no from attribute.
+-- provided message message has no "from" attribute. Sets the "from" attribute
+-- to 'Nothing' to let the server assign one.
 answerMessage :: Message -> [Element] -> Maybe Message
 answerMessage Message{messageFrom = Just frm, ..} payload =
-    Just Message{ messageFrom    = messageTo
+    Just Message{ messageFrom    = Nothing
                 , messageID      = Nothing
                 , messageTo      = Just frm
                 , messagePayload = payload

source/Network/Xmpp/Types.hs

@@ -220,7 +220,7 @@ data Presence = Presence { presenceID      :: !(Maybe StanzaID)
                          , presenceFrom    :: !(Maybe Jid)
                          , presenceTo      :: !(Maybe Jid)
                          , presenceLangTag :: !(Maybe LangTag)
-                         , presenceType    :: !(Maybe PresenceType)
+                         , presenceType    :: !PresenceType
                          , presencePayload :: ![Element]
                          } deriving Show
 
@@ -243,7 +243,8 @@ data PresenceType = Subscribe    | -- ^ Sender wants to subscribe to presence
                                    --   subscription
                     Probe        | -- ^ Sender requests current presence;
                                    --   should only be used by servers
-                    Default      |
+                    Available    | -- ^ Sender wants to express availability
+                                   --   (no type attribute is defined)
                     Unavailable deriving (Eq)
 
 instance Show PresenceType where
@@ -252,12 +253,12 @@ instance Show PresenceType where
     show Unsubscribe  = "unsubscribe"
     show Unsubscribed = "unsubscribed"
     show Probe        = "probe"
-    show Default      = ""
+    show Available    = ""
     show Unavailable  = "unavailable"
 
 instance Read PresenceType where
-    readsPrec _  ""             = [(Default, "")]
+    readsPrec _  ""             = [(Available, "")]
-    readsPrec _  "available"    = [(Default, "")]
+    readsPrec _  "available"    = [(Available, "")]
     readsPrec _  "unavailable"  = [(Unavailable, "")]
     readsPrec _  "subscribe"    = [(Subscribe, "")]
     readsPrec _  "subscribed"   = [(Subscribed, "")]