update echoclient

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
-import Control.Monad.IO.Class (liftIO)
+import           Data.Maybe (fromJust)
-import Data.Maybe (fromJust, isJust)
+import qualified Data.Text as Text
+import           Text.Printf
 
-import Network
 import           Network.Xmpp
-import Network.Xmpp.Concurrent
 import           Network.Xmpp.IM
 
-
 -- Server and authentication details.
-
 host     = "localhost"
-hostname = "species64739.dyndns.org"
-
 port     = PortNumber 5222
-username = "echouser"
+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
+    con <- simpleConnect
-    withConnection (simpleConnect host port hostname username password resource)
+               host
-        (session csession)
+               port
-    forkIO $ autoAccept csession
+               realm
-    sendPresence presenceOnline csession
+               username
-    echo csession
+               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