You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
75 lines
2.2 KiB
75 lines
2.2 KiB
14 years ago
|
{-
|
||
|
|
|
||
|
|
Copyright © 2010-2011 Jon Kristensen.
|
||
|
|
|
||
|
|
This file (EchoClient.hs) illustrates how to connect, authenticate, set a
|
||
|
|
presence, and echo messages with Pontarius XMPP. The contents of this file may
|
||
|
|
be used freely, as if it is in the public domain.
|
||
|
|
|
||
|
|
-}
|
||
|
|
|
||
|
|
|
||
|
|
module Examples.EchoClient () where
|
||
|
|
|
||
|
|
import Network.XMPP
|
||
|
|
|
||
|
|
|
||
|
|
-- Account and server details.
|
||
|
|
|
||
|
|
hostName = "jonkristensen.com"
|
||
|
|
userName = "pontarius"
|
||
|
|
serverIdentifier = "jonkristensen.com"
|
||
|
|
portNumber = 5222
|
||
|
|
resource = "pontarius"
|
||
|
|
password = "substrat44"
|
||
|
|
|
||
|
|
|
||
|
|
-- The main function initializes Pontarius XMPP and specifies the (XMPPT)
|
||
|
|
-- actions the be executed, hooking the client into the appropriate events and
|
||
|
|
-- tries to connect.
|
||
|
|
|
||
|
|
main :: IO ()
|
||
|
|
|
||
|
|
main = runXMPPT $ do
|
||
|
|
hookConnectedEvent onConnectedEvent Nothing
|
||
|
|
hookMessageEvent onMessageEvent onMessageEventPredicate
|
||
|
|
hookDisconnectedEvent onDisonnectedEvent Nothing
|
||
|
|
connect hostName portNumber userName serverIdentifier password (Just resource)
|
||
|
|
|
||
|
|
where
|
||
|
|
|
||
|
|
-- When successfully connected, send a simple presence, and unhook
|
||
|
|
-- ourselves from further "connected" events.
|
||
|
|
|
||
|
|
onConnectedEvent (Right r) = do
|
||
|
|
liftIO $ putStrLn $ "Connected with resource: " ++ (show r)
|
||
|
|
presence simplePresence
|
||
|
|
return False
|
||
|
|
|
||
|
|
-- When the connection fails, print the error and shut down the XMPP
|
||
|
|
-- session.
|
||
|
|
|
||
|
|
onConnectedEvent (Left e) = do
|
||
|
|
liftIO $ putStrLn $ "Could not connect due to the following error:" ++ (show e)
|
||
|
|
destroy
|
||
|
|
return True
|
||
|
|
|
||
|
|
-- Predicate that makes sure that the messages processed by
|
||
|
|
-- onMessageEvent are sent from and to full (not bare) XMPP addresses.
|
||
|
|
|
||
|
|
onMessageEventPredicate = Just (\ m -> return $ and [isJust $ messageFrom m, isJust $ messageTo m])
|
||
|
|
|
||
|
|
-- Swap the from and to addresses and send the new message.
|
||
|
|
|
||
|
|
onMessageEvent m = do
|
||
|
|
message $ m { messageFrom = fromJust $ messageTo m
|
||
|
|
, messageTo = fromJust $ messageFrom m }
|
||
|
|
return True
|
||
|
|
|
||
|
|
-- When disconnected, print the reason and shut down the XMPP session.
|
||
|
|
|
||
|
|
onDisconnectedEvent r = do
|
||
|
|
liftIO $ putStrLn $ "Disconnected with the reason: " ++ (show r)
|
||
|
|
destroy
|
||
|
|
return True
|