WIP: Deliver tox generated messages to xmpp clients.

1 files changed, 13 insertions, 8 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index f4a7cbab..2ab59568 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -83,18 +83,23 @@ xmppToTox = doNestingXML $ fix $ \loop -> do
     dput DPut.XMan $ "xmppToTox: " ++ show e
     loop
 
-toxToXmpp :: Monad m => Text -> Conduit Tox.CryptoMessage m XML.Event
-toxToXmpp toxhost = do
-    CL.sourceList $ XMPP.greet' "jabber:server" toxhost
+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 toxhost) (T.pack $ show $ msgID toxmsg)
+        xmppInstantMessage "jabber:server"
+            (Just theirhost)      -- /from/
+            (Just $ unsplitJID (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 -> Text -> ConduitM i Event m ()
-xmppInstantMessage namespace mfrom text = do
+xmppInstantMessage :: Monad m => Text -> Maybe Text -> Maybe Text -> Text -> ConduitM i Event m ()
+xmppInstantMessage namespace mfrom mto text = do
     let ns n = n { nameNamespace = Just namespace }
     C.yield $ EventBeginElement (ns "message")
-               ((maybe id (\t->(attr "from" t:)) mfrom)
-                 [attr "type" "normal" ])
+               (  maybe id (\t->(attr "from" t:)) mfrom
+                $ maybe id (\t->(attr "to" t:)) mto
+                $ [attr "type" "normal" ] )
     C.yield $   EventBeginElement (ns "body") []
     C.yield $     EventContent $ ContentText text
     C.yield $   EventEndElement (ns "body")