|
|
|
|
@ -1,7 +1,6 @@
@@ -1,7 +1,6 @@
|
|
|
|
|
-- | |
|
|
|
|
-- Module: $Header$ |
|
|
|
|
-- Description: A work in progress client implementation of RFC 6120 (XMPP: |
|
|
|
|
-- Core). |
|
|
|
|
-- Description: RFC 6120 (XMPP: Core). |
|
|
|
|
-- License: Apache License 2.0 |
|
|
|
|
-- |
|
|
|
|
-- Maintainer: info@jonkri.com |
|
|
|
|
@ -37,6 +36,9 @@ module Network.Xmpp
@@ -37,6 +36,9 @@ module Network.Xmpp
|
|
|
|
|
, startTLS |
|
|
|
|
, simpleAuth |
|
|
|
|
, auth |
|
|
|
|
, scramSha1 |
|
|
|
|
, digestMd5 |
|
|
|
|
, plain |
|
|
|
|
, closeConnection |
|
|
|
|
, endSession |
|
|
|
|
, setConnectionClosedHandler |
|
|
|
|
@ -78,11 +80,10 @@ module Network.Xmpp
@@ -78,11 +80,10 @@ module Network.Xmpp
|
|
|
|
|
-- or IQ stanza. |
|
|
|
|
, getStanzaChan |
|
|
|
|
-- ** Messages |
|
|
|
|
-- | The /message/ stanza is a /push/ mechanism whereby one entity pushes |
|
|
|
|
-- information to another entity, similar to the communications that occur in |
|
|
|
|
-- a system such as email. |
|
|
|
|
-- |
|
|
|
|
-- <http://xmpp.org/rfcs/rfc6120.html#stanzas-semantics-message> |
|
|
|
|
-- | The /message/ stanza is a /push/ mechanism whereby one entity |
|
|
|
|
-- pushes information to another entity, similar to the communications that |
|
|
|
|
-- occur in a system such as email. It is not to be confused with |
|
|
|
|
-- /instant messaging/ which is handled in the 'Network.Xmpp.IM' module |
|
|
|
|
, Message(..) |
|
|
|
|
, MessageError(..) |
|
|
|
|
, MessageType(..) |
|
|
|
|
@ -101,6 +102,7 @@ module Network.Xmpp
@@ -101,6 +102,7 @@ module Network.Xmpp
|
|
|
|
|
-- for communication is signaled end-to-end by means of a dedicated |
|
|
|
|
-- communication primitive: the presence stanza. |
|
|
|
|
, Presence(..) |
|
|
|
|
, PresenceType(..) |
|
|
|
|
, PresenceError(..) |
|
|
|
|
-- *** Creating |
|
|
|
|
, module Network.Xmpp.Presence |
|
|
|
|
@ -147,10 +149,8 @@ module Network.Xmpp
@@ -147,10 +149,8 @@ module Network.Xmpp
|
|
|
|
|
, exampleParams |
|
|
|
|
) where |
|
|
|
|
|
|
|
|
|
import Data.Text as Text |
|
|
|
|
import Data.XML.Types (Element) |
|
|
|
|
|
|
|
|
|
import Network |
|
|
|
|
import qualified Network.TLS as TLS |
|
|
|
|
import Network.Xmpp.Bind |
|
|
|
|
import Network.Xmpp.Concurrent |
|
|
|
|
import Network.Xmpp.Concurrent.Channels |
|
|
|
|
@ -158,100 +158,20 @@ import Network.Xmpp.Concurrent.Types
@@ -158,100 +158,20 @@ import Network.Xmpp.Concurrent.Types
|
|
|
|
|
import Network.Xmpp.Marshal |
|
|
|
|
import Network.Xmpp.Message |
|
|
|
|
import Network.Xmpp.Monad |
|
|
|
|
import Network.Xmpp.Pickle |
|
|
|
|
import Network.Xmpp.Presence |
|
|
|
|
import Network.Xmpp.Sasl |
|
|
|
|
import Network.Xmpp.Sasl.Mechanisms |
|
|
|
|
import Network.Xmpp.Sasl.Types |
|
|
|
|
import Network.Xmpp.Session |
|
|
|
|
-- import Network.Xmpp.Session |
|
|
|
|
import Network.Xmpp.Stream |
|
|
|
|
import Network.Xmpp.TLS |
|
|
|
|
import Network.Xmpp.Types |
|
|
|
|
|
|
|
|
|
import Control.Monad.Error |
|
|
|
|
|
|
|
|
|
-- | Connect to host with given address. |
|
|
|
|
connect :: HostName -> PortID -> Text -> XmppConMonad (Either StreamError ()) |
|
|
|
|
connect address port hostname = do |
|
|
|
|
xmppRawConnect address port hostname |
|
|
|
|
result <- xmppStartStream |
|
|
|
|
case result of |
|
|
|
|
Left e -> do |
|
|
|
|
pushElement . pickleElem xpStreamError $ toError e |
|
|
|
|
xmppCloseStreams |
|
|
|
|
return () |
|
|
|
|
Right () -> return () |
|
|
|
|
return result |
|
|
|
|
where |
|
|
|
|
-- TODO: Descriptive texts in stream errors? |
|
|
|
|
toError (StreamNotStreamElement _name) = |
|
|
|
|
XmppStreamError StreamInvalidXml Nothing Nothing |
|
|
|
|
toError (StreamInvalidStreamNamespace _ns) = |
|
|
|
|
XmppStreamError StreamInvalidNamespace Nothing Nothing |
|
|
|
|
toError (StreamInvalidStreamPrefix _prefix) = |
|
|
|
|
XmppStreamError StreamBadNamespacePrefix Nothing Nothing |
|
|
|
|
-- TODO: Catch remaining xmppStartStream errors. |
|
|
|
|
toError (StreamWrongVersion _ver) = |
|
|
|
|
XmppStreamError StreamUnsupportedVersion Nothing Nothing |
|
|
|
|
toError (StreamWrongLangTag _) = |
|
|
|
|
XmppStreamError StreamInvalidXml Nothing Nothing |
|
|
|
|
toError StreamUnknownError = |
|
|
|
|
XmppStreamError StreamBadFormat Nothing Nothing |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- | Authenticate to the server using the first matching method and bind a |
|
|
|
|
-- resource. |
|
|
|
|
auth :: [SaslHandler] |
|
|
|
|
-> Maybe Text |
|
|
|
|
-> XmppConMonad (Either AuthError Jid) |
|
|
|
|
auth mechanisms resource = runErrorT $ do |
|
|
|
|
ErrorT $ xmppSasl mechanisms |
|
|
|
|
jid <- lift $ xmppBind resource |
|
|
|
|
lift $ xmppStartSession |
|
|
|
|
return jid |
|
|
|
|
|
|
|
|
|
-- | Authenticate to the server with the given username and password |
|
|
|
|
-- and bind a resource. |
|
|
|
|
-- |
|
|
|
|
-- Prefers SCRAM-SHA1 over DIGEST-MD5. |
|
|
|
|
simpleAuth :: Text.Text -- ^ The username |
|
|
|
|
-> Text.Text -- ^ The password |
|
|
|
|
-> Maybe Text -- ^ The desired resource or 'Nothing' to let the |
|
|
|
|
-- server assign one |
|
|
|
|
-> XmppConMonad (Either AuthError Jid) |
|
|
|
|
simpleAuth username passwd resource = flip auth resource $ |
|
|
|
|
[ -- TODO: scramSha1Plus |
|
|
|
|
scramSha1 username Nothing passwd |
|
|
|
|
, digestMd5 username Nothing passwd |
|
|
|
|
] |
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
-- | The quick and easy way to set up a connection to an XMPP server |
|
|
|
|
-- |
|
|
|
|
-- This will |
|
|
|
|
-- * connect to the host |
|
|
|
|
-- * secure the connection with TLS |
|
|
|
|
-- * authenticate to the server using either SCRAM-SHA1 (preferred) or |
|
|
|
|
-- Digest-MD5 |
|
|
|
|
-- * bind a resource |
|
|
|
|
-- * return the full JID you have been assigned |
|
|
|
|
-- |
|
|
|
|
-- Note that the server might assign a different resource even when we send |
|
|
|
|
-- a preference. |
|
|
|
|
simpleConnect :: HostName -- ^ Host to connect to |
|
|
|
|
-> PortID -- ^ Port to connec to |
|
|
|
|
-> Text -- ^ Hostname of the server (to distinguish the XMPP |
|
|
|
|
-- service) |
|
|
|
|
-> Text -- ^ User name (authcid) |
|
|
|
|
-> Text -- ^ Password |
|
|
|
|
-> Maybe Text -- ^ Desired resource (or Nothing to let the server |
|
|
|
|
-- decide) |
|
|
|
|
-> XmppConMonad Jid |
|
|
|
|
simpleConnect host port hostname username password resource = do |
|
|
|
|
connect host port hostname |
|
|
|
|
startTLS exampleParams |
|
|
|
|
saslResponse <- simpleAuth username password resource |
|
|
|
|
case saslResponse of |
|
|
|
|
Right jid -> return jid |
|
|
|
|
Left e -> error $ show e |
|
|
|
|
-- -- Sends the session IQ set element and waits for an answer. Throws an error if |
|
|
|
|
-- -- if an IQ error stanza is returned from the server. |
|
|
|
|
-- startSession :: Session -> IO () |
|
|
|
|
-- startSession session = do |
|
|
|
|
-- answer <- sendIQ' Nothing Set Nothing sessionXML session |
|
|
|
|
-- case answer of |
|
|
|
|
-- IQResponseResult _ -> return () |
|
|
|
|
-- e -> error $ show e |
|
|
|
|
|