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