This is a simple snippet to enable jabber-controllable applications. Code can be downloaded here.
1 -- A small jabber client to allow programs to be controlled and send status
2 -- messages using chat clients like pidgin. Uses the XMPP library (available
3 -- through cabal).
4 --
5 -- The credentials file has the format
6 --
7 -- Credentials {
8 -- username = "<username>",
9 -- password = "<password>",
10 -- server = "<server>",
11 -- ressource = "<some identifier>"
12 -- }
13
14 module Main where
15 import Network
16 import Network.XMPP
17 import System.Directory
18 import Control.Monad
19
20
21 type Handler = String -> IO String
22
23 data Credentials = Credentials {
24 username :: String,
25 password :: String,
26 server :: String,
27 ressource :: String
28 } deriving (Eq, Show, Read)
29
30
31 -- Start a jabber bot by reading the credentials from a file.
32 startJabber :: FilePath -> Handler -> IO ()
33 startJabber fname handler = do
34 e <- doesFileExist fname
35 unless e $
36 error ("Jabber: credentials file " ++ fname ++ " does not exist.")
37 cred <- read `liftM` readFile fname :: IO Credentials
38 startJabber' cred handler
39
40
41 -- Start a jabber bot by passing both credentials and handler directly.
42 startJabber' :: Credentials -> Handler -> IO ()
43 startJabber' cred handler = do
44 c <- openStream (server cred)
45 getStreamStart c
46
47 runXMPP c $ do
48 startAuth (username cred) (server cred) (password cred) (ressource cred)
49 sendPresence Nothing Nothing
50
51 -- Say hello to someone.
52 sendMessage "michael.lesniak@gmail.com" "Online."
53
54 run
55 where run :: XMPP ()
56 run = do
57 input <- waitForStanza (isChat `conj` hasBody)
58 let sender = maybe "" id (getAttr "from" input)
59 msg = maybe "" id (getMessageBody input)
60 response <- liftIO $ handler msg
61 sendMessage sender response
62 run
63
64
65 -- For testing purposes. A small echo bot.
66 main :: IO ()
67 main = startJabber "credentials" return
68