|
|
|
|
@ -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 (main) where |
|
|
|
|
module Main where |
|
|
|
|
|
|
|
|
|
import Control.Concurrent |
|
|
|
|
import Control.Monad (forever) |
|
|
|
|
import Control.Monad.IO.Class (liftIO) |
|
|
|
|
import Data.Maybe (fromJust, isJust) |
|
|
|
|
import Control.Monad |
|
|
|
|
import Data.Maybe (fromJust) |
|
|
|
|
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 |
|
|
|
|
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 |