Eq instance for JID, PLAIN now base64-encoded, EchoClient compiles,

isBare/Full functions exposed

examples/EchoClient.hs

@@ -2,62 +2,62 @@
 
 Copyright © 2010-2012 Jon Kristensen.
 
-This file (EchoClient.hs) illustrates how to connect, authenticate,
-set a simple presence, receive message stanzas, and echo them back to
-whoever is sending them, using Pontarius. The contents of this file
-may be used freely, as if it is in the public domain.
+This file (EchoClient.hs) illustrates how to connect, authenticate, set a simple
+presence, receive message stanzas, and echo them back to whoever is sending
+them, using Pontarius. The contents of this file may be used freely, as if it is
+in the public domain.
 
 -}
 
 
-module Examples.EchoClient () where
+{-# LANGUAGE OverloadedStrings #-}
+
+
+module Main (main) where
+
+import Control.Monad (forever)
+import Control.Monad.IO.Class (liftIO)
+import Data.Maybe (fromJust, isJust)
 
 import Network.XMPP
+import Network.XMPP.IM
 
 
 -- Server and authentication details.
 
 hostName = "nejla.com"
 portNumber = 5222
-userName = "test"
-password = ""
-
+userName = "jon"
+password = "G2D9%b4S3" -- TODO
 
--- Start an XMPP session with the default settings, open the streams
--- to the XMPP server, authenticate, send a simple presence, and start
--- the `echo' XMPP thread.
 
+-- TODO: Incomplete code, needs documentation, etc.
 main :: IO ()
-
-main = session default $ do
-  liftIO $ putStrLn "Welcome to the Pontarius EchoClient example!"
-  openStreamsResult <- openStreams "nejla.com"
-  case openStreamsResult of
-    Nothing -> do
-      liftIO $ putStrLn "Streams opened, now authenticating!"
-      authenticateResult <- authenticate userName password Nothing
-      case authenticateResult of
-        Right _ -> do -- Ignore XMPP address
-          liftIO $ putStrLn "Authenticating, now sending presence!"
-          sendPresence Nothing Nothing [] Nothing -- Simple presence
-          liftIO $ putStrLn "Echoing..."
-          fork echo
-        Left error -> liftIO $ putStrLn "Error: " ++ $ show exception
-    Just error -> liftIO $ putStrLn "Error: " ++ $ show exception
-
+main = do
+    withNewSession $ do
+        withConnection $ do
+            connect "xmpp.nejla.com" "nejla.com"
+            -- startTLS exampleParams
+            saslResponse <- auth userName password (Just "echo-client")
+            case saslResponse of
+                Right _ -> return ()
+                Left e -> error $ show e
+        sendPresence presenceOnline
+        fork echo
+        return ()
+    return ()
 
 -- Pull message stanzas, verify that they originate from a `full' XMPP
 -- address, and, if so, `echo' the message back.
-
-echo :: XMPPThread () -- TODO: XMPP ()? XMPP?
-
+echo :: XMPP ()
 echo = forever $ do
-  result <- pullMessage	
-  case result of
-    Right message ->
-      if messageFrom message /= Nothing && isFull $ messageFrom message
-      then do
-        sendMessage (messageFrom message) (messageType message) Nothing []
-        liftIO $ putStrLn "Message echoed!"
-      else liftIO $ putStrLn "Message sender is not set or is bare!"
-    Left exception -> liftIO $ putStrLn "Error: " ++ $ show exception
+    result <- pullMessage	
+    case result of
+        Right message ->
+            if (isJust $ messageFrom message) &&
+                   (isFull $ fromJust $ messageFrom message) then do
+                -- TODO: May not set from.
+                sendMessage $ Message Nothing (messageTo message) (messageFrom message) Nothing (messageType message) (messagePayload message)
+                liftIO $ putStrLn "Message echoed!"
+            else liftIO $ putStrLn "Message sender is not set or is bare!"
+        Left exception -> liftIO $ putStrLn "Error: "

pontarius.cabal

@@ -75,6 +75,9 @@ Library
                  , Data.Conduit.TLS
   GHC-Options: -Wall
 
+Executable pontarius-echoclient
+  hs-source-dirs: source
+  Main-Is: ../examples/EchoClient.hs
 
 Source-Repository head
   Type: git

source/Network/XMPP.hs

@@ -38,6 +38,8 @@ module Network.XMPP
   -- for addressing entities in the network. It is somewhat similar to an e-mail
   -- address but contains three parts instead of two:
   , JID(..)
+  , isBare
+  , isFull
   -- * Stanzas
   -- | @Stanzas@ are the the smallest unit of communication in @XMPP@. They come
   -- in 3 flavors:

source/Network/XMPP/JID.hs

@@ -54,7 +54,7 @@ data JID = JID { -- | The @localpart@ of a JID is an optional identifier placed
                  -- the entity associated with an XMPP localpart at a domain
                  -- (i.e., @localpart\@domainpart/resourcepart@).
                , resourcepart :: !(Maybe Text)
-               }
+               } deriving Eq
 
 instance Show JID where
   show (JID nd dmn res) =

source/Network/XMPP/SASL.hs

@@ -63,4 +63,5 @@ xmppSASL creds = runErrorT $ do
     -- the XMPP mechanism attribute.
     credsToName :: SASLCredentials -> Text
     credsToName (DIGEST_MD5Credentials _ _ _) = "DIGEST-MD5"
+    credsToName (PLAINCredentials _ _ _) = "PLAIN"
     credsToName c = error $ "credsToName failed for " ++ (show c)

source/Network/XMPP/SASL/PLAIN.hs

@@ -51,7 +51,7 @@ xmppPLAIN :: Maybe T.Text
           -> XMPPConMonad (Either AuthError ())
 xmppPLAIN authzid authcid passwd = runErrorT $ do
     _ <- lift . pushElement $ saslInitE "PLAIN" $ -- TODO: Check boolean?
-        Just $ plainMessage authzid authcid passwd
+        Just $ Text.decodeUtf8 $ B64.encode $ Text.encodeUtf8 $ plainMessage authzid authcid passwd
     lift $ pushElement saslResponse2E
     e <- lift pullElement
     case e of