Browse Source

Merge remote-tracking branch 'remotes/nejla/master'

master
Philipp Balzarek 14 years ago
parent
commit
bd8e5c670b
  1. 13
      examples/EchoClient.hs
  2. 1
      source/Network/Xmpp.hs
  3. 9
      source/Network/Xmpp/Monad.hs
  4. 6
      source/Network/Xmpp/Stream.hs

13
examples/EchoClient.hs

@ -25,10 +25,11 @@ import Network.Xmpp.IM
-- Server and authentication details. -- Server and authentication details.
hostName = "nejla.com" hostname = "nejla.com"
portNumber = 5222 hostname_ = "xmpp.nejla.com" -- TODO
userName = "jon" -- portNumber = 5222 -- TODO
password = "G2D9%b4S3" -- TODO userName = ""
password = ""
-- TODO: Incomplete code, needs documentation, etc. -- TODO: Incomplete code, needs documentation, etc.
@ -36,9 +37,9 @@ main :: IO ()
main = do main = do
withNewSession $ do withNewSession $ do
withConnection $ do withConnection $ do
connect "xmpp.nejla.com" "nejla.com" connect hostname_ hostname
-- startTLS exampleParams -- startTLS exampleParams
saslResponse <- auth userName password (Just "echo-client") saslResponse <- simpleAuth userName password (Just "echo-client")
case saslResponse of case saslResponse of
Right _ -> return () Right _ -> return ()
Left e -> error $ show e Left e -> error $ show e

1
source/Network/Xmpp.hs

@ -35,6 +35,7 @@ module Network.Xmpp
, withConnection , withConnection
, connect , connect
, startTLS , startTLS
, simpleAuth
, auth , auth
, endSession , endSession
, setConnectionClosedHandler , setConnectionClosedHandler

9
source/Network/Xmpp/Monad.hs

@ -40,6 +40,15 @@ pushElement x = do
pushStanza :: Stanza -> XmppConMonad Bool pushStanza :: Stanza -> XmppConMonad Bool
pushStanza = pushElement . pickleElem xpStanza pushStanza = pushElement . pickleElem xpStanza
-- XML documents and XMPP streams SHOULD be preceeded by an XML declaration.
-- UTF-8 is the only supported XMPP encoding. The standalone document
-- declaration (matching "SDDecl" in the XML standard) MUST NOT be included in
-- XMPP streams. RFC 6120 defines XMPP only in terms of XML 1.0.
pushXmlDecl :: XmppConMonad Bool
pushXmlDecl = do
sink <- gets sConPushBS
liftIO $ sink "<?xml version='1.0' encoding='UTF-8' ?>"
pushOpenElement :: Element -> XmppConMonad Bool pushOpenElement :: Element -> XmppConMonad Bool
pushOpenElement e = do pushOpenElement e = do
sink <- gets sConPushBS sink <- gets sConPushBS

6
source/Network/Xmpp/Stream.hs

@ -61,8 +61,10 @@ xmppStartStream = runErrorT $ do
hostname' <- gets sHostname hostname' <- gets sHostname
case hostname' of case hostname' of
Nothing -> throwError StreamConnectionError Nothing -> throwError StreamConnectionError
Just hostname -> lift . pushOpenElement $ Just hostname -> lift $ do
pickleElem pickleStream ("1.0", Nothing, Just hostname) pushXmlDecl
pushOpenElement $
pickleElem pickleStream ("1.0", Nothing, Just hostname)
features <- ErrorT . pullToSink $ runErrorT xmppStream features <- ErrorT . pullToSink $ runErrorT xmppStream
modify (\s -> s {sFeatures = features}) modify (\s -> s {sFeatures = features})
return () return ()

Loading…
Cancel
Save