pontarius-xmpp 0.2.0.0 → 0.2.0.1

raw patch · 4 files changed

+78/−65 lines, 4 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• README.md +5/−4
• pontarius-xmpp.cabal +10/−3
• source/Network/Xmpp/Concurrent.hs +41/−26
• source/Network/Xmpp/Types.hs +22/−32

@@ -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+<code>Text</code> 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-<code>Data.Text</code> 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).

@@ -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

@@ -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

@@ -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.