Progress toward support for messaging.

1 files changed, 30 insertions, 2 deletions

diff --git a/Presence/main.hs b/Presence/main.hs
index d7510f94..784faaca 100644
--- a/Presence/main.hs
+++ b/Presence/main.hs
@@ -56,7 +56,10 @@ import Network.Socket (Family(AF_INET,AF_INET6))
 import           Holumbus.Data.MultiMap as MM (MultiMap)
 import qualified Holumbus.Data.MultiMap as MM
 
-data Client = Client { clientShow :: JabberShow }
+data Client = Client { 
+    clientShow :: JabberShow,
+    clientChan :: TChan ClientCommands
+ }
 
 -- see Data.Map.Lazy.fromSet
 fromSet f = Map.fromList . map (\a -> (a,f a)) . Set.toList
@@ -195,7 +198,12 @@ instance JabberClientSession ClientSession where
             let au = activeUsers . presence_state $ s
             us <- readTVar au
             sequenceA $ Map.lookup (user,tty) us >>= \(ttypid,cs) -> do
-                let entry = (ttypid,Map.insert client_pid (Client {clientShow=stat}) cs)
+                let entry = (ttypid, Map.insert client_pid 
+                                                (Client {
+                                                     clientShow = stat,
+                                                     clientChan = Main.clientChannel s
+                                                 }) 
+                                                cs)
                 Just $ do
                     writeTVar au (Map.insert (user,tty) entry us)
                     subs <- readTVar $ subscriberMap (presence_state s)
@@ -394,6 +402,11 @@ instance JabberClientSession ClientSession where
                     (peer cjid)
         return ()
 
+    sendChat s msg = do
+        sendMessage (remotePeers . presence_state $ s) 
+                    (OutBoundMessage msg)
+                    (peer . msgTo $ msg)
+
 
 {- PeerSession 
  -
@@ -508,6 +521,21 @@ instance JabberPeerSession PeerSession where
         withJust mbuddy $ \buddy -> do
         rosterPush (PendingSubscriber user buddy) (peer_global session)
 
+    sendChatToClient session msg = do
+        let rsc = resource (msgTo msg)
+            g = peer_global session
+        (curtty,cmap) <- atomically $ liftM2 (,) (readTVar (currentTTY g))
+                                                 (readTVar (activeUsers g))
+                   
+        let rsc' = maybe curtty id rsc
+        withJust (name (msgTo msg)) $ \nto -> do
+        case Map.lookup (nto,rsc') cmap of
+            Just (ttypid,clients) -> 
+                forM_ (Map.toList clients) $ \(pid,client) -> do
+                    atomically $ writeTChan (clientChan client) (Chat msg)
+            Nothing            -> 
+                -- todo: fallback
+                return () 
 
 
 type RefCount = Int