7 changed files with 0 additions and 109 deletions
@ -1,6 +0,0 @@
@@ -1,6 +0,0 @@
|
||||
[submodule "stringprep-hs"] |
||||
path = stringprep-hs |
||||
url = git@github.com:Philonous/stringprep-hs.git |
||||
[submodule "xml-picklers"] |
||||
path = xml-picklers |
||||
url = git@github.com:Philonous/xml-picklers.git |
||||
@ -1,55 +0,0 @@
@@ -1,55 +0,0 @@
|
||||
{-# LANGUAGE PackageImports, OverloadedStrings #-} |
||||
module Example where |
||||
|
||||
import Data.Text as T |
||||
|
||||
import Network.Xmpp |
||||
import Control.Concurrent |
||||
import Control.Concurrent.STM |
||||
import Control.Monad |
||||
import Control.Monad.IO.Class |
||||
|
||||
philonous :: JID |
||||
philonous = read "uart14@species64739.dyndns.org" |
||||
|
||||
attXmpp :: STM a -> XmppThread a |
||||
attXmpp = liftIO . atomically |
||||
|
||||
autoAccept :: XmppThread () |
||||
autoAccept = forever $ do |
||||
st <- pullPresence |
||||
case st of |
||||
Presence from _ idq (Just Subscribe) _ _ _ _ -> |
||||
sendS . SPresence $ |
||||
Presence Nothing from idq (Just Subscribed) Nothing Nothing Nothing [] |
||||
_ -> return () |
||||
|
||||
mirror :: XmppThread () |
||||
mirror = forever $ do |
||||
st <- pullMessage |
||||
case st of |
||||
Message (Just from) _ idq tp subject (Just bd) thr _ -> |
||||
sendS . SMessage $ |
||||
Message Nothing from idq tp subject |
||||
(Just $ "you wrote: " `T.append` bd) thr [] |
||||
_ -> return () |
||||
|
||||
|
||||
main :: IO () |
||||
main = do |
||||
sessionConnect "localhost" "species64739.dyndns.org" "bot" Nothing $ do |
||||
-- singleThreaded $ xmppStartTLS exampleParams |
||||
singleThreaded $ xmppSASL "pwd" |
||||
xmppThreadedBind (Just "botsi") |
||||
-- singleThreaded $ xmppBind (Just "botsi") |
||||
singleThreaded $ xmppContext |
||||
forkXmpp autoAccept |
||||
forkXmpp mirror |
||||
sendS . SPresence $ Presence Nothing Nothing Nothing Nothing |
||||
(Just Available) Nothing Nothing [] |
||||
sendS . SMessage $ Message Nothing philonous Nothing Nothing Nothing |
||||
(Just "bla") Nothing [] |
||||
liftIO . forever $ threadDelay 1000000 |
||||
return () |
||||
return () |
||||
|
||||
@ -1,46 +0,0 @@
@@ -1,46 +0,0 @@
|
||||
{- |
||||
|
||||
Copyright © 2010-2012 Jon Kristensen. |
||||
|
||||
This file (IBR.hs) illustrates how to connect and perform an XEP-0077: |
||||
In-Band Registration registration using Pontarius. The contents of |
||||
this file may be used freely, as if it is in the public domain. |
||||
|
||||
-} |
||||
|
||||
|
||||
module Examples.IBR () where |
||||
|
||||
import Network.Xmpp |
||||
|
||||
|
||||
-- Server and authentication details. |
||||
|
||||
hostName = "nejla.com" |
||||
portNumber = 5222 |
||||
userName = "test" |
||||
password = "" |
||||
|
||||
|
||||
-- Start an XMPP session with the default settings, open the streams |
||||
-- to the XMPP server, send the `register' IQ, wait for and interpret |
||||
-- the response, and destroy the session. |
||||
|
||||
main :: IO () |
||||
|
||||
main = session default $ do |
||||
liftIO $ putStrLn "Welcome to the Pontarius IBR example!" |
||||
openStreamsResult <- openStreams "nejla.com" |
||||
case openStreamsResult of |
||||
Nothing -> do |
||||
liftIO $ putStrLn "Streams opened, now registering!" |
||||
pushIQReq Nothing Set query Nothing $ \reply -> do |
||||
case reply of |
||||
Right (IQResponse {}) -> liftIO $ putStrLn "Registered!" -- TODO: iqRequestPayload may be empty! |
||||
Right (IQError {}) -> liftIO $ putStrLn "Registration error!" -- TODO: More details from error stanza |
||||
Left _ -> liftIO $ putStrLn "Registration error!" -- TODO: More details from error |
||||
destroy |
||||
Just error -> liftIO $ putStrLn "Error: " ++ $ show exception |
||||
where |
||||
query :: Element |
||||
query = undefined -- TODO: <query xmlns='jabber:iq:register'><username>userName</username><password>password</password></query> |
||||
@ -1 +0,0 @@
@@ -1 +0,0 @@
|
||||
Subproject commit 7a6ca463b5e6d6636abf266bc9a782ede4e76b06 |
||||
Loading…
Reference in new issue