4 files changed, 81 insertions, 4 deletions

diff --git a/avahi.hs b/avahi.hs
new file mode 100644
index 00000000..2db3be71
--- /dev/null
+++ b/avahi.hs
@@ -0,0 +1,14 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+
+import           BasePrelude
+import           Network.Tox.Avahi
+
+exampleNodeId :: NodeId
+exampleNodeId = read $ replicate 43 'a'
+
+main :: IO ()
+main = do
+  [hostname, port, nodeId] <- getArgs
+  void $ announceToxService hostname (fromMaybe 54321 $ readMaybe port) (fromMaybe exampleNodeId $ readMaybe nodeId)
+  void $ queryToxService print
+  void $ getLine
diff --git a/dht-client.cabal b/dht-client.cabal
index bd660a4b..50635be3 100644
--- a/dht-client.cabal
+++ b/dht-client.cabal
@@ -248,6 +248,13 @@ library
   else
         build-depends: cryptonite >= 0.22
 
+executable avahi
+  hs-source-dirs:      .
+  main-is:             avahi.hs
+  default-language:    Haskell2010
+  build-depends:       base-prelude, dht-client, avahi, network
+  ghc-options:         -fobject-code
+
 executable dht
   hs-source-dirs:      examples
   main-is:             dht.hs
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)
diff --git a/stack.yaml b/stack.yaml
index 32715280..6de07aed 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -9,5 +9,5 @@ extra-package-dbs: []
 extra-deps:
 - cryptonite-0.23
 - reference-0.1
-- git: https://github.com/portnov/hs-avahi.git
-  commit: d41b179e1163746adcbc1c898e33a77dc8b8174e
+- git: https://github.com/afcady/hs-avahi.git
+  commit: 5ec3bef32d40652b987b256eea8f85e7e8f2e5bb