Browse Source

Remove IM module dependency for EchoClient; update tutorial

master
Jon Kristensen 13 years ago
parent
commit
c13dd57a9f
  1. 26
      README.md
  2. 73
      examples/echoclient/Main.hs

26
README.md

@ -15,10 +15,19 @@ page](http://hackage.haskell.org/package/pontarius-xmpp/).
_Note:_ Pontarius XMPP is still in its Alpha phase. Pontarius XMPP is not yet _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. feature-complete, it may contain bugs, and its API may change between versions.
The first thing to do is to import the <code>Network.Xmpp</code> module. The first thing to do is to import the modules that we are going to use.
import Network.Xmpp import Network.Xmpp
import Control.Monad
import Data.Default
import System.Log.Logger
Pontarius XMPP supports [hslogger](http://hackage.haskell.org/package/hslogger)
logging. Start by enabling console logging.
updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG
When this is done, a <code>Session</code> object can be acquired by calling When this is done, a <code>Session</code> object can be acquired by calling
<code>session</code>. This object will be used for interacting with the library. <code>session</code>. This object will be used for interacting with the library.
@ -44,23 +53,22 @@ The return type of <code>session</code> is <code>IO (Either XmppFailure
doing it could be doing something like this: doing it could be doing something like this:
sess <- case result of sess <- case result of
Right (sess, Nothing) -> sess Right (s, Nothing) -> return s
Right (_sess, e) -> error "AuthFailure: " ++ (show e) Right (_s, e) -> error $ "AuthFailure: " ++ (show e)
Left e -> error "XmppFailure: " ++ (show e) Left e -> error $ "XmppFailure: " ++ (show e)
Next, let us set our status to Online. Next, let us set our status to Online.
sendPresence presenceOnline sess sendPresence (Presence Nothing Nothing Nothing Nothing Nothing []) sess
Now, let's say that we want to receive all message stanzas, and echo the stanzas Now, let's say that we want to receive all message stanzas, and echo the stanzas
back to the recipient. This can be done like so: back to the recipient. This can be done like so:
forever $ do forever $ do
msg <- getMessage sess msg <- getMessage sess
sendMessage (answerIM (bodies msg) [] msg) sess case answerMessage msg (messagePayload msg) of
let sender = show . fromJust $ messageFrom msg Just answer -> sendMessage answer sess
let contents = maybe "nothing" Text.unpack $ body msg Nothing -> putStrLn "Received message with no sender."
printf "%s says \"%s\"\n" sender contents
Additional XMPP threads can be created using <code>dupSession</code> and Additional XMPP threads can be created using <code>dupSession</code> and
<code>forkIO</code>. <code>forkIO</code>.

73
examples/echoclient/Main.hs

@ -10,66 +10,25 @@ sending them, using Pontarius XMPP. This file is in the public domain.
module Main where module Main where
import Control.Concurrent import Control.Monad
import Control.Monad import Data.Default
import Data.Default import Network.Xmpp
import Data.Maybe (fromJust) import System.Log.Logger
import qualified Data.Text as Text
import Text.Printf
import Network.Xmpp
import Network.Xmpp.IM
-- import System.Log.Formatter
import System.Log.Handler hiding (setLevel)
import System.Log.Handler.Simple
import System.Log.Logger
-- import Network.Xmpp.IM.Roster
-- Server and authentication details.
realm = "species64739.dyndns.org"
username = "echo"
password = "pwd"
resource = Just "bot"
-- | Automatically accept all subscription requests from other entities
autoAccept :: Session -> IO ()
autoAccept session = forever $ do
st <- waitForPresence isPresenceSubscribe session
friend <- case presenceFrom st of
Just from -> do
sendPresence (presenceSubscribed from) session
return $ show from
Nothing -> return "anonymous" -- this shouldn't happen
printf "Hello %s !" friend
main :: IO () main :: IO ()
main = do main = do
updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG
-- handler <- streamHandler stderr DEBUG >>= \h -> result <- session
-- return $ setFormatter h (simpleLogFormatter "$loggername: $msg") "example.com"
-- updateGlobalLogger "Pontarius.Xmpp" (addHandler handler) def
(Just ([scramSha1 "user" Nothing "Password"], Nothing))
sess' <- session sess <- case result of
realm Right (s, Nothing) -> return s
def Right (_s, e) -> error $ "AuthFailure: " ++ (show e)
(Just ([scramSha1 username Nothing password], resource)) Left e -> error $ "XmppFailure: " ++ (show e)
sess <- case sess' of sendPresence (Presence Nothing Nothing Nothing Nothing Nothing []) sess
Left err -> error $ "Error connection to XMPP server: " ++ show err
Right (_, Just err) -> error $ "Error while authenticating: " ++ show err
Right (sess, Nothing) -> return sess
-- We won't be able to receive stanzas before we set out status to online
sendPresence presenceOnline sess
putStrLn "Connected."
-- We want to see all incoming stanzas in the auto-accept thread as well.
sess' <- dupSession sess
_thread <- forkIO $ autoAccept sess'
forever $ do forever $ do
-- Echo all messages back to the user.
msg <- getMessage sess msg <- getMessage sess
sendMessage (answerIM (bodies msg) [] msg) sess case answerMessage msg (messagePayload msg) of
-- Print the received message to the screen. Just answer -> sendMessage answer sess
let sender = show . fromJust $ messageFrom msg Nothing -> putStrLn "Received message with no sender."
let contents = maybe "nothing" Text.unpack $ body msg
printf "%s says \"%s\"\n" sender contents
return ()

Loading…
Cancel
Save