tox: Automatically share dhtkey with roster contacts.

1 files changed, 7 insertions, 1 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index d7a069b4..28bfc9b4 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -1718,7 +1718,13 @@ main = runResourceT $ liftBaseWith $ \resT -> do
             forM_ msv $ \sv -> do
                 let Tox.HaveDHTKey saddr = Tox.ncSockAddr netcrypto
                 announceToxJabberPeer (Tox.ncTheirPublicKey netcrypto) (xmppEventChannel sv) addrTox saddr pingflag xmppSrc xmppSink
-            -- TODO: Update toxContactInfo, connected.
+                forM_ mbtox $ \tox -> do
+                let ContactInfo{accounts} = Tox.toxContactInfo tox
+                mbacc <- HashMap.lookup (Tox.key2id $ Tox.ncMyPublicKey netcrypto)
+                         <$> atomically (readTVar accounts)
+                forM_ mbacc $ \acnt -> do
+                now <- getPOSIXTime
+                atomically $ setEstablished now (Tox.ncTheirPublicKey netcrypto) acnt
             atomically $ do
                 supply <- readTVar (Tox.listenerIDSupply netCryptoSessionsState)
                 let (listenerId,supply') = freshId supply