diff options
-rw-r--r-- | Presence/Logging.hs | 17 | ||||
-rw-r--r-- | Presence/XMPP.hs | 23 |
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 @@ | |||
1 | module Logging where | ||
2 | |||
3 | import qualified Data.ByteString.Lazy.Char8 as L | ||
4 | import qualified Data.ByteString.Char8 as S | ||
5 | import qualified Data.Text.IO as Text | ||
6 | import qualified Debug.Trace as Debug | ||
7 | |||
8 | |||
9 | debugStr str = putStrLn str | ||
10 | |||
11 | debugL bs = L.putStrLn bs | ||
12 | |||
13 | debugS bs = S.putStrLn bs | ||
14 | |||
15 | debugText text = Text.putStrLn text | ||
16 | |||
17 | 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 | |||
478 | CmdChan InterestedInRoster -> do | 478 | CmdChan InterestedInRoster -> do |
479 | liftIO . debugStr $ "Roster: interested" | 479 | liftIO . debugStr $ "Roster: interested" |
480 | toClient' isBound True | 480 | toClient' isBound True |
481 | CmdChan (Chat msg) -> return () -- TODO | 481 | CmdChan (Chat msg) -> do |
482 | xs <- liftIO $ xmlifyMessageForClient msg | ||
483 | send xs | ||
484 | loop | ||
482 | -- CmdChan cmd -> liftIO (debugStr $ "unhandled event: "++show cmd) >> loop | 485 | -- CmdChan cmd -> liftIO (debugStr $ "unhandled event: "++show cmd) >> loop |
483 | RChan (RequestedSubscription who contact) -> do | 486 | RChan (RequestedSubscription who contact) -> do |
484 | jid <- liftIO $ getJID session | 487 | jid <- liftIO $ getJID session |
@@ -1120,6 +1123,24 @@ xmlifyPresenceForPeer sock (Presence jid stat) = do | |||
1120 | , EventContent (ContentText stat) | 1123 | , EventContent (ContentText stat) |
1121 | , EventEndElement "{jabber:server}show" ] | 1124 | , EventEndElement "{jabber:server}show" ] |
1122 | 1125 | ||
1126 | xmlifyMessageForClient msg = do | ||
1127 | let tojid = msgTo msg | ||
1128 | fromjid = msgFrom msg | ||
1129 | tonames <- getNamesForPeer (peer tojid) | ||
1130 | fromnames <- getNamesForPeer (peer fromjid) | ||
1131 | let mk_str ns jid = toStrict . L.decodeUtf8 $ name jid <$++> "@" <?++> L.fromChunks [head ns] <++?> "/" <++$> resource jid | ||
1132 | to_str = mk_str tonames tojid | ||
1133 | from_str = mk_str fromnames fromjid | ||
1134 | return $ | ||
1135 | [ EventBeginElement "{jabber:client}message" | ||
1136 | [ attr "from" from_str | ||
1137 | , attr "to" to_str | ||
1138 | ] | ||
1139 | ] | ||
1140 | ++ xmlifyMsgElements (msgLangMap msg) ++ | ||
1141 | [ EventEndElement "{jabber:client}message" ] | ||
1142 | |||
1143 | |||
1123 | xmlifyMessageForPeer sock msg = do | 1144 | xmlifyMessageForPeer sock msg = do |
1124 | addr <- getSocketName sock | 1145 | addr <- getSocketName sock |
1125 | remote <- getPeerName sock | 1146 | remote <- getPeerName sock |