1 changed files with 63 additions and 0 deletions
@ -0,0 +1,63 @@
@@ -0,0 +1,63 @@
|
||||
{- |
||||
|
||||
Copyright © 2010-2012 Jon Kristensen. |
||||
|
||||
This file (EchoClient.hs) illustrates how to connect, authenticate, |
||||
set a simple presence, receive message stanzas, and echo them back to |
||||
whoever is sending them, using Pontarius. The contents of this file |
||||
may be used freely, as if it is in the public domain. |
||||
|
||||
-} |
||||
|
||||
|
||||
module Examples.EchoClient () where |
||||
|
||||
import Network.XMPP |
||||
|
||||
|
||||
-- Server and authentication details. |
||||
|
||||
hostName = "nejla.com" |
||||
portNumber = 5222 |
||||
userName = "test" |
||||
password = "" |
||||
|
||||
|
||||
-- Start an XMPP session with the default settings, open the streams |
||||
-- to the XMPP server, authenticate, send a simple presence, and start |
||||
-- the `echo' XMPP thread. |
||||
|
||||
main :: IO () |
||||
|
||||
main = session default $ do |
||||
liftIO $ putStrLn "Welcome to the Pontarius EchoClient example!" |
||||
openStreamsResult <- openStreams "nejla.com" |
||||
case openStreamsResult of |
||||
Nothing -> do |
||||
liftIO $ putStrLn "Streams opened, now authenticating!" |
||||
authenticateResult <- authenticate userName password Nothing |
||||
case authenticateResult of |
||||
Right _ -> do -- Ignore XMPP address |
||||
liftIO $ putStrLn "Authenticating, now sending presence!" |
||||
sendPresence Nothing Nothing [] Nothing -- Simple presence |
||||
liftIO $ putStrLn "Echoing..." |
||||
fork echo |
||||
Left error -> liftIO $ putStrLn "Error: " ++ $ show exception |
||||
Just error -> liftIO $ putStrLn "Error: " ++ $ show exception |
||||
|
||||
|
||||
-- Pull message stanzas, verify that they originate from a `full' XMPP |
||||
-- address, and, if so, `echo' the message back. |
||||
|
||||
echo :: XMPPThread () -- TODO: XMPP ()? XMPP? |
||||
|
||||
echo = forever $ do |
||||
result <- pullMessage |
||||
case result of |
||||
Right message -> |
||||
if messageFrom message /= Nothing && isFull $ messageFrom message |
||||
then do |
||||
sendMessage (messageFrom message) (messageType message) Nothing [] |
||||
liftIO $ putStrLn "Message echoed!" |
||||
else liftIO $ putStrLn "Message sender is not set or is bare!" |
||||
Left exception -> liftIO $ putStrLn "Error: " ++ $ show exception |
||||
Loading…
Reference in new issue