diff --git a/LICENSE.md b/LICENSE.md index 1ff545d..f9568c9 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -3,7 +3,7 @@ Copyright © 2005-2011 Pierre Kovalev Copyright © 2010-2011 Mahdi Abdinejadi Copyright © 2010-2013 Jon Kristensen Copyright © 2011 IETF Trust -Copyright © 2012-2013 Philipp Balzarek +Copyright © 2012-2013 Philipp Balzarek All rights reserved. @@ -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 BE LIABLE FOR ANY -DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR THE PONTARIUS PROJECT BE +LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR +CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE +GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT +OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md index 6877cdc..db96eac 100644 --- a/README.md +++ b/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 Text 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 dupSession and forkIO. diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal index 91bf5e3..4b930bb 100644 --- a/pontarius-xmpp.cabal +++ b/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/ diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index 76abc16..33c1251 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/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 diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 3c99f0b..976bcca 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/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 --- TMVars of and TMVars for expected IQ responses +-- | IQHandlers holds the registered channels for incoming IQ requests and +-- 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 diff --git a/source/Network/Xmpp/Internal.hs b/source/Network/Xmpp/Internal.hs index 151553f..59d2018 100644 --- a/source/Network/Xmpp/Internal.hs +++ b/source/Network/Xmpp/Internal.hs @@ -30,7 +30,6 @@ module Network.Xmpp.Internal , pullStanza , pushIQ , SaslHandler - , StanzaID(..) , Stanza(..) , TlsBehaviour(..) ) diff --git a/source/Network/Xmpp/Marshal.hs b/source/Network/Xmpp/Marshal.hs index 9d1d4e3..9a457a4 100644 --- a/source/Network/Xmpp/Marshal.hs +++ b/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 diff --git a/source/Network/Xmpp/Stream.hs b/source/Network/Xmpp/Stream.hs index 26f95d1..38c145f 100644 --- a/source/Network/Xmpp/Stream.hs +++ b/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 diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs index 3396cf0..f37b04b 100644 --- a/source/Network/Xmpp/Types.hs +++ b/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 ".". 2.4 is lesser than -- 2.13, which in turn is lesser than 12.3.