From af00583e44f7e13f2dd673fae20c2f18bc57be0c Mon Sep 17 00:00:00 2001
From: Philipp Balzarek
Date: Sat, 8 Dec 2012 20:29:34 +0100
Subject: [PATCH] update echoclient
---
examples/EchoClient.hs | 84 +++++++++++++++++++-----------------------
1 file changed, 37 insertions(+), 47 deletions(-)
diff --git a/examples/EchoClient.hs b/examples/EchoClient.hs
index 9f55e16..6a26e27 100644
--- a/examples/EchoClient.hs
+++ b/examples/EchoClient.hs
@@ -1,6 +1,6 @@
{-
-Copyright © 2010-2012 Jon Kristensen.
+Copyright © 2010-2012 Jon Kristensen, Philipp Balzarek
This file (EchoClient.hs) illustrates how to connect, authenticate, set a simple
presence, receive message stanzas, and echo them back to whoever is sending
@@ -12,59 +12,49 @@ in the public domain.
{-# LANGUAGE OverloadedStrings #-}
+module Main where
-module Main (main) where
-
-import Control.Concurrent
-import Control.Monad (forever)
-import Control.Monad.IO.Class (liftIO)
-import Data.Maybe (fromJust, isJust)
-
-import Network
-import Network.Xmpp
-import Network.Xmpp.Concurrent
-import Network.Xmpp.IM
+import Control.Concurrent
+import Control.Monad
+import Data.Maybe (fromJust)
+import qualified Data.Text as Text
+import Text.Printf
+import Network.Xmpp
+import Network.Xmpp.IM
-- Server and authentication details.
-
-host = "localhost"
-hostname = "species64739.dyndns.org"
-
-port = PortNumber 5222
-username = "echouser"
+host = "localhost"
+port = PortNumber 5222
+realm = "host.com"
+username = "echo"
password = "pwd"
-resource = Nothing
+resource = Just "bot"
+-- | Automatically accept all subscription requests from other entities
+autoAccept :: Context -> IO ()
+autoAccept context = forever $ do
+ st <- waitForPresence isPresenceSubscribe context
+ let Just friend = presenceFrom st
+ sendPresence (presenceSubscribed friend) context
+ printf "Hello %s !" (show friend)
--- TODO: Incomplete code, needs documentation, etc.
main :: IO ()
main = do
- csession <- newSessionChans
- withConnection (simpleConnect host port hostname username password resource)
- (session csession)
- forkIO $ autoAccept csession
- sendPresence presenceOnline csession
- echo csession
+ con <- simpleConnect
+ host
+ port
+ realm
+ username
+ password
+ resource
+ putStrLn "connected"
+ sendPresence presenceOnline con
+ _thread <- forkIO $ autoAccept con
+ forever $ do -- echo all messages back to the user
+ msg <- getMessage con
+ let sender = show . fromJust $ messageFrom msg
+ let contents = maybe "nothing" Text.unpack $ body msg
+ printf "%s sayd \"%s\"\n" sender contents
+ sendMessage (answerIM (bodies msg) [] msg) con
return ()
-
--- Pull message stanzas, verify that they originate from a `full' XMPP
--- address, and, if so, `echo' the message back.
-echo :: CSession -> IO ()
-echo csession = forever $ do
- result <- pullMessage csession
- 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)) csession
- liftIO $ putStrLn "Message echoed!"
- else liftIO $ putStrLn "Message sender is not set or is bare!"
- Left exception -> liftIO $ putStrLn "Error: "
-
--- | Autoaccept any subscription offers (So people can see us online)
-autoAccept :: CSession -> IO ()
-autoAccept csession = forever $ do
- st <- waitForPresence isPresenceSubscribe csession
- sendPresence (presenceSubscribed (fromJust $ presenceFrom st)) csession
\ No newline at end of file