Forward instant messages from XMPP clients to Tox peers.

2 files changed, 52 insertions, 3 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index fefec650..e099334e 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1982,14 +1982,22 @@ main = do
                 xmppSink         = newXmmpSink netcrypto
             forM_ msv $ \sv -> do
                 let Tox.HaveDHTKey saddr = Tox.ncSockAddr netcrypto
-                announceToxJabberPeer (Tox.ncMyPublicKey netcrypto) (Tox.ncTheirPublicKey netcrypto) (xmppEventChannel sv) addrTox saddr pingflag xmppSrc xmppSink
+                    Tox.HaveDHTKey dkey  = Tox.ncTheirDHTKey netcrypto
+                    nid                  = Tox.key2id dkey
+                    them                 = Tox.ncTheirPublicKey netcrypto
+                    me                   = Tox.ncMyPublicKey netcrypto
+                announceToxJabberPeer me them (xmppEventChannel sv) addrTox saddr pingflag xmppSrc xmppSink
                 forM_ mbtox $ \tox -> do
                 let ContactInfo{accounts} = Tox.toxContactInfo tox
-                mbacc <- HashMap.lookup (Tox.key2id $ Tox.ncMyPublicKey netcrypto)
+                mbacc <- HashMap.lookup (Tox.key2id me)
                          <$> atomically (readTVar accounts)
+                -- TODO: Add account if it doesn't exist?
                 forM_ mbacc $ \acnt -> do
                 now <- getPOSIXTime
-                atomically $ setEstablished now (Tox.ncTheirPublicKey netcrypto) acnt
+                forM_ (either (const Nothing) Just $ Tox.nodeInfo nid saddr)
+                    $ \ni -> do
+                atomically $ do setEstablished now them acnt
+                                setContactAddr now them ni acnt
             atomically $ do
                 supply <- readTVar (Tox.listenerIDSupply netCryptoSessionsState)
                 let (listenerId,supply') = freshId supply
diff --git a/examples/test-xmpp.hs b/examples/test-xmpp.hs
new file mode 100644
index 00000000..a8e20c3c
--- /dev/null
+++ b/examples/test-xmpp.hs
@@ -0,0 +1,41 @@
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Resource
+-- import Control.Monad.Trans.Class
+import Data.Conduit
+import Data.Conduit.List            as CL
+-- import Data.XML.Types
+import System.Environment
+import Text.XML.Stream.Parse
+
+import XMPPToTox
+
+{-
+parse :: ConduitM Event o (ResourceT IO) ()
+parse = do
+    return ()
+-}
+
+showTox :: CryptoMessage -> ResourceT IO ()
+showTox = liftIO . print
+
+main :: IO ()
+main = do
+    args <- getArgs
+    let xmlfile = args !! 0
+
+    -- runConduit :: Monad m => ConduitM () Void m r -> m r
+
+    -- test-xmpp.hs:19:51: warning: [-Wdeprecations]
+    --    In the use of ‘$$’
+    --    (imported from Data.Conduit, but defined in conduit-1.3.0.3:Data.Conduit.Internal.Conduit):
+    --    Deprecated: "Use runConduit and .|"
+    --
+    -- runResourceT $ parseFile def xmlfile =$= parse $$ return ()
+
+    runResourceT $ runConduit $ do
+        parseFile def xmlfile
+            .| xmppToTox
+            -- CL.mapM_ :: Monad m => (a -> m ()) -> ConduitT a o m ()
+            .| CL.mapM_ showTox
+