|
|
|
@ -2,9 +2,9 @@ |
|
|
|
|
|
|
|
|
|
|
|
Copyright © 2010-2012 Jon Kristensen. |
|
|
|
Copyright © 2010-2012 Jon Kristensen. |
|
|
|
|
|
|
|
|
|
|
|
This file (IBR.hs) illustrates how to connect and perform a simple |
|
|
|
This file (IBR.hs) illustrates how to connect and perform an XEP-0077: |
|
|
|
In-Band Registration request using Pontarius. The contents of this |
|
|
|
In-Band Registration registration using Pontarius. The contents of |
|
|
|
file may be used freely, as if it is in the public domain. |
|
|
|
this file may be used freely, as if it is in the public domain. |
|
|
|
|
|
|
|
|
|
|
|
-} |
|
|
|
-} |
|
|
|
|
|
|
|
|
|
|
|
@ -13,48 +13,34 @@ module Examples.IBR () where |
|
|
|
|
|
|
|
|
|
|
|
import Network.XMPP |
|
|
|
import Network.XMPP |
|
|
|
|
|
|
|
|
|
|
|
import Control.Monad.IO.Class (liftIO) |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- Server and authentication details. |
|
|
|
-- Server details. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
hostName = "nejla.com" |
|
|
|
hostName = "nejla.com" |
|
|
|
portNumber = 5222 |
|
|
|
portNumber = 5222 |
|
|
|
|
|
|
|
userName = "test" |
|
|
|
|
|
|
|
password = "" |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- The main function initializes Pontarius and specifies the (XMPPT) |
|
|
|
-- Start an XMPP session with the default settings, open the streams |
|
|
|
-- actions the be executed, hooking the client into the appropriate |
|
|
|
-- to the XMPP server, send the `register' IQ, wait for and interpret |
|
|
|
-- events and tries to open the streams to the server. |
|
|
|
-- the response, and destroy the session. |
|
|
|
|
|
|
|
|
|
|
|
main :: IO () |
|
|
|
main :: IO () |
|
|
|
|
|
|
|
|
|
|
|
main = create $ do |
|
|
|
main = session default $ do |
|
|
|
hookStreamsOpenedEvent onStreamsOpened Nothing |
|
|
|
liftIO $ putStrLn "Welcome to the Pontarius IBR example!" |
|
|
|
hookDisconnectedEvent onDisconnected Nothing |
|
|
|
openStreamsResult <- openStreams "nejla.com" |
|
|
|
openStreams hostName portNumber |
|
|
|
case openStreamsResult of |
|
|
|
|
|
|
|
Nothing -> do |
|
|
|
where |
|
|
|
liftIO $ putStrLn "Streams opened, now registering!" |
|
|
|
|
|
|
|
pushIQReq Nothing Set query Nothing $ \reply -> do |
|
|
|
-- When the streams has been opened, print a message and unhook |
|
|
|
case reply of |
|
|
|
-- ourselves from future "Streams Opened" events. |
|
|
|
Right (IQResponse {}) -> liftIO $ putStrLn "Registered!" -- TODO: iqRequestPayload may be empty! |
|
|
|
|
|
|
|
Right (IQError {}) -> liftIO $ putStrLn "Registration error!" -- TODO: More details from error stanza |
|
|
|
onStreamsOpened Nothing = do |
|
|
|
Left _ -> liftIO $ putStrLn "Registration error!" -- TODO: More details from error |
|
|
|
liftIO $ putStrLn $ "The server streams has been successfully opened." |
|
|
|
|
|
|
|
-- sendIQRequest Nothing hostName (LangTag "en" []) Set elem cb |
|
|
|
|
|
|
|
return False |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- When the opening of the streams fails, print the error and |
|
|
|
|
|
|
|
-- shut down the XMPP session. |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
onStreamsOpened (Just e) = do |
|
|
|
|
|
|
|
liftIO $ putStrLn $ "Could not open the streams due to the following error: " ++ (show e) |
|
|
|
|
|
|
|
destroy |
|
|
|
destroy |
|
|
|
return True |
|
|
|
Just error -> liftIO $ putStrLn "Error: " ++ $ show exception |
|
|
|
|
|
|
|
where |
|
|
|
-- When disconnected, print the reason and shut down the XMPP |
|
|
|
query :: Element |
|
|
|
-- session. |
|
|
|
query = undefined -- TODO: <query xmlns='jabber:iq:register'><username>userName</username><password>password</password></query> |
|
|
|
|
|
|
|
|
|
|
|
onDisconnected r = do |
|
|
|
|
|
|
|
liftIO $ putStrLn $ "Disconnected with the reason: " ++ (show r) |
|
|
|
|
|
|
|
destroy |
|
|
|
|
|
|
|
return True |
|
|
|
|