2 files changed, 36 insertions, 23 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 93d42eca..00dfcf9f 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -486,12 +486,20 @@ routing4nodeInfo :: DHT.Routing -> IO NodeInfo
 routing4nodeInfo (DHT.routing4 -> tv) = R.thisNode <$> readTVarIO tv
 
 dnssdAnnounce :: Tox extra -> IO ()
-dnssdAnnounce (toxRouting -> r) = do
-    ni <- routing4nodeInfo r
-    announceToxService (nodePort ni) (nodeId ni)
-
-dnssdDiscover :: Tox extra -> NodeInfo -> IO ()
-dnssdDiscover (toxDHT -> client) ni = void $ DHT.ping client ni
+dnssdAnnounce tox = do
+  ni   <- routing4nodeInfo (toxRouting tox)
+  keys <- fmap (key2id . snd) <$> atomically (userKeys $ toxCryptoKeys tox)
+  announceToxService (nodePort ni) (nodeId ni) (listToMaybe keys)
+
+dnssdDiscover :: Tox extra -> NodeInfo -> (Maybe NodeId) -> IO ()
+dnssdDiscover tox ni toxid = do
+  acts <- atomically $ readTVar $ accounts $ toxContactInfo tox
+  now  <- getPOSIXTime
+  forM toxid $ \tid ->
+    forM acts $ \act ->
+      atomically $ setContactAddr now (id2key tid) ni act
+
+  void $ DHT.ping (toxDHT tox) ni
 
 forkTox :: Tox extra -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ())
 forkTox tox = do
diff --git a/src/Network/Tox/Avahi.hs b/src/Network/Tox/Avahi.hs
index 7fe87db2..559e5fd7 100644
--- a/src/Network/Tox/Avahi.hs
+++ b/src/Network/Tox/Avahi.hs
@@ -1,16 +1,18 @@
+{-# OPTIONS_GHC -Wall #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ViewPatterns    #-}
 module Network.Tox.Avahi
   ( module Network.Tox.Avahi
   , NodeInfo(..)
-  , NodeId(..)
+  , NodeId
   ) where
 
-import           Data.Foldable
-import           Network.Address
-import           Network.Avahi
-import           Network.Tox.NodeId
-import           Text.Read
+import Control.Applicative
+import Data.Foldable
+import Network.Address
+import Network.Avahi
+import Network.Tox.NodeId
+import Text.Read
 
 toxServiceName :: String
 toxServiceName = "_tox_dht._udp"
@@ -21,8 +23,8 @@ toxServiceDomain = "local"
 (<.>) :: String -> String -> String
 a <.> b = a ++ "." ++ b
 
-toxService :: String -> PortNumber -> NodeId -> Service
-toxService hostname (fromIntegral -> port) (show -> extra) =
+toxService :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> Service
+toxService hostname (fromIntegral -> port) dhtkey toxid =
   Service {
     serviceProtocol = PROTO_UNSPEC,
     serviceName     = "Tox DHT @ " ++ hostname,
@@ -31,16 +33,17 @@ toxService hostname (fromIntegral -> port) (show -> extra) =
     serviceHost     = if null hostname then "" else hostname <.> toxServiceDomain,
     serviceAddress  = Nothing,
     servicePort     = port,
-    serviceText     = extra
+    serviceText     = maybe (show dhtkey) (show . ((,) dhtkey)) toxid
   }
 
-announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> IO ()
-announceToxServiceWithHostname  = ((.).(.).(.)) announce toxService
+announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
+announceToxServiceWithHostname  = (boobs.boobs) announce toxService
+  where boobs = ((.).(.))
 
-announceToxService :: PortNumber -> NodeId -> IO ()
+announceToxService :: PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
 announceToxService = announceToxServiceWithHostname ""
 
-queryToxService :: (NodeInfo -> IO ()) -> IO ()
+queryToxService :: (NodeInfo -> Maybe NodeId -> IO ()) -> IO ()
 queryToxService cb =
   browse $
   BrowseQuery
@@ -50,8 +53,10 @@ queryToxService cb =
   , lookupCallback    = runCallback
   }
   where
-    runCallback x@Service {..} = do
-      let nid = readMaybe serviceText
+    runCallback Service {..} = do
+      let both :: Maybe (NodeId, NodeId)
+          both = readMaybe serviceText
+          nid  = (fst <$> both) <|> readMaybe serviceText
           addr = readMaybe =<< serviceAddress
-          p = fromIntegral servicePort
-      forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p)
+          p    = fromIntegral servicePort
+      forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p) (snd <$> both)