1 files changed, 41 insertions, 29 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index b75ada6a..9979526a 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -15,14 +15,19 @@ module ToxToXMPP
     , interweave
     ) where
 
-import Data.Conduit                 as C
-import qualified Data.Conduit.List  as CL
-import Data.XML.Types               as XML
+import Control.Applicative
+import Data.Conduit                    as C
+import qualified Data.Conduit.List     as CL
+import Data.Monoid
+import Data.Text.Encoding              as T
+import Data.XML.Types                  as XML
 import EventUtil
-import Network.Tox.Crypto.Transport as Tox
-import Network.Tox.Handshake        (HandshakeParams (..))
-import Util                         (unsplitJID)
-import XMPPServer                   as XMPP
+import Network.Tox.Crypto.Transport    as Tox
+import Network.Tox.Handshake           (HandshakeParams (..))
+import qualified Text.XML.Stream.Parse as XML
+import Util                            (unsplitJID)
+import XMPPServer                      as XMPP
+
 
 import Announcer
 import Announcer.Tox
@@ -71,31 +76,39 @@ import GHC.Conc                  (labelThread)
 #endif
 import DPut
 import Nesting
-
-xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage
-xmppToTox = doNestingXML $ do
-    eventBeginDocument <- await
-    streamTag <- await
-    fix $ \loop -> do
-    e <- nextElement
-    -- dput DPut.XMan $ "xmppToTox: " ++ show e
-    --
-    -- (yield e >> awaitForever yield) $$ prettyPrint "xmpp->Tox"
-    -- prettyPrint
-    loop
+import XMPPToTox
 
 toxToXmpp :: Monad m => SockAddr -> PublicKey -> Text -> Conduit Tox.CryptoMessage m XML.Event
 toxToXmpp laddr me theirhost = do
     CL.sourceList $ XMPP.greet' "jabber:server" theirhost
     let me_u = T.pack $ show (key2id me)
-    awaitForever $ \toxmsg -> do
-        xmppInstantMessage "jabber:server"
-            (Just theirhost)      -- /from/
-            (Just $ unsplitJID (Just me_u,T.pack (show laddr),Nothing)) -- /to/ should match local address of this node.
-            (T.pack $ show $ msgID toxmsg)
-
-xmppInstantMessage :: Monad m => Text -> Maybe Text -> Maybe Text -> Text -> ConduitM i Event m ()
-xmppInstantMessage namespace mfrom mto text = do
+    awaitForever $ \case
+
+        UpToN { msgID    = MESSAGE
+              , msgBytes = bs      }
+               -> do
+            xmppInstantMessage "jabber:server"
+                (Just $ "root@" <> theirhost)      -- /from/
+                (Just $ unsplitJID (Just me_u,T.pack (show laddr),Nothing)) -- /to/ should match local address of this node.
+                []
+                (T.decodeUtf8 bs)
+
+        toxmsg | msgID toxmsg == PacketRequest -> return ()
+
+        toxmsg -> do
+            xmppInstantMessage "jabber:server"
+                (Just theirhost)      -- /from/
+                (Just $ unsplitJID (Just me_u,T.pack (show laddr),Nothing)) -- /to/ should match local address of this node.
+                [ attr "style" "font-weight:bold; color:red" ]
+                (T.pack $ show $ msgID toxmsg)
+
+xmppInstantMessage :: Monad m => Text
+                              -> Maybe Text
+                              -> Maybe Text
+                              -> [(Name, [Content])]
+                              -> Text
+                              -> ConduitM i Event m ()
+xmppInstantMessage namespace mfrom mto style text = do
     let ns n = n { nameNamespace = Just namespace }
     C.yield $ EventBeginElement (ns "message")
                (  maybe id (\t->(attr "from" t:)) mfrom
@@ -106,8 +119,7 @@ xmppInstantMessage namespace mfrom mto text = do
     C.yield $   EventEndElement (ns "body")
     C.yield $   EventBeginElement "{http://jabber.org/protocol/xhtml-im}html" []
     C.yield $     EventBeginElement "{http://www.w3.org/1999/xhtml}body" []
-    C.yield $        EventBeginElement "{http://www.w3.org/1999/xhtml}p"
-                       [ attr "style" "font-weight:bold; color:red" ]
+    C.yield $        EventBeginElement "{http://www.w3.org/1999/xhtml}p" style
     C.yield $          EventContent $ ContentText text
     C.yield $        EventEndElement "{http://www.w3.org/1999/xhtml}p"
     C.yield $     EventEndElement "{http://www.w3.org/1999/xhtml}body"