jonkri
14 years ago
19 changed files with 124 additions and 174 deletions
@ -0,0 +1,4 @@
@@ -0,0 +1,4 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?> |
||||
<haskellProject> |
||||
<sourcePath path="Source"/> |
||||
<compiler>ghcCompiler</compiler></haskellProject> |
||||
@ -0,0 +1,17 @@
@@ -0,0 +1,17 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?> |
||||
<projectDescription> |
||||
<name>pontarius-xmpp</name> |
||||
<comment></comment> |
||||
<projects> |
||||
</projects> |
||||
<buildSpec> |
||||
<buildCommand> |
||||
<name>net.sf.eclipsefp.haskell.core.builder.HaskellBuilder</name> |
||||
<arguments> |
||||
</arguments> |
||||
</buildCommand> |
||||
</buildSpec> |
||||
<natures> |
||||
<nature>net.sf.eclipsefp.haskell.core.project.HaskellNature</nature> |
||||
</natures> |
||||
</projectDescription> |
||||
@ -1,147 +0,0 @@
@@ -1,147 +0,0 @@
|
||||
{- |
||||
|
||||
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. |
||||
|
||||
In any state-aware function (function operating in the StateT monad) you can get |
||||
and set the current by writing |
||||
|
||||
@CMS.get >>= \ state -> CMS.put $ state { stateTest = 10 } ...@ |
||||
|
||||
or, if you prefer the do-notation, |
||||
|
||||
@do |
||||
state <- CMS.get |
||||
CMS.put $ state { stateTest = 10 } |
||||
...@ |
||||
|
||||
-} |
||||
|
||||
|
||||
{-# LANGUAGE MultiParamTypeClasses #-} |
||||
|
||||
|
||||
module Examples.EchoClient () where |
||||
|
||||
import Network.XMPP |
||||
|
||||
import qualified Control.Monad as CM |
||||
import qualified Control.Monad.State as CMS |
||||
import qualified Control.Monad.IO.Class as CMIC |
||||
import qualified Data.Maybe as DM |
||||
|
||||
|
||||
-- Account and server details. |
||||
|
||||
hostName = "jonkristensen.com" |
||||
userName = "pontarius" |
||||
serverIdentifier = "jonkristensen.com" |
||||
portNumber = 5222 |
||||
resource = "echo-client" |
||||
password = "" |
||||
|
||||
|
||||
-- The client state, containing the required Pontarius XMPP Session object. It |
||||
-- also contains a dummy integer value to illustrate how client states are used. |
||||
|
||||
data State = State { stateSession :: Maybe (Session State IO) |
||||
, stateTest :: Integer } |
||||
|
||||
defaultState :: State |
||||
|
||||
defaultState = State { stateSession = Nothing |
||||
, stateTest = 5 } |
||||
|
||||
|
||||
instance ClientState State IO where |
||||
putSession st se = st { stateSession = Just se } |
||||
|
||||
|
||||
-- This client defines one client handler, and only specifies the |
||||
-- messageReceived callback. |
||||
|
||||
clientHandlers = [ClientHandler { messageReceived = Just messageReceived_ |
||||
, presenceReceived = Nothing |
||||
, iqReceived = Nothing |
||||
, sessionTerminated = Nothing }] |
||||
|
||||
|
||||
-- The main function sets up the Pontarius XMPP session with the default client |
||||
-- state and client handler defined above, as well as specifying that the |
||||
-- sessionCreated function should be called when the session has been created. |
||||
|
||||
main :: IO () |
||||
|
||||
main = do |
||||
session |
||||
defaultState |
||||
clientHandlers |
||||
sessionCreated |
||||
|
||||
|
||||
-- The session has been created. Let's try to open the XMPP stream! |
||||
|
||||
sessionCreated :: CMS.StateT State IO () |
||||
|
||||
sessionCreated = do |
||||
state <- CMS.get |
||||
connect (DM.fromJust $ stateSession state) hostName portNumber |
||||
(Just ("", \ x -> True)) (Just (userName, password, Just resource)) |
||||
connectCallback |
||||
id <- getID (DM.fromJust $ stateSession state) |
||||
CMIC.liftIO $ putStrLn $ "Unique ID acquired: " ++ id |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
injectAction (DM.fromJust $ stateSession state) Nothing (do CMIC.liftIO $ putStrLn "Async action!"; return ()) |
||||
return () |
||||
|
||||
|
||||
-- We have tried to connected, TLS secured and authenticated! |
||||
|
||||
connectCallback :: ConnectResult -> CMS.StateT State IO () |
||||
|
||||
connectCallback r = do |
||||
state <- CMS.get |
||||
case r of |
||||
ConnectSuccess _ _ _ -> do |
||||
sendPresence (DM.fromJust $ stateSession state) |
||||
Presence { presenceID = Nothing |
||||
, presenceFrom = Nothing |
||||
, presenceTo = Nothing |
||||
, presenceXMLLang = Nothing |
||||
, presenceType = Available |
||||
, presencePayload = [] } |
||||
Nothing Nothing Nothing |
||||
_ -> do |
||||
CMIC.liftIO $ putStrLn "Could not connect." |
||||
return () |
||||
|
||||
|
||||
-- A message (stanza) has been received. Let's echo it! |
||||
|
||||
messageReceived_ :: Message -> CMS.StateT State IO Bool |
||||
|
||||
messageReceived_ m = do |
||||
state <- CMS.get |
||||
CMIC.liftIO $ putStrLn $ |
||||
"Received a message; echoing it! By the way: Internal state is " ++ |
||||
(show $ stateTest state) ++ "." |
||||
sendMessage (DM.fromJust $ stateSession state) |
||||
Message { messageID = messageID m |
||||
, messageFrom = Nothing |
||||
, messageTo = messageFrom m |
||||
, messageXMLLang = Nothing |
||||
, messageType = messageType m |
||||
, messagePayload = messagePayload m } |
||||
Nothing (Just (0, (do CMIC.liftIO $ putStrLn "Timeout!"; return ()))) Nothing |
||||
return True |
||||
@ -1,3 +1,2 @@
@@ -1,3 +1,2 @@
|
||||
import Distribution.Simple |
||||
|
||||
main = defaultMain |
||||
|
||||
@ -0,0 +1,74 @@
@@ -0,0 +1,74 @@
|
||||
{- |
||||
|
||||
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 |
||||
Loading…
Reference in new issue