Added stubs for PresenceProbe message

1 files changed, 15 insertions, 6 deletions

diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 86f2df44..0fd49c2b 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -7,8 +7,11 @@ module XMPP
     , module SocketLike
     , listenForXmppClients
     , listenForRemotePeers
+    , newServerConnections
     , seekRemotePeers
     , quitListening
+    , OutBoundMessage(..)
+    , sendMessage
     )  where
 
 import ServerC
@@ -80,9 +83,11 @@ import NestingXML
 import           Data.Set as Set (Set)
 import qualified Data.Set as Set
 import qualified Data.Map as Map
+import           Data.Map as Map (Map)
 import GHC.Conc 
     ( threadStatus
     , ThreadStatus(..)
+    , ThreadId
     )
 
 data Commands = Send [XML.Event] | QuitThread
@@ -573,10 +578,10 @@ seekRemotePeers config chan = do
     return ()
 -}
 
-data OutBoundMessage = OutBoundPresence Presence
+data OutBoundMessage = OutBoundPresence Presence | PresenceProbe JID
  deriving Prelude.Show
 
-newServerConnections = atomically $ newTVar Map.empty
+newServerConnections = newTVar Map.empty
 
 connect_to_server chan peer = (>> return ()) . runMaybeT $ do
     let port = 5269 :: Int
@@ -600,6 +605,9 @@ connect_to_server chan peer = (>> return ()) . runMaybeT $ do
                 cached_map <- readIORef cached
                 writeIORef cached (Map.insert jid st cached_map)
                 loop
+            Left (PresenceProbe jid) -> do
+                liftIO $ putStrLn "Connection not ready, Discarding Presence Probe..."
+                loop
             {-
             Left event -> do
                 L.putStrLn $ "REMOTE-OUT DISCARDED: " <++> bshow event
@@ -642,6 +650,8 @@ toPeer sock cache chan = do
           OutBoundPresence p -> do
             r <- lift $ xmlifyPresenceForPeer sock p
             send r
+          PresenceProbe jid  -> do
+            liftIO $ putStrLn ("Connection ready, PresenceProbe " ++ show jid ++ " (NOT IMPLEMENTED)")
         loop
     send goodbyePeer
 
@@ -686,7 +696,7 @@ connect' addr port = do
         )
 
 
-
+sendMessage  :: TVar (Map Peer (TChan OutBoundMessage, ThreadId)) -> OutBoundMessage -> Peer -> IO ()
 sendMessage cons msg peer = do
     found <- atomically $ do
         consmap <- readTVar cons
@@ -720,9 +730,8 @@ sendMessage cons msg peer = do
 
 
 seekRemotePeers :: XMPPConfig config =>
-     config -> TChan Presence -> IO b0
-seekRemotePeers config chan = do
-    server_connections <- newServerConnections
+     config -> TChan Presence -> TVar (Map Peer (TChan OutBoundMessage, ThreadId)) -> IO b0
+seekRemotePeers config chan server_connections = do
     fix $ \loop -> do
         event <- atomically $ readTChan chan
         case event of