1 files changed, 58 insertions, 2 deletions

diff --git a/src/Network/Tox/Avahi.hs b/src/Network/Tox/Avahi.hs
index 58921744..ba5138bc 100644
--- a/src/Network/Tox/Avahi.hs
+++ b/src/Network/Tox/Avahi.hs
@@ -1,2 +1,58 @@
-module Network.Tox.Avahi where
-import Network.Avahi
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns    #-}
+module Network.Tox.Avahi
+  ( module Network.Tox.Avahi
+  , NodeInfo(..)
+  , NodeId(..)
+  ) where
+import           Data.Foldable
+import           GHC.Conc.Sync
+import           GHC.Word           (Word16)
+import           Network.Address
+import           Network.Avahi
+import           Network.Avahi
+import           Network.Socket
+import           Network.Tox.NodeId
+import           Text.Read
+
+toxServiceName :: String
+toxServiceName = "_tox_dht._udp"
+
+toxServiceDomain :: String
+toxServiceDomain = "local"
+
+(<.>) :: String -> String -> String
+a <.> b = a ++ "." ++ b
+
+toxService :: String -> PortNumber -> NodeId -> Service
+toxService hostname (fromIntegral -> port) (show -> extra) =
+  Service {
+    serviceProtocol = PROTO_UNSPEC,
+    serviceName     = "Tox DHT @ " ++ hostname,
+    serviceType     = toxServiceName,
+    serviceDomain   = toxServiceDomain,
+    serviceHost     = if null hostname then "" else hostname <.> toxServiceDomain,
+    serviceAddress  = Nothing,
+    servicePort     = port,
+    serviceText     = extra
+  }
+
+announceToxService :: String -> PortNumber -> NodeId -> IO ThreadId
+announceToxService = ((.).(.).(.)) (forkIO . announce) toxService
+
+queryToxService :: (NodeInfo -> IO ()) -> IO ThreadId
+queryToxService cb =
+  forkIO $
+  browse $
+  BrowseQuery
+  { lookupProtocol    = PROTO_UNSPEC
+  , lookupServiceName = toxServiceName
+  , lookupDomain      = toxServiceDomain
+  , lookupCallback    = runCallback
+  }
+  where
+    runCallback x@Service {..} = do
+      let nid = readMaybe serviceText
+          addr = readMaybe =<< serviceAddress
+          p = fromIntegral servicePort
+      forM_ nid $ \n -> forM_ addr $ \a -> cb (NodeInfo n a p)