blob: ed52de74bceb4f57f81cad8354594692556c2325 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
|
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Network.Tox.Avahi
( module Network.Tox.Avahi
, NodeInfo(..)
, NodeId(..)
) where
import Data.Foldable
import GHC.Word (Word16)
import Network.Address
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
}
announceToxServiceWithHostname :: String -> PortNumber -> NodeId -> IO ()
announceToxServiceWithHostname = ((.).(.).(.)) announce toxService
announceToxService :: PortNumber -> NodeId -> IO ()
announceToxService = announceToxServiceWithHostname ""
queryToxService :: (NodeInfo -> IO ()) -> IO ()
queryToxService cb =
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)
|
