Browse Source

update echoclient

master
Philipp Balzarek 13 years ago
parent
commit
af00583e44
  1. 84
      examples/EchoClient.hs

84
examples/EchoClient.hs

@ -1,6 +1,6 @@ @@ -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. @@ -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
Loading…
Cancel
Save