Merge branch 'master' of github.com:pontarius/pontarius-xmpp

LICENSE.md

@@ -26,10 +26,10 @@ modification, are permitted provided that the following conditions are met:
 THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
 ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
 WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-DISCLAIMED. IN NO EVENT SHALL <COPYRIGHT HOLDER> BE LIABLE FOR ANY
+DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE PONTARIUS PROJECT BE
-DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
+LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
-LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
-SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

README.md

@@ -9,9 +9,14 @@ ADDR")](http://tools.ietf.org/html/rfc6122). Pontarius XMPP is part of [the
 Pontarius project](http://www.pontarius.org/), an effort to produce free and
 open source, uncentralized, and privacy-aware software solutions.
 
+While in alpha, Pontarius XMPP works quite well and fulfills most requirements
+of the RFCs.
+
 Prerequisites
 -------------
 
+Pontarius XMPP requires GHC 7.0, or later.
+
 You will need the ICU Unicode library and it's header files in order to be able
 to build Pontarius XMPP. On Debian, you will need to install the *libicu-dev*
 package. In Fedora, the package is called *libicu-devel*.
@@ -97,6 +102,10 @@ back to the recipient. This can be done like so:
             Just answer -> sendMessage answer sess
             Nothing -> putStrLn "Received message with no sender."
 
+You don't need to worry about escaping your <code>Text</code> values - Pontarius
+XMPP (or rather, [xml-picklers](https://github.com/Philonous/xml-picklers)) will
+take care of that for you.
+
 Additional XMPP threads can be created using <code>dupSession</code> and
 <code>forkIO</code>.
 

pontarius-xmpp.cabal

@@ -6,7 +6,7 @@ License:       BSD3
 License-File:  LICENSE.md
 Copyright:     Dmitry Astapov, Pierre Kovalev, Mahdi Abdinejadi, Jon Kristensen,
                IETF Trust, Philipp Balzarek
-Author:        Jon Kristensen, Mahdi Abdinejadi, Philipp Balzarek
+Author:        Jon Kristensen, Philipp Balzarek
 Maintainer:    info@jonkri.com
 Stability:     alpha
 Homepage:      https://github.com/pontarius/pontarius-xmpp/

source/Network/Xmpp/Concurrent.hs

@@ -295,5 +295,5 @@ doRetry sess@Session{reconnectWait = rw} = do
     reconnectNow sess
 
 
-newStanzaID :: Session -> IO StanzaID
+newStanzaID :: Session -> IO Text
 newStanzaID = idGenerator

source/Network/Xmpp/Concurrent/Types.hs

@@ -26,7 +26,7 @@ data SessionConfiguration = SessionConfiguration
       -- | Handler to be run when the session ends (for whatever reason).
     , onConnectionClosed         :: Session -> XmppFailure -> IO ()
       -- | Function to generate the stream of stanza identifiers.
-    , sessionStanzaIDs           :: IO (IO StanzaID)
+    , sessionStanzaIDs           :: IO (IO Text)
     , extraStanzaHandlers        :: [StanzaHandler]
     , enableRoster               :: Bool
     }
@@ -39,7 +39,7 @@ instance Default SessionConfiguration where
                                      return . atomically $ do
                                          curId <- readTVar idRef
                                          writeTVar idRef (curId + 1 :: Integer)
-                                         return . StanzaID . Text.pack . show $ curId
+                                         return . Text.pack . show $ curId
                                , extraStanzaHandlers = []
                                , enableRoster = True
                                }
@@ -67,7 +67,7 @@ data Session = Session
       -- Fields below are from Context.
     , writeSemaphore :: WriteSemaphore
     , readerThread :: ThreadId
-    , idGenerator :: IO StanzaID
+    , idGenerator :: IO Text
       -- | Lock (used by withStream) to make sure that a maximum of one
       -- Stream action is executed at any given time.
     , streamRef :: TMVar Stream
@@ -80,10 +80,11 @@ data Session = Session
     , reconnectWait :: TVar Int
     }
 
--- | IQHandlers holds the registered channels for incomming IQ requests and
+-- | IQHandlers holds the registered channels for incoming IQ requests and
--- TMVars of and TMVars for expected IQ responses
+-- TMVars of and TMVars for expected IQ responses (the second Text represent a
+-- stanza identifier.
 type IQHandlers = (Map.Map (IQRequestType, Text) (TChan IQRequestTicket)
-                  , Map.Map StanzaID (TMVar IQResponse)
+                  , Map.Map Text (TMVar IQResponse)
                   )
 
 -- | Contains whether or not a reply has been sent, and the IQ request body to

source/Network/Xmpp/Internal.hs

@@ -30,7 +30,6 @@ module Network.Xmpp.Internal
   , pullStanza
   , pushIQ
   , SaslHandler
-  , StanzaID(..)
   , Stanza(..)
   , TlsBehaviour(..)
  )

source/Network/Xmpp/Marshal.hs

