Sends incomming messages to client, checked in overlooked file

Logging.hs

2 files changed, 39 insertions, 1 deletions

diff --git a/Presence/Logging.hs b/Presence/Logging.hs
new file mode 100644
index 00000000..f55e2e79
--- /dev/null
+++ b/Presence/Logging.hs
@@ -0,0 +1,17 @@
+module Logging where
+
+import qualified Data.ByteString.Lazy.Char8 as L
+import qualified Data.ByteString.Char8 as S
+import qualified Data.Text.IO as Text
+import qualified Debug.Trace as Debug
+
+
+debugStr str = putStrLn str
+
+debugL bs = L.putStrLn bs
+
+debugS bs = S.putStrLn bs
+
+debugText text = Text.putStrLn text
+
+trace str a = Debug.trace str a
diff --git a/Presence/XMPP.hs b/Presence/XMPP.hs
index 1c6336b9..df19f211 100644
--- a/Presence/XMPP.hs
+++ b/Presence/XMPP.hs
@@ -478,7 +478,10 @@ toClient session pchan cmdChan rchan = toClient' False False
       CmdChan InterestedInRoster -> do
         liftIO . debugStr $ "Roster: interested"
         toClient' isBound True
-      CmdChan (Chat msg) -> return () -- TODO
+      CmdChan (Chat msg) -> do
+        xs <- liftIO $ xmlifyMessageForClient msg
+        send xs
+        loop
       -- CmdChan cmd        -> liftIO (debugStr $ "unhandled event: "++show cmd) >> loop
       RChan   (RequestedSubscription who contact) ->  do
         jid <- liftIO $ getJID session
@@ -1120,6 +1123,24 @@ xmlifyPresenceForPeer sock (Presence jid stat) = do
       , EventContent (ContentText stat)
       , EventEndElement "{jabber:server}show" ]
 
+xmlifyMessageForClient msg = do
+    let tojid = msgTo msg
+        fromjid = msgFrom msg
+    tonames <- getNamesForPeer (peer tojid)
+    fromnames <- getNamesForPeer (peer fromjid)
+    let mk_str ns jid = toStrict . L.decodeUtf8 $ name jid <$++> "@" <?++> L.fromChunks [head ns] <++?> "/" <++$> resource jid
+        to_str   = mk_str tonames   tojid
+        from_str = mk_str fromnames fromjid
+    return $
+        [ EventBeginElement "{jabber:client}message" 
+            [ attr "from" from_str
+            , attr "to"   to_str
+            ]
+        ]
+        ++ xmlifyMsgElements (msgLangMap msg) ++
+        [ EventEndElement "{jabber:client}message" ]
+    
+
 xmlifyMessageForPeer sock msg = do
     addr <- getSocketName sock
     remote <- getPeerName sock