{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ViewPatterns #-} module Network.Tox.Avahi ( module Network.Tox.Avahi , NodeInfo(..) , NodeId ) where import Control.Applicative import Data.Foldable import Network.Address import Network.BSD (getHostName) import Network.Tox.NodeId import Text.Read #if defined(VERSION_avahi) import Network.Avahi #else data Service = Service #endif toxServiceName :: String toxServiceName = "_tox_dht._udp" toxServiceDomain :: String toxServiceDomain = "local" (<.>) :: String -> String -> String a <.> b = a ++ "." ++ b toxService :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> Service toxService hostname (fromIntegral -> port) dhtkey toxid = Service #if defined(VERSION_avahi) { serviceProtocol = PROTO_UNSPEC, serviceName = "Tox DHT @ " ++ hostname, serviceType = toxServiceName, serviceDomain = toxServiceDomain, serviceHost = if null hostname then "" else hostname <.> toxServiceDomain, serviceAddress = Nothing, servicePort = port, serviceText = maybe (show dhtkey) (show . ((,) dhtkey)) toxid } #endif announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> IO () #if defined(VERSION_avahi) announceToxServiceWithHostname = (boobs.boobs) announce toxService where boobs = ((.).(.)) #else announceToxServiceWithHostname _ _ _ _ = return () #endif announceToxService :: PortNumber -> NodeId -> (Maybe NodeId) -> IO () announceToxService a b c = do h <- getHostName announceToxServiceWithHostname h a b c queryToxService :: (NodeInfo -> Maybe NodeId -> IO ()) -> IO () queryToxService cb = #if defined(VERSION_avahi) browse $ BrowseQuery { lookupProtocol = PROTO_UNSPEC , lookupServiceName = toxServiceName , lookupDomain = toxServiceDomain , lookupCallback = runCallback } where 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) (snd <$> both) #else return () #endif