Merge remote-tracking branch 'remotes/nejla/master'

Conflicts:
	source/Network/Xmpp.hs
	source/Network/Xmpp/Concurrent/Threads.hs

examples/EchoClient.hs

@@ -36,24 +36,23 @@ resource = Nothing
 -- TODO: Incomplete code, needs documentation, etc.
 main :: IO ()
 main = do
-    withNewSession $ do
+    session <- newSession
-        withConnection $ simpleConnect hostname username password resource
+    withConnection (simpleConnect hostname username password resource) session
-        sendPresence presenceOnline
+    sendPresence presenceOnline session
-        echo
+    echo session
-        return ()
     return ()
 
 -- Pull message stanzas, verify that they originate from a `full' XMPP
 -- address, and, if so, `echo' the message back.
-echo :: Xmpp ()
+echo :: Session -> IO ()
-echo = forever $ do
+echo session = forever $ do
-    result <- pullMessage
+    result <- pullMessage session
     case result of
         Right message ->
             if (isJust $ messageFrom message) &&
                    (isFull $ fromJust $ messageFrom message) then do
                 -- TODO: May not set from.
-                sendMessage $ Message Nothing (messageTo message) (messageFrom message) Nothing (messageType message) (messagePayload message)
+                sendMessage (Message Nothing (messageTo message) (messageFrom message) Nothing (messageType message) (messagePayload message)) session
                 liftIO $ putStrLn "Message echoed!"
             else liftIO $ putStrLn "Message sender is not set or is bare!"
         Left exception -> liftIO $ putStrLn "Error: "

pontarius-xmpp.cabal

@@ -2,7 +2,7 @@ Name: pontarius-xmpp
 Version: 0.1.0.0
 Cabal-Version: >= 1.6
 Build-Type: Simple
--- License:
+License: OtherLicense
 License-File: LICENSE
 Copyright: Dmitry Astapov, Pierre Kovalev, Mahdi Abdinejadi, Jon Kristensen,
            IETF Trust, Philipp Balzarek
@@ -26,32 +26,32 @@ Library
   hs-source-dirs: source
   Exposed: True
   Build-Depends: base              >4 && <5
-               , conduit           >= 0.5
+               , conduit           >=0.5
-               , void              -any
+               , void              >=0.5.5
-               , resourcet         -any
+               , resourcet         >=0.3.0
-               , containers        -any
+               , containers        >=0.4.0.0
-               , random            -any
+               , random            >=1.0.0.0
-               , tls               -any
+               , tls               >=1.0.0
-               , tls-extra         -any
+               , tls-extra         >=0.5.0
-               , pureMD5           -any
+               , pureMD5           >=2.1.2.1
-               , base64-bytestring -any
+               , base64-bytestring >=0.1.0.0
-               , binary            -any
+               , binary            >=0.4.1
-               , attoparsec        -any
+               , attoparsec        >=0.10.0.3
-               , crypto-api        -any
+               , crypto-api        >=0.9
-               , cryptohash        -any
+               , cryptohash        >=0.6.1
-               , text              -any
+               , text              >=0.11.1.5
-               , bytestring        -any
+               , bytestring        >=0.9.1.9
-               , transformers      -any
+               , transformers      >=0.2.2.0
-               , mtl               -any
+               , mtl               >=2.0.0.0
-               , network           -any
+               , network           >=2.3
-               , lifted-base       -any
+               , lifted-base       >=0.1.0.1
-               , split             -any
+               , split             >=0.1.2.3
-               , stm               -any
+               , stm               >=2.1.2.1
-               , xml-types         -any
+               , xml-types         >=0.3.1
-               , xml-conduit       >= 1.0
+               , xml-conduit       >=1.0
-               , xml-picklers      >= 0.2.2
+               , xml-picklers      >=0.2.2
-               , data-default      -any
+               , data-default      >=0.2
-               , stringprep        >= 0.1.5
+               , stringprep        >=0.1.3
   Exposed-modules: Network.Xmpp
                  , Network.Xmpp.Bind
                  , Network.Xmpp.Concurrent

source/Network/Xmpp.hs

@@ -4,7 +4,7 @@
 --              Core).
 -- License:     Apache License 2.0
 --
--- Maintainer:  jon.kristensen@nejla.com
+-- Maintainer:  info@jonkri.com
 -- Stability:   unstable
 -- Portability: portable
 --
@@ -85,11 +85,11 @@ module Network.Xmpp
   , Message(..)
   , MessageError(..)
   , MessageType(..)
-  -- *** creating
+  -- *** Creating
   , answerMessage
