Browse Source

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

Conflicts:
	source/Network/Xmpp.hs
	source/Network/Xmpp/Concurrent/Threads.hs
master
Philipp Balzarek 13 years ago
parent
commit
3b2b934376
  1. 17
      examples/EchoClient.hs
  2. 48
      pontarius-xmpp.cabal
  3. 16
      source/Network/Xmpp.hs
  4. 11
      source/Network/Xmpp/Concurrent/Monad.hs
  5. 7
      source/Network/Xmpp/Jid.hs

17
examples/EchoClient.hs

@ -36,24 +36,23 @@ resource = Nothing @@ -36,24 +36,23 @@ resource = Nothing
-- TODO: Incomplete code, needs documentation, etc.
main :: IO ()
main = do
withNewSession $ do
withConnection $ simpleConnect hostname username password resource
sendPresence presenceOnline
echo
return ()
session <- newSession
withConnection (simpleConnect hostname username password resource) session
sendPresence presenceOnline session
echo session
return ()
-- Pull message stanzas, verify that they originate from a `full' XMPP
-- address, and, if so, `echo' the message back.
echo :: Xmpp ()
echo = forever $ do
result <- pullMessage
echo :: Session -> IO ()
echo session = forever $ do
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: "

48
pontarius-xmpp.cabal

@ -2,7 +2,7 @@ Name: pontarius-xmpp @@ -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
@ -27,31 +27,31 @@ Library @@ -27,31 +27,31 @@ Library
Exposed: True
Build-Depends: base >4 && <5
, conduit >=0.5
, void -any
, resourcet -any
, containers -any
, random -any
, tls -any
, tls-extra -any
, pureMD5 -any
, base64-bytestring -any
, binary -any
, attoparsec -any
, crypto-api -any
, cryptohash -any
, text -any
, bytestring -any
, transformers -any
, mtl -any
, network -any
, lifted-base -any
, split -any
, stm -any
, xml-types -any
, void >=0.5.5
, resourcet >=0.3.0
, containers >=0.4.0.0
, random >=1.0.0.0
, tls >=1.0.0
, tls-extra >=0.5.0
, pureMD5 >=2.1.2.1
, base64-bytestring >=0.1.0.0
, binary >=0.4.1
, attoparsec >=0.10.0.3
, crypto-api >=0.9
, cryptohash >=0.6.1
, text >=0.11.1.5
, bytestring >=0.9.1.9
, transformers >=0.2.2.0
, mtl >=2.0.0.0
, network >=2.3
, lifted-base >=0.1.0.1
, split >=0.1.2.3
, stm >=2.1.2.1
, xml-types >=0.3.1
, xml-conduit >=1.0
, xml-picklers >=0.2.2
, data-default -any
, stringprep >= 0.1.5
, data-default >=0.2
, stringprep >=0.1.3
Exposed-modules: Network.Xmpp
, Network.Xmpp.Bind
, Network.Xmpp.Concurrent

16
source/Network/Xmpp.hs

@ -4,7 +4,7 @@ @@ -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 @@ -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 @@ -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 @@ -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 @@ -141,7 +141,7 @@ module Network.Xmpp
, iqResultPayload
-- * Threads
, forkChans
-- * Misc
-- * Miscellaneous
, LangTag(..)
, exampleParams
) where

11
source/Network/Xmpp/Concurrent/Monad.hs

@ -6,6 +6,7 @@ import Network.Xmpp.Types @@ -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 @@ -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 @@ -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 ()

7
source/Network/Xmpp/Jid.hs

@ -23,6 +23,9 @@ import qualified Data.Text as Text @@ -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 @@ -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

Loading…
Cancel
Save