|
|
|
@ -1,5 +1,6 @@ |
|
|
|
{- |
|
|
|
{- |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
Copyright © 2010-2012 Jon Kristensen, Philipp Balzarek |
|
|
|
Copyright © 2010-2012 Jon Kristensen, Philipp Balzarek |
|
|
|
|
|
|
|
|
|
|
|
This file (EchoClient.hs) illustrates how to connect, authenticate, set a simple |
|
|
|
This file (EchoClient.hs) illustrates how to connect, authenticate, set a simple |
|
|
|
@ -20,13 +21,14 @@ import Data.Maybe (fromJust) |
|
|
|
import qualified Data.Text as Text |
|
|
|
import qualified Data.Text as Text |
|
|
|
import Text.Printf |
|
|
|
import Text.Printf |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
import Network.TLS |
|
|
|
import Network.Xmpp |
|
|
|
import Network.Xmpp |
|
|
|
import Network.Xmpp.IM |
|
|
|
import Network.Xmpp.IM |
|
|
|
|
|
|
|
import System.IO (stderr) |
|
|
|
import System.Log.Formatter |
|
|
|
import System.Log.Formatter |
|
|
|
import System.Log.Logger |
|
|
|
|
|
|
|
import System.Log.Handler hiding (setLevel) |
|
|
|
import System.Log.Handler hiding (setLevel) |
|
|
|
import System.Log.Handler.Simple |
|
|
|
import System.Log.Handler.Simple |
|
|
|
import System.IO (stderr) |
|
|
|
import System.Log.Logger |
|
|
|
|
|
|
|
|
|
|
|
-- Server and authentication details. |
|
|
|
-- Server and authentication details. |
|
|
|
host = "localhost" |
|
|
|
host = "localhost" |
|
|
|
@ -40,9 +42,12 @@ resource = Just "bot" |
|
|
|
autoAccept :: Session -> IO () |
|
|
|
autoAccept :: Session -> IO () |
|
|
|
autoAccept session = forever $ do |
|
|
|
autoAccept session = forever $ do |
|
|
|
st <- waitForPresence isPresenceSubscribe session |
|
|
|
st <- waitForPresence isPresenceSubscribe session |
|
|
|
let Just friend = presenceFrom st |
|
|
|
friend <- case presenceFrom st of |
|
|
|
sendPresence (presenceSubscribed friend) session |
|
|
|
Just from -> do |
|
|
|
printf "Hello %s !" (show friend) |
|
|
|
sendPresence (presenceSubscribed from) session |
|
|
|
|
|
|
|
return $ show from |
|
|
|
|
|
|
|
Nothing -> return "anonymous" -- this shouldn't happen |
|
|
|
|
|
|
|
printf "Hello %s !" friend |
|
|
|
|
|
|
|
|
|
|
|
main :: IO () |
|
|
|
main :: IO () |
|
|
|
main = do |
|
|
|
main = do |
|
|
|
@ -51,13 +56,16 @@ main = do |
|
|
|
return $ setFormatter h (simpleLogFormatter "$time - $loggername: $prio: $msg") |
|
|
|
return $ setFormatter h (simpleLogFormatter "$time - $loggername: $prio: $msg") |
|
|
|
updateGlobalLogger "Pontarius.Xmpp" (addHandler handler) |
|
|
|
updateGlobalLogger "Pontarius.Xmpp" (addHandler handler) |
|
|
|
|
|
|
|
|
|
|
|
sess <- simpleConnect |
|
|
|
sess' <- session |
|
|
|
host |
|
|
|
host |
|
|
|
port |
|
|
|
|
|
|
|
realm |
|
|
|
realm |
|
|
|
username |
|
|
|
port |
|
|
|
password |
|
|
|
Nothing -- (Just defaultParamsClient) |
|
|
|
resource |
|
|
|
(Just ([scramSha1 username Nothing password], resource)) |
|
|
|
|
|
|
|
sess <- case sess' of |
|
|
|
|
|
|
|
Left err -> error $ "Error connection to XMPP server: " ++ show err |
|
|
|
|
|
|
|
Right (_, Just err) -> error $ "Error while authenticating: " ++ show err |
|
|
|
|
|
|
|
Right (sess, Nothing) -> return sess |
|
|
|
-- We won't be able to receive stanzas before we set out status to online |
|
|
|
-- We won't be able to receive stanzas before we set out status to online |
|
|
|
sendPresence presenceOnline sess |
|
|
|
sendPresence presenceOnline sess |
|
|
|
putStrLn "Connected." |
|
|
|
putStrLn "Connected." |
|
|
|
|