@@ -48,7 +48,7 @@ xpMessage = ("xpMessage" , "") <?+> xpWrap
     (xpElem "{jabber:client}message"
          (xp5Tuple
              (xpDefault Normal $ xpAttr "type" xpMessageType)
-             (xpAttrImplied "id"   xpStanzaID)
+             (xpAttrImplied "id"   xpId)
              (xpAttrImplied "from" xpJid)
              (xpAttrImplied "to"   xpJid)
              xpLangTag
@@ -63,7 +63,7 @@ xpPresence = ("xpPresence" , "") <?+> xpWrap
     (\(Presence qid from to lang tp ext) -> ((qid, from, to, lang, tp), ext))
     (xpElem "{jabber:client}presence"
          (xp5Tuple
-              (xpAttrImplied "id"   xpStanzaID)
+              (xpAttrImplied "id"   xpId)
               (xpAttrImplied "from" xpJid)
               (xpAttrImplied "to"   xpJid)
               xpLangTag
@@ -78,7 +78,7 @@ xpIQRequest = ("xpIQRequest" , "") <?+> xpWrap
     (\(IQRequest qid from to lang tp body) -> ((qid, from, to, lang, tp), body))
     (xpElem "{jabber:client}iq"
          (xp5Tuple
-             (xpAttr        "id"   xpStanzaID)
+             (xpAttr        "id"   xpId)
              (xpAttrImplied "from" xpJid)
              (xpAttrImplied "to"   xpJid)
              xpLangTag
@@ -93,7 +93,7 @@ xpIQResult = ("xpIQResult" , "") <?+> xpWrap
     (\(IQResult qid from to lang body) -> ((qid, from, to, lang, ()), body))
     (xpElem "{jabber:client}iq"
          (xp5Tuple
-             (xpAttr        "id"   xpStanzaID)
+             (xpAttr        "id"   xpId)
              (xpAttrImplied "from" xpJid)
              (xpAttrImplied "to"   xpJid)
              xpLangTag
@@ -142,7 +142,7 @@ xpMessageError = ("xpMessageError" , "") <?+> xpWrap
     (xpElem "{jabber:client}message"
          (xp5Tuple
               (xpAttrFixed   "type" "error")
-              (xpAttrImplied "id"   xpStanzaID)
+              (xpAttrImplied "id"   xpId)
               (xpAttrImplied "from" xpJid)
               (xpAttrImplied "to"   xpJid)
               (xpAttrImplied xmlLang xpLang)
@@ -159,7 +159,7 @@ xpPresenceError = ("xpPresenceError" , "") <?+> xpWrap
         ((qid, from, to, lang, ()), (err, ext)))
     (xpElem "{jabber:client}presence"
          (xp5Tuple
-              (xpAttrImplied "id"   xpStanzaID)
+              (xpAttrImplied "id"   xpId)
               (xpAttrImplied "from" xpJid)
               (xpAttrImplied "to"   xpJid)
               xpLangTag
@@ -176,7 +176,7 @@ xpIQError = ("xpIQError" , "") <?+> xpWrap
         ((qid, from, to, lang, ()), (err, body)))
     (xpElem "{jabber:client}iq"
          (xp5Tuple
-              (xpAttr        "id"   xpStanzaID)
+              (xpAttr        "id"   xpId)
               (xpAttrImplied "from" xpJid)
               (xpAttrImplied "to"   xpJid)
               xpLangTag
@@ -292,16 +292,6 @@ xpJid = ("xpJid", "") <?>
                                    Just j -> Right j)
                   jidToText
 
-xpStanzaID :: PU Text StanzaID
-xpStanzaID = ("xpStanzaID", "") <?>
-        xpPartial ( \input -> case stanzaIDFromText input of
-                                   Nothing -> Left "Could not parse StanzaID."
-                                   Just j -> Right j)
-                  stanzaIDToText
-  where
-    stanzaIDFromText t = Just $ StanzaID t
-    stanzaIDToText (StanzaID s) = s
-
 xpIQRequestType :: PU Text IQRequestType
 xpIQRequestType = ("xpIQRequestType", "") <?>
         xpPartial ( \input -> case iqRequestTypeFromText input of

source/Network/Xmpp/Stream.hs

@@ -752,7 +752,7 @@ killStream = withStream $ do
 
 -- Sends an IQ request and waits for the response. If the response ID does not
 -- match the outgoing ID, an error is thrown.
-pushIQ :: StanzaID
+pushIQ :: Text
        -> Maybe Jid
        -> IQRequestType
        -> Maybe LangTag

source/Network/Xmpp/Types.hs

@@ -18,7 +18,6 @@ module Network.Xmpp.Types
     , IQRequestType(..)
     , IQResponse(..)
     , IQResult(..)
-    , IdGenerator(..)
     , LangTag (..)
     , langTagFromText
     , langTagToText
@@ -38,7 +37,6 @@ module Network.Xmpp.Types
     , StanzaError(..)
     , StanzaErrorCondition(..)
     , StanzaErrorType(..)
-    , StanzaID(..)
     , XmppFailure(..)
     , StreamErrorCondition(..)
     , Version(..)
@@ -97,15 +95,6 @@ import           Network.TLS.Extra
 import qualified Text.NamePrep as SP
 import qualified Text.StringPrep as SP
 
--- |
--- Wraps a string of random characters that, when using an appropriate
--- @IdGenerator@, is guaranteed to be unique for the Xmpp session.
-
-data StanzaID = StanzaID !Text deriving (Eq, Ord, Read, Show)
-
-instance IsString StanzaID where
-  fromString = StanzaID . Text.pack
-
 -- | The Xmpp communication primities (Message, Presence and Info/Query) are
 -- called stanzas.
 data Stanza = IQRequestS     !IQRequest
@@ -119,7 +108,7 @@ data Stanza = IQRequestS     !IQRequest
 
 -- | A "request" Info/Query (IQ) stanza is one with either "get" or "set" as
 -- type. It always contains an xml payload.
-data IQRequest = IQRequest { iqRequestID      :: !StanzaID
+data IQRequest = IQRequest { iqRequestID      :: !Text
                            , iqRequestFrom    :: !(Maybe Jid)
                            , iqRequestTo      :: !(Maybe Jid)
                            , iqRequestLangTag :: !(Maybe LangTag)
@@ -138,7 +127,7 @@ data IQResponse = IQResponseError IQError
                 deriving Show
 
 -- | The (non-error) answer to an IQ request.
-data IQResult = IQResult { iqResultID      :: !StanzaID
+data IQResult = IQResult { iqResultID      :: !Text
                          , iqResultFrom    :: !(Maybe Jid)
                          , iqResultTo      :: !(Maybe Jid)
                          , iqResultLangTag :: !(Maybe LangTag)
@@ -146,7 +135,7 @@ data IQResult = IQResult { iqResultID      :: !StanzaID
                          } deriving Show
 
 -- | The answer to an IQ request that generated an error.
-data IQError = IQError { iqErrorID          :: !StanzaID
+data IQError = IQError { iqErrorID          :: !Text
                        , iqErrorFrom        :: !(Maybe Jid)
                        , iqErrorTo          :: !(Maybe Jid)
                        , iqErrorLangTag     :: !(Maybe LangTag)
@@ -155,7 +144,7 @@ data IQError = IQError { iqErrorID          :: !StanzaID
                        } deriving Show
 
 -- | The message stanza. Used for /push/ type communication.
-data Message = Message { messageID      :: !(Maybe StanzaID)
+data Message = Message { messageID      :: !(Maybe Text)
                        , messageFrom    :: !(Maybe Jid)
                        , messageTo      :: !(Maybe Jid)
                        , messageLangTag :: !(Maybe LangTag)
@@ -179,7 +168,7 @@ instance Default Message where
     def = message
 
 -- | An error stanza generated in response to a 'Message'.
-data MessageError = MessageError { messageErrorID          :: !(Maybe StanzaID)
+data MessageError = MessageError { messageErrorID          :: !(Maybe Text)
                                  , messageErrorFrom        :: !(Maybe Jid)
                                  , messageErrorTo          :: !(Maybe Jid)
                                  , messageErrorLangTag     :: !(Maybe LangTag)
@@ -226,7 +215,7 @@ data MessageType = -- | The message is sent in the context of a one-to-one chat
                  deriving (Eq, Read, Show)
 
 -- | The presence stanza. Used for communicating status updates.
-data Presence = Presence { presenceID      :: !(Maybe StanzaID)
+data Presence = Presence { presenceID      :: !(Maybe Text)
                          , presenceFrom    :: !(Maybe Jid)
                          , presenceTo      :: !(Maybe Jid)
                          , presenceLangTag :: !(Maybe LangTag)
@@ -248,7 +237,7 @@ instance Default Presence where
     def = presence
 
 -- | An error stanza generated in response to a 'Presence'.
-data PresenceError = PresenceError { presenceErrorID          :: !(Maybe StanzaID)
+data PresenceError = PresenceError { presenceErrorID          :: !(Maybe Text)
                                    , presenceErrorFrom        :: !(Maybe Jid)
                                    , presenceErrorTo          :: !(Maybe Jid)
                                    , presenceErrorLangTag     :: !(Maybe LangTag)
@@ -552,14 +541,6 @@ instance Error AuthFailure where
 --  XML TYPES
 -- =============================================================================
 
-
--- | Wraps a function that MUST generate a stream of unique Ids. The
---   strings MUST be appropriate for use in the stanza id attirubte.
---   For a default implementation, see @idGenerator@.
-
-newtype IdGenerator = IdGenerator (IO Text)
-
-
 -- | XMPP version number. Displayed as "<major>.<minor>". 2.4 is lesser than
 -- 2.13, which in turn is lesser than 12.3.