-  -- *** sending
+  -- *** Sending
   , sendMessage
-  -- *** receiving
+  -- *** Receiving
   , pullMessage
   , waitForMessage
   , waitForMessageError
@@ -101,9 +101,9 @@ module Network.Xmpp
   -- communication primitive: the presence stanza.
   , Presence(..)
   , PresenceError(..)
-  -- *** creating
+  -- *** Creating
   , module Network.Xmpp.Presence
-  -- *** sending
+  -- *** Sending
   -- | Sends a presence stanza. In general, the presence stanza should have no
   -- 'to' attribute, in which case the server to which the client is connected
   -- will broadcast that stanza to all subscribed entities. However, a
@@ -111,7 +111,7 @@ module Network.Xmpp
   -- which case the server will route or deliver that stanza to the intended
   -- recipient.
   , sendPresence
-  -- *** receiving
+  -- *** Receiving
   , pullPresence
   , waitForPresence
   -- ** IQ
@@ -141,7 +141,7 @@ module Network.Xmpp
   , iqResultPayload
   -- * Threads
   , forkChans
-  -- * Misc
+  -- * Miscellaneous
   , LangTag(..)
   , exampleParams
   ) where

source/Network/Xmpp/Concurrent/Monad.hs

@@ -6,6 +6,7 @@ import           Network.Xmpp.Types
 import           Control.Applicative((<$>))
 import           Control.Concurrent
 import           Control.Concurrent.STM
+import           Control.Concurrent.STM.TVar (TVar, readTVar, writeTVar)
 import qualified Control.Exception.Lifted as Ex
 import           Control.Monad.IO.Class
 import           Control.Monad.Reader
@@ -151,7 +152,7 @@ waitForPresence f chans = do
 
 -- TODO: Wait for presence error?
 
--- | Run an XmppMonad action in isolation. Reader and writer workers will be
+-- | Run an XmppConMonad action in isolation. Reader and writer workers will be
 -- temporarily stopped and resumed with the new session details once the action
 -- returns. The action will run in the calling thread. Any uncaught exceptions
 -- will be interpreted as connection failure.
@@ -205,6 +206,14 @@ sendMessage m chans = sendStanza (MessageS m) chans
 -- | Executes a function to update the event handlers.
 modifyHandlers :: (EventHandlers -> EventHandlers) -> Session -> IO ()
 modifyHandlers f session = atomically $ modifyTVar (eventHandlers session) f
+  where
+    -- Borrowing modifyTVar from
+    -- http://hackage.haskell.org/packages/archive/stm/2.4/doc/html/src/Control-Concurrent-STM-TVar.html
+    -- as it's not available in GHC 7.0.
+    modifyTVar :: TVar a -> (a -> a) -> STM ()
+    modifyTVar var f = do
+      x <- readTVar var
+      writeTVar var (f x)
 
 -- | Sets the handler to be executed when the server connection is closed.
 setConnectionClosedHandler :: (StreamError -> Session -> IO ()) -> Session -> IO ()

source/Network/Xmpp/Jid.hs

@@ -23,6 +23,9 @@ import qualified Data.Text as Text
 import qualified Text.NamePrep as SP
 import qualified Text.StringPrep as SP
 
+-- | A JID is XMPP\'s native format for addressing entities in the network. It
+-- is somewhat similar to an e-mail address but contains three parts instead of
+-- two.
 data Jid = Jid { -- | The @localpart@ of a JID is an optional identifier placed
                  -- before the domainpart and separated from the latter by a
                  -- \'\@\' character. Typically a localpart uniquely identifies
@@ -105,12 +108,12 @@ fromStrings l d r = do
     validPartLength :: Text -> Bool
     validPartLength p = Text.length p > 0 && Text.length p < 1024
 
--- | Returns True if the JID is /bare/, and False otherwise.
+-- | Returns 'True' if the JID is /bare/, and 'False' otherwise.
 isBare :: Jid -> Bool
 isBare j | resourcepart j == Nothing = True
          | otherwise                 = False
 
--- | Returns True if the JID is 'full', and False otherwise.
+-- | Returns 'True' if the JID is /full/, and 'False' otherwise.
 isFull :: Jid -> Bool
 isFull = not . isBare
 

source/Network/Xmpp/Stream.hs

@@ -15,7 +15,7 @@ import           Data.Maybe (fromJust, isJust, isNothing)
 import           Data.Text as Text
 import           Data.XML.Pickle
 import           Data.XML.Types
-import           Data.Void(Void)
+import           Data.Void (Void)
 
 import           Network.Xmpp.Monad
 import           Network.Xmpp.Pickle