1 files changed, 23 insertions, 2 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index eec04846..acd1e45b 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -7,6 +7,7 @@ import qualified Data.Conduit.List  as CL
 import Data.XML.Types               as XML
 import Network.Tox.Crypto.Transport as Tox
 import XMPPServer                   as XMPP
+import EventUtil
 
 import ClientState
 import Control.Concurrent.STM
@@ -36,10 +37,30 @@ xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage
 xmppToTox = do
     awaitForever (\_ -> return ())
 
-toxToXmpp :: Text -> Conduit Tox.CryptoMessage IO XML.Event
+toxToXmpp :: Monad m => Text -> Conduit Tox.CryptoMessage m XML.Event
 toxToXmpp toxhost = do
     CL.sourceList $ XMPP.greet' "jabber:server" toxhost
-    awaitForever (\_ -> return ())
+    awaitForever $ \toxmsg -> do
+        xmppInstantMessage "jabber:server" (Just toxhost) (T.pack $ show $ msgID toxmsg)
+
+xmppInstantMessage :: Monad m => Text -> Maybe Text -> Text -> ConduitM i Event m ()
+xmppInstantMessage namespace mfrom text = do
+    let ns n = n { nameNamespace = Just namespace }
+    C.yield $ EventBeginElement (ns "message")
+               ((maybe id (\t->(attr "from" t:)) mfrom)
+                 [attr "type" "normal" ])
+    C.yield $   EventBeginElement (ns "body") []
+    C.yield $     EventContent $ ContentText text
+    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 $          EventContent $ ContentText text
+    C.yield $        EventEndElement "{http://www.w3.org/1999/xhtml}p"
+    C.yield $     EventEndElement "{http://www.w3.org/1999/xhtml}body"
+    C.yield $   EventEndElement "{http://jabber.org/protocol/xhtml-im}html"
+    C.yield $ EventEndElement (ns "message")
 
 key2jid :: Word32 -> PublicKey -> Text
 key2jid nospam key = T.pack $ show $ NoSpamId nsp key