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/). @@ -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
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 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
<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 @@ -44,23 +53,22 @@ The return type of <code>session</code> is <code>IO (Either XmppFailure
doing it could be doing something like this:
sess <- case result of
Right (sess, Nothing) -> sess
Right (_sess, e) -> error "AuthFailure: " ++ (show e)
Left e -> error "XmppFailure: " ++ (show e)
Right (s, Nothing) -> return s
Right (_s, e) -> error $ "AuthFailure: " ++ (show e)
Left e -> error $ "XmppFailure: " ++ (show e)
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
back to the recipient. This can be done like so:
forever $ do
msg <- getMessage sess
sendMessage (answerIM (bodies msg) [] msg) sess
let sender = show . fromJust $ messageFrom msg
let contents = maybe "nothing" Text.unpack $ body msg
printf "%s says \"%s\"\n" sender contents
case answerMessage msg (messagePayload msg) of
Just answer -> sendMessage answer sess
Nothing -> putStrLn "Received message with no sender."
Additional XMPP threads can be created using <code>dupSession</code> and
<code>forkIO</code>.

73
examples/echoclient/Main.hs

@ -10,66 +10,25 @@ sending them, using Pontarius XMPP. This file is in the public domain. @@ -10,66 +10,25 @@ sending them, using Pontarius XMPP. This file is in the public domain.
module Main where
import Control.Concurrent
import Control.Monad
import Data.Default
import Data.Maybe (fromJust)
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
import Control.Monad
import Data.Default
import Network.Xmpp
import System.Log.Logger
main :: IO ()
main = do
updateGlobalLogger "Pontarius.Xmpp" $ setLevel DEBUG
-- handler <- streamHandler stderr DEBUG >>= \h ->
-- return $ setFormatter h (simpleLogFormatter "$loggername: $msg")
-- updateGlobalLogger "Pontarius.Xmpp" (addHandler handler)
sess' <- session
realm
def
(Just ([scramSha1 username Nothing password], resource))
sess <- case sess' of
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'
result <- session
"example.com"
def
(Just ([scramSha1 "user" Nothing "Password"], Nothing))
sess <- case result of
Right (s, Nothing) -> return s
Right (_s, e) -> error $ "AuthFailure: " ++ (show e)
Left e -> error $ "XmppFailure: " ++ (show e)
sendPresence (Presence Nothing Nothing Nothing Nothing Nothing []) sess
forever $ do
-- Echo all messages back to the user.
msg <- getMessage sess
sendMessage (answerIM (bodies msg) [] msg) sess
-- Print the received message to the screen.
let sender = show . fromJust $ messageFrom msg
let contents = maybe "nothing" Text.unpack $ body msg
printf "%s says \"%s\"\n" sender contents
return ()
case answerMessage msg (messagePayload msg) of
Just answer -> sendMessage answer sess
Nothing -> putStrLn "Received message with no sender."

Loading…
Cancel
Save