{-# OPTIONS_GHC -Wall #-}
{-# 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.Avahi
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 -> (Maybe NodeId) -> Service
toxService hostname (fromIntegral -> port) dhtkey toxid =
  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     = maybe (show dhtkey) (show . ((,) dhtkey)) toxid
  }

announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
announceToxServiceWithHostname  = (boobs.boobs) announce toxService
  where boobs = ((.).(.))

announceToxService :: PortNumber -> NodeId -> (Maybe NodeId) -> IO ()
announceToxService = announceToxServiceWithHostname ""

queryToxService :: (NodeInfo -> Maybe NodeId -> IO ()) -> IO ()
queryToxService cb =
  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)