diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -14,8 +14,12 @@
_Note:_ Pontarius XMPP is still in its Alpha phase. Pontarius XMPP is not yet
feature-complete, it may contain bugs, and its API may change between versions.
-The first thing to do is to import the modules that we are going to use.
+The first thing to do is to import the modules that we are going to use. We are
+also using the OverloadedStrings LANGUAGE pragma in order to be able to type
+Text values like strings.
+ {-# LANGUAGE OverloadedStrings #-}
+
import Network.Xmpp
import Control.Monad
@@ -34,9 +38,6 @@
"example.com"
def
(Just ([scramSha1 "username" Nothing "password"], Nothing))
-
-_Tip:_ Note that the first parameter actually is a Text value. Import
-Data.Text and use the OverloadedStrings LANGUAGE pragma.
The three parameters above are the XMPP server realm, the session configuration
settings (set to the default settings), and a SASL handler (for authentication).
diff --git a/pontarius-xmpp.cabal b/pontarius-xmpp.cabal
--- a/pontarius-xmpp.cabal
+++ b/pontarius-xmpp.cabal
@@ -1,5 +1,5 @@
Name: pontarius-xmpp
-Version: 0.2.0.0
+Version: 0.2.0.1
Cabal-Version: >= 1.6
Build-Type: Simple
License: OtherLicense
@@ -11,13 +11,20 @@
Stability: alpha
Homepage: https://github.com/jonkri/pontarius-xmpp/
Bug-Reports: mailto:info@jonkri.com
-Package-URL: http://www.jonkri.com/releases/pontarius-xmpp-0.2.0.0.tar.gz
+Package-URL: http://www.jonkri.com/releases/pontarius-xmpp-0.2.0.1.tar.gz
Synopsis: An incomplete implementation of RFC 6120 (XMPP: Core)
Description: Pontarius XMPP is a work in progress implementation of
RFC 6120 (XMPP: Core).
Category: Network
Tested-With: GHC ==7.0.4, GHC ==7.4.1
+Extra-Source-Files: README.md
+ , examples/echoclient/echoclient.cabal
+ , examples/echoclient/LICENSE.md
+ , examples/echoclient/Main.hs
+ , examples/echoclient/README.md
+ , examples/echoclient/Setup.hs
+
Library
hs-source-dirs: source
Exposed: True
@@ -84,4 +91,4 @@
Source-Repository this
Type: git
Location: git://github.com/jonkri/pontarius-xmpp.git
- Tag: 0.2.0.0
+ Tag: 0.2.0.1
diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs
--- a/source/Network/Xmpp/Concurrent.hs
+++ b/source/Network/Xmpp/Concurrent.hs
@@ -8,14 +8,12 @@
, module Network.Xmpp.Concurrent.Message
, module Network.Xmpp.Concurrent.Presence
, module Network.Xmpp.Concurrent.IQ
- , toChans
+ , StanzaHandler
, newSession
, writeWorker
, session
) where
-import Network.Xmpp.Concurrent.Monad
-import Network.Xmpp.Concurrent.Threads
import Control.Applicative((<$>),(<*>))
import Control.Concurrent
import Control.Concurrent.STM
@@ -23,44 +21,56 @@
import qualified Data.ByteString as BS
import Data.IORef
import qualified Data.Map as Map
+import Data.Maybe
import Data.Maybe (fromMaybe)
+import Data.Text as Text
import Data.XML.Types
+import Network
+import qualified Network.TLS as TLS
import Network.Xmpp.Concurrent.Basic
import Network.Xmpp.Concurrent.IQ
import Network.Xmpp.Concurrent.Message
+import Network.Xmpp.Concurrent.Monad
import Network.Xmpp.Concurrent.Presence
-import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Concurrent.Threads
+import Network.Xmpp.Concurrent.Threads
+import Network.Xmpp.Concurrent.Types
import Network.Xmpp.Marshal
-import Network.Xmpp.Types
-import Network
-import Data.Text as Text
-import Network.Xmpp.Tls
-import qualified Network.TLS as TLS
import Network.Xmpp.Sasl
import Network.Xmpp.Sasl.Mechanisms
import Network.Xmpp.Sasl.Types
-import Data.Maybe
import Network.Xmpp.Stream
+import Network.Xmpp.Tls
+import Network.Xmpp.Types
import Network.Xmpp.Utilities
import Control.Monad.Error
-import Data.Default
-import System.Log.Logger
-import Control.Monad.State.Strict
+import Data.Default
+import System.Log.Logger
+import Control.Monad.State.Strict
-toChans :: TChan Stanza
- -> TChan Stanza
- -> TVar IQHandlers
- -> Stanza
- -> IO ()
-toChans stanzaC outC iqHands sta = atomically $ do
- writeTChan stanzaC sta
+runHandlers :: (TChan Stanza) -> [StanzaHandler] -> Stanza -> IO ()
+runHandlers _ [] _ = return ()
+runHandlers outC (h:hands) sta = do
+ res <- h outC sta
+ case res of
+ True -> runHandlers outC hands sta
+ False -> return ()
+
+toChan :: TChan Stanza -> StanzaHandler
+toChan stanzaC _ sta = do
+ atomically $ writeTChan stanzaC sta
+ return True
+
+
+handleIQ :: TVar IQHandlers
+ -> StanzaHandler
+handleIQ iqHands outC sta = atomically $ do
case sta of
- IQRequestS i -> handleIQRequest iqHands i
- IQResultS i -> handleIQResponse iqHands (Right i)
- IQErrorS i -> handleIQResponse iqHands (Left i)
- _ -> return ()
+ IQRequestS i -> handleIQRequest iqHands i >> return False
+ IQResultS i -> handleIQResponse iqHands (Right i) >> return False
+ IQErrorS i -> handleIQResponse iqHands (Left i) >> return False
+ _ -> return True
where
-- If the IQ request has a namespace, send it through the appropriate channel.
handleIQRequest :: TVar IQHandlers -> IQRequest -> STM ()
@@ -96,15 +106,20 @@
stanzaChan <- lift newTChanIO
iqHandlers <- lift $ newTVarIO (Map.empty, Map.empty)
eh <- lift $ newTVarIO $ EventHandlers { connectionClosedHandler = sessionClosedHandler config }
- let stanzaHandler = toChans stanzaChan outC iqHandlers
+ let stanzaHandler = runHandlers outC $ Prelude.concat [ [toChan stanzaChan]
+ , extraStanzaHandlers
+ config
+ , [handleIQ iqHandlers]
+ ]
(kill, wLock, streamState, readerThread) <- ErrorT $ startThreadsWith stanzaHandler eh stream
writer <- lift $ forkIO $ writeWorker outC wLock
+ idGen <- liftIO $ sessionStanzaIDs config
return $ Session { stanzaCh = stanzaChan
, outCh = outC
, iqHandlers = iqHandlers
, writeRef = wLock
, readerThread = readerThread
- , idGenerator = sessionStanzaIDs config
+ , idGenerator = idGen
, streamRef = streamState
, eventHandlers = eh
, stopThreads = kill >> killThread writer
diff --git a/source/Network/Xmpp/Types.hs b/source/Network/Xmpp/Types.hs
--- a/source/Network/Xmpp/Types.hs
+++ b/source/Network/Xmpp/Types.hs
@@ -36,6 +36,7 @@
, StreamState(..)
, ConnectionState(..)
, StreamErrorInfo(..)
+ , StanzaHandler
, StreamConfiguration(..)
, langTag
, Jid(..)
@@ -52,45 +53,29 @@
)
where
+import Control.Applicative ((<$>), (<|>), many)
import Control.Concurrent.STM
import Control.Exception
import Control.Monad.Error
-import Control.Monad.IO.Class
-import Control.Monad.State.Strict
-
import qualified Data.Attoparsec.Text as AP
import qualified Data.ByteString as BS
import Data.Conduit
-import Data.IORef
-import Data.Maybe (fromJust, fromMaybe, maybeToList)
-import Data.String(IsString(..))
+import Data.Default
+import Data.Maybe (fromJust, maybeToList)
+import qualified Data.Set as Set
+import Data.String (IsString(..))
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Typeable(Typeable)
import Data.XML.Types
-
+import Network
+import Network.DNS
+import Network.Socket
import Network.TLS hiding (Version)
import Network.TLS.Extra
-
-import qualified Network as N
-
-import System.IO
-
-import Control.Applicative ((<$>), (<|>), many)
-import Control.Monad(guard)
-
-import qualified Data.Set as Set
-import Data.String (IsString(..))
import qualified Text.NamePrep as SP
import qualified Text.StringPrep as SP
-import Network
-import Network.DNS
-import Network.Socket
-
-import Data.Default
-import Data.IP
-
-- |
-- Wraps a string of random characters that, when using an appropriate
-- @IdGenerator@, is guaranteed to be unique for the Xmpp session.
@@ -776,8 +761,7 @@
subtag :: AP.Parser Text.Text
subtag = do
AP.skip (== '-')
- subtag <- tag
- return subtag
+ tag
tagChars :: [Char]
tagChars = ['a'..'z'] ++ ['A'..'Z']
@@ -874,7 +858,7 @@
-- the entity associated with an XMPP localpart at a domain
-- (i.e., @localpart\@domainpart/resourcepart@).
, resourcepart :: !(Maybe Text)
- } deriving Eq
+ } deriving (Eq, Ord)
instance Show Jid where
show (Jid nd dmn res) =
@@ -957,9 +941,9 @@
-- Case 2: We found a '/'; the JID is in the form
-- domainpart/resourcepart.
<|> do
- b <- resourcePartP
+ b' <- resourcePartP
AP.endOfInput
- return (Nothing, a, Just b)
+ return (Nothing, a, Just b')
-- Case 3: We have reached EOF; we have an JID consisting of only a
-- domainpart.
<|> do
@@ -1105,6 +1089,10 @@
then fail "Hostname too long."
else return $ Text.concat [label, Text.pack ".", r]
+type StanzaHandler = TChan Stanza -- ^ outgoing stanza
+ -> Stanza -- ^ stanza to handle
+ -> IO Bool -- ^ True when processing should continue
+
-- | Configuration for the @Session@ object.
data SessionConfiguration = SessionConfiguration
{ -- | Configuration for the @Stream@ object.
@@ -1112,7 +1100,8 @@
-- | Handler to be run when the session ends (for whatever reason).
, sessionClosedHandler :: XmppFailure -> IO ()
-- | Function to generate the stream of stanza identifiers.
- , sessionStanzaIDs :: IO StanzaID
+ , sessionStanzaIDs :: IO (IO StanzaID)
+ , extraStanzaHandlers :: [StanzaHandler]
}
instance Default SessionConfiguration where
@@ -1120,10 +1109,11 @@
, sessionClosedHandler = \_ -> return ()
, sessionStanzaIDs = do
idRef <- newTVarIO 1
- atomically $ do
+ return . atomically $ do
curId <- readTVar idRef
writeTVar idRef (curId + 1 :: Integer)
- return . read. show $ curId
+ return . StanzaID . Text.pack . show $ curId
+ , extraStanzaHandlers = []
}
-- | How the client should behave in regards to TLS.