{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} module Network.Tox where #ifdef THREAD_DEBUG import Control.Concurrent.Lifted.Instrument #else import Control.Concurrent.Lifted #endif import Control.Concurrent.STM import Control.Monad import Crypto.PubKey.Curve25519 import Crypto.Random import Data.Bits.ByteString () import qualified Data.ByteString as B ;import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as C8 import Data.Data import Data.Functor.Contravariant import Data.IP import Data.Maybe import qualified Data.MinMaxPSQ as MinMaxPSQ import qualified Data.Serialize as S import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word import qualified Data.Wrapper.PSQ as PSQ import System.Global6 import Network.Address (WantIP (..)) import qualified Network.Kademlia.Routing as R import Network.QueryResponse import Network.Socket import System.Endian import Network.BitTorrent.DHT.Token as Token import Connection import Crypto.Tox import Data.Word64Map (fitsInInt) import qualified Data.Word64Map (empty) import HandshakeCache import Network.Kademlia.Bootstrap (forkPollForRefresh, bootstrap) import Network.Kademlia.Search import Network.Tox.Crypto.Transport (Handshake(..),CryptoPacket) import Network.Tox.Handshake import Network.Tox.Crypto.Handlers import qualified Network.Tox.DHT.Handlers as DHT import qualified Network.Tox.DHT.Transport as DHT import Network.Tox.NodeId import qualified Network.Tox.Onion.Handlers as Onion import qualified Network.Tox.Onion.Transport as Onion import Network.Tox.Transport import OnionRouter import Network.Tox.ContactInfo import Text.XXD import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import DPut import Network.Tox.Avahi import Text.Printf import Data.List newCrypto :: IO TransportCrypto newCrypto = do secret <- generateSecretKey alias <- generateSecretKey ralias <- generateSecretKey let pubkey = toPublic secret aliaspub = toPublic alias raliaspub = toPublic ralias ukeys <- atomically $ newTVar [] (symkey, drg) <- do drg0 <- getSystemDRG return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG) noncevar <- atomically $ newTVar $ fst $ withDRG drg drgNew cookieKeys <- atomically $ newTVar [] cache <- newSecretsCache dput XNetCrypto $ "secret(tox) = " ++ DHT.showHex secret dput XNetCrypto $ "public(tox) = " ++ DHT.showHex pubkey dput XNetCrypto $ "symmetric(tox) = " ++ DHT.showHex symkey return TransportCrypto { transportSecret = secret , transportPublic = pubkey , onionAliasSecret = alias , onionAliasPublic = aliaspub , rendezvousSecret = ralias , rendezvousPublic = raliaspub , transportSymmetric = return $ SymmetricKey symkey , transportNewNonce = do drg1 <- readTVar noncevar let (nonce, drg2) = withDRG drg1 (Nonce24 <$> getRandomBytes 24) writeTVar noncevar drg2 return nonce , transportNewKey = do drg1 <- readTVar noncevar let (k, drg2) = withDRG drg1 generateSecretKey writeTVar noncevar drg2 return k , userKeys = return [] , pendingCookies = cookieKeys , secretsCache = cache } updateIP :: TVar (R.BucketList NodeInfo) -> SockAddr -> STM () updateIP tblvar a = do bkts <- readTVar tblvar case nodeInfo (nodeId (R.thisNode bkts)) a of Right ni -> writeTVar tblvar (bkts { R.thisNode = ni }) Left _ -> return () genNonce24 :: DRG g => TVar (g, pending) -> DHT.TransactionId -> IO DHT.TransactionId genNonce24 var (DHT.TransactionId nonce8 _) = atomically $ do (g,pending) <- readTVar var let (bs, g') = randomBytesGenerate 24 g writeTVar var (g',pending) return $ DHT.TransactionId nonce8 (Nonce24 bs) gen :: forall gen. DRG gen => gen -> (DHT.TransactionId, gen) gen g = let (bs, g') = randomBytesGenerate 24 g (ws, g'') = randomBytesGenerate 8 g' Right w = S.runGet S.getWord64be ws in ( DHT.TransactionId (Nonce8 w) (Nonce24 bs), g'' ) intKey :: DHT.TransactionId -> Int intKey (DHT.TransactionId (Nonce8 w) _) = fromIntegral w w64Key :: DHT.TransactionId -> Word64 w64Key (DHT.TransactionId (Nonce8 w) _) = w nonceKey :: DHT.TransactionId -> Nonce8 nonceKey (DHT.TransactionId n _) = n -- | Return my own address. myAddr :: TVar (R.BucketList NodeInfo) -- ^ IPv4 buckets -> TVar (R.BucketList NodeInfo) -- ^ IPv6 buckets -> Maybe NodeInfo -- ^ Interested remote address -> IO NodeInfo myAddr routing4 routing6 maddr = atomically $ do let var = case flip DHT.prefer4or6 Nothing <$> maddr of Just Want_IP6 -> routing4 _ -> routing6 a <- readTVar var return $ R.thisNode a newClient :: (DRG g, Show addr, Show meth) => g -> Transport String addr x -> (Client String meth DHT.TransactionId addr x -> x -> MessageClass String meth DHT.TransactionId addr x) -> (Maybe addr -> IO addr) -> (Client String meth DHT.TransactionId addr x -> meth -> Maybe (MethodHandler String DHT.TransactionId addr x)) -> (forall d. TransactionMethods d DHT.TransactionId addr x -> TransactionMethods d DHT.TransactionId addr x) -> (Client String meth DHT.TransactionId addr x -> Transport String addr x -> Transport String addr x) -> IO (Client String meth DHT.TransactionId addr x) newClient drg net classify selfAddr handlers modifytbl modifynet = do -- If we have 8-byte keys for IntMap, then use it for transaction lookups. -- Otherwise, use ordinary Map. The details of which will be hidden by an -- existential closure (see mkclient below). -- tblvar <- if fitsInInt (Proxy :: Proxy Word64) then do let intmapT = transactionMethods (contramap intKey intMapMethods) gen intmap_var <- atomically $ newTVar (drg, mempty) return $ Right (intmapT,intmap_var) else do let word64mapT = transactionMethods (contramap w64Key w64MapMethods) gen map_var <- atomically $ newTVar (drg, Data.Word64Map.empty) return $ Left (word64mapT,map_var) let dispatch tbl var handlers client = DispatchMethods { classifyInbound = classify client , lookupHandler = handlers -- var , tableMethods = modifytbl tbl } eprinter = logErrors -- printErrors stderr mkclient (tbl,var) handlers = let client = Client { clientNet = addHandler (reportParseError eprinter) (handleMessage client) $ modifynet client net , clientDispatcher = dispatch tbl var (handlers client) client , clientErrorReporter = eprinter { reportTimeout = reportTimeout ignoreErrors } , clientPending = var , clientAddress = selfAddr , clientResponseId = genNonce24 var , clientEnterQuery = \_ -> return () , clientLeaveQuery = \_ _ -> return () } in client return $ either mkclient mkclient tblvar handlers data Tox extra = Tox { toxDHT :: DHT.Client , toxOnion :: Onion.Client RouteId , toxToRoute :: Transport String Onion.AnnouncedRendezvous (PublicKey,Onion.OnionData) , toxCrypto :: Transport String SockAddr (CryptoPacket Encrypted) , toxHandshakes :: Transport String SockAddr (Handshake Encrypted) , toxHandshakeCache :: HandshakeCache , toxCryptoSessions :: NetCryptoSessions , toxCryptoKeys :: TransportCrypto , toxRouting :: DHT.Routing , toxTokens :: TVar SessionTokens , toxAnnouncedKeys :: TVar Onion.AnnouncedKeys , toxOnionRoutes :: OnionRouter , toxContactInfo :: ContactInfo extra , toxAnnounceToLan :: IO () } -- | initiate a netcrypto session, blocking netCrypto :: Tox extra -> SecretKey -> PublicKey{-UserKey -} -> IO [NetCryptoSession] netCrypto tox myseckey theirpubkey = netCryptoWithBackoff 1000000 tox myseckey theirpubkey -- | helper for 'netCrypto', initiate a netcrypto session, retry after specified millisecs netCryptoWithBackoff :: Int -> Tox extra -> SecretKey -> PublicKey -> IO [NetCryptoSession] netCryptoWithBackoff millisecs tox myseckey theirpubkey = do let mykeyAsId = key2id (toPublic myseckey) -- TODO: check status of connection here: mbContactsVar <- fmap contacts . HashMap.lookup mykeyAsId <$> atomically (readTVar (accounts (toxContactInfo tox))) case mbContactsVar of Nothing -> do dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") accounts lookup failed.") return [] Just contactsVar -> do let theirkeyAsId = key2id theirpubkey mbContact <- HashMap.lookup theirkeyAsId <$> atomically (readTVar contactsVar) tup <- atomically $ do mc <- HashMap.lookup theirkeyAsId <$> readTVar contactsVar kp <- fmap join $ forM mc $ \c -> readTVar (contactKeyPacket c) sa <- fmap join $ forM mc $ \c -> readTVar (contactLastSeenAddr c) fr <- fmap join $ forM mc $ \c -> readTVar (contactFriendRequest c) cp <- fmap join $ forM mc $ \c -> readTVar (contactPolicy c) return (kp,sa,fr,cp) case tup of (Nothing,Nothing,Nothing,Nothing) -> do dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") friend not found (" ++ show theirkeyAsId ++ ").") return [] (mbKeyPkt,Nothing,mbFR,mbPolicy) -> do dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") no SockAddr for friend (" ++ show theirkeyAsId ++ "). TODO: search their node?") return [] (Nothing,_,_,_) -> do dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") no DHT-key for friend (" ++ show theirkeyAsId ++ "). TODO: what?") return [] (Just (stamp_theirDhtKey,keyPkt),Just (stamp_saddr,saddr),mbFR,mbPolicy) | theirDhtKey <- DHT.dhtpk keyPkt -> do -- Do we already have an active session with this user? sessionsMap <- atomically $ readTVar (netCryptoSessionsByKey (toxCryptoSessions tox) ) let sessionUsesIdentity key session = key == ncMyPublicKey session case Map.lookup theirpubkey sessionsMap of -- if sessions found, is it using this private key? Just sessions | matchedSessions <- filter (sessionUsesIdentity (toPublic myseckey)) sessions , not (null matchedSessions) -> do dput XNetCrypto ("netCrypto: Already have a session for " ++ show mykeyAsId ++ "<-->" ++ show theirkeyAsId) return matchedSessions -- if not, send handshake, this is separate session _ -> do -- if no session: -- Convert to NodeInfo, so we can send cookieRequest let crypto = toxCryptoKeys tox client = toxDHT tox case nodeInfo (key2id theirDhtKey) (nodeAddr saddr) of Left e -> dput XNetCrypto ("netCrypto: nodeInfo fail... " ++ e) >> return [] Right ni -> do mbCookie <- DHT.cookieRequest crypto client (toPublic myseckey) ni case mbCookie of Nothing -> do dput XNetCrypto ("netCrypto: (" ++ show mykeyAsId ++") <--> (" ++ show theirkeyAsId ++ ").") dput XNetCrypto ("netCrypto: CookieRequest failed. TODO: dhtpkNodes thingy") return [] Just cookie -> do dput XNetCrypto "Have cookie, creating handshake packet..." let hp = HParam { hpOtherCookie = cookie , hpMySecretKey = myseckey , hpCookieRemotePubkey = theirpubkey , hpCookieRemoteDhtkey = theirDhtKey , hpTheirBaseNonce = Nothing , hpTheirSessionKeyPublic = Nothing } newsession <- generateSecretKey timestamp <- getPOSIXTime (myhandshake,ioAction) <- atomically $ freshCryptoSession (toxCryptoSessions tox) (nodeAddr saddr) newsession timestamp hp ioAction -- send handshake forM myhandshake $ \response_handshake -> do sendHandshake (toxCryptoSessions tox) (nodeAddr saddr) response_handshake let secnum :: Double secnum = fromIntegral millisecs / 1000000 delay = (millisecs * 5 `div` 4) if secnum < 20000000 then do dput XNetCrypto $ "sent handshake, now delaying " ++ show (secnum * 1.25) ++ " second(s).." -- threadDelay delay -- Commenting loop for simpler debugging return [] -- netCryptoWithBackoff delay tox myseckey theirpubkey -- hopefully it will find an active session this time. else do dput XNetCrypto "Unable to establish session..." return [] -- | Create a DHTPublicKey packet to send to a remote contact. getContactInfo :: Tox extra -> IO DHT.DHTPublicKey getContactInfo Tox{toxCryptoKeys,toxRouting} = join $ atomically $ do r4 <- readTVar $ DHT.routing4 toxRouting r6 <- readTVar $ DHT.routing6 toxRouting nonce <- transportNewNonce toxCryptoKeys let self = nodeId n4 n4 = R.thisNode r4 n6 = R.thisNode r6 n4s = R.kclosest DHT.toxSpace 4 self r4 n6s = R.kclosest DHT.toxSpace 4 self r6 ns = filter (DHT.isGlobal . nodeIP) [n4,n6] ++ concat (zipWith (\a b -> [a,b]) n4s n6s) return $ do timestamp <- round . (* 1000000) <$> getPOSIXTime return DHT.DHTPublicKey { dhtpkNonce = timestamp , dhtpk = id2key self , dhtpkNodes = DHT.SendNodes $ take 4 ns } isLocalHost :: SockAddr -> Bool isLocalHost (SockAddrInet _ host32) = (fromBE32 host32 == 0x7f000001) isLocalHost _ = False addVerbosity :: Transport err SockAddr ByteString -> Transport err SockAddr ByteString addVerbosity tr = tr { awaitMessage = \kont -> awaitMessage tr $ \m -> do forM_ m $ mapM_ $ \(msg,addr) -> do when (not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x82,0x8c,0x8d])) $ do mapM_ (\x -> dput XMisc ( (show addr) ++ " --> " ++ x)) $ xxd 0 msg kont m , sendMessage = \addr msg -> do when (not (B.null msg || elem (B.head msg) [0,1,2,4,0x81,0x8c,0x8d])) $ do mapM_ (\x -> dput XMisc ( (show addr) ++ " <-- " ++ x)) $ xxd 0 msg sendMessage tr addr msg } newKeysDatabase :: IO (TVar Onion.AnnouncedKeys) newKeysDatabase = atomically $ newTVar $ Onion.AnnouncedKeys PSQ.empty MinMaxPSQ.empty getOnionAlias :: TransportCrypto -> STM NodeInfo -> Maybe (Onion.OnionDestination r) -> IO (Onion.OnionDestination r) getOnionAlias crypto dhtself remoteNode = atomically $ do ni <- dhtself let alias = case remoteNode of Just (Onion.OnionDestination (Onion.AnnouncingAlias _ uk) _ _) -> ni { nodeId = key2id uk } _ -> ni { nodeId = key2id (onionAliasPublic crypto) } return $ Onion.OnionDestination Onion.SearchingAlias alias Nothing mkDefaultDestroyHook :: ContactInfo extra -> NetCryptoSession -> IO () mkDefaultDestroyHook roster = \session -> do now <- getPOSIXTime r <- atomically $ do accounts <- readTVar (accounts roster) -- :: STM (HashMap NodeId (Account extra) let mbAccount = HashMap.lookup (key2id $ ncMyPublicKey session) accounts -- :: STM (Maybe (Account extra) case mbAccount of Just account -> do mp <- readTVar (netCryptoSessionsByKey (ncAllSessions session)) case Map.lookup (ncTheirPublicKey session) mp of Just sessionsWithThisPublicKey | relevantSessions <- filter ((/=ncSessionId session) . ncSessionId) sessionsWithThisPublicKey , not (null relevantSessions) -> do let showsession x = printf "%x" (ncSessionId x) return . Left $ "Not calling setTerminated on " ++ show (key2id (ncTheirPublicKey session)) ++" despite session(" ++ showsession session ++ ") failure. (Still have sessions: [" ++ Data.List.intercalate "," (map showsession relevantSessions) ++ "]" _ -> Right <$> setTerminated (ncTheirPublicKey session) account Nothing -> return . Left $ "(defaultDestroyHook) their is no account! pubkey=" ++ show (key2id (ncTheirPublicKey session)) case r of Left msg -> dput XMan msg _ -> return () newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rendezvous for. -> SockAddr -- ^ Bind-address to listen on. -> Maybe NetCryptoSessions -- ^ State of all one-on-one Tox links. -> Maybe SecretKey -- ^ Optional DHT secret key to use. -> IO (Tox extra) newTox keydb addr mbSessionsState suppliedDHTKey = do (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr tox <- newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox) } -- | This version of 'newTox' is useful for automated tests using 'testPairTransport'. newToxOverTransport :: TVar Onion.AnnouncedKeys -> SockAddr -> Maybe NetCryptoSessions -> Maybe SecretKey -> Onion.UDPTransport -> IO (Tox extra) newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp = do roster <- newContactInfo (crypto0,sessionsState0) <- case mbSessionsState of Nothing -> do crypto <- newCrypto sessionsState <- newSessionsState crypto (mkDefaultDestroyHook roster) defaultUnRecHook defaultCryptoDataHooks return (crypto,sessionsState) Just s -> do let oldhook = defaultDestroyHook s oldhook' = filter ((==0) . fst) oldhook newhook = (0,mkDefaultDestroyHook roster):oldhook' return (transportCrypto s, s { defaultDestroyHook = newhook}) let -- patch in supplied DHT key crypto1 = fromMaybe crypto0 $do k <- suppliedDHTKey return crypto0 { transportSecret = k , transportPublic = toPublic k } -- patch in newly allocated roster state. crypto = crypto1 { userKeys = myKeyPairs roster } forM_ suppliedDHTKey $ \k -> do maybe (dput XMisc "failed to encode suppliedDHTKey") (dputB XMisc . C8.append "Using suppliedDHTKey: ") $ encodeSecret k drg <- drgNew let lookupClose _ = return Nothing mkrouting <- DHT.newRouting addr crypto updateIP updateIP orouter <- newOnionRouter $ dput XRoutes (cryptonet,dhtcrypt,onioncrypt,dtacrypt,handshakes) <- toxTransport crypto orouter lookupClose udp let dhtnet0 = layerTransportM (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt tbl4 = DHT.routing4 $ mkrouting (error "missing client") tbl6 = DHT.routing6 $ mkrouting (error "missing client") dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr tbl4 tbl6) (DHT.handlers crypto . mkrouting) id $ \client net -> onInbound (DHT.updateRouting client (mkrouting client) orouter) net hscache <- newHandshakeCache crypto (sendMessage handshakes) let sessionsState = sessionsState0 { sendHandshake = sendMessage handshakes , sendSessionPacket = sendMessage cryptonet , transportCrypto = crypto -- ToxContact -> STM Policy , netCryptoPolicyByKey = policylookup } policylookup (ToxContact me them) = do macnt <- HashMap.lookup me <$> readTVar (accounts roster) case macnt of Nothing -> return RefusingToConnect Just acnt -> do mc <- HashMap.lookup them <$> readTVar (contacts acnt) case mc of Nothing -> return RefusingToConnect Just c -> fromMaybe RefusingToConnect <$> readTVar (contactPolicy c) orouter' <- forkRouteBuilder orouter $ \nid ni -> fmap (\(_,ns,_)->ns) <$> DHT.getNodes dhtclient (DHT.nodesOfInterest $ mkrouting dhtclient) nid ni toks <- do nil <- nullSessionTokens atomically $ newTVar nil { maxInterval = 20 } -- 20 second timeout on announce ping-ids. oniondrg <- drgNew let onionnet = layerTransportM (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt onionclient <- newClient oniondrg onionnet (const Onion.classify) (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 $ mkrouting dhtclient)) (const $ Onion.handlers onionnet (mkrouting dhtclient) toks keydb) (hookQueries orouter' DHT.transactionKey) (const id) return Tox { toxDHT = dhtclient , toxOnion = onionclient , toxToRoute = onInbound (updateContactInfo roster) dtacrypt , toxCrypto = addHandler (dput XMisc) (sessionPacketH sessionsState) cryptonet , toxHandshakes = addHandler (dput XMisc) (handshakeH sessionsState) handshakes , toxHandshakeCache = hscache , toxCryptoSessions = sessionsState , toxCryptoKeys = crypto , toxRouting = mkrouting dhtclient , toxTokens = toks , toxAnnouncedKeys = keydb , toxOnionRoutes = orouter , toxContactInfo = roster , toxAnnounceToLan = return () } onionTimeout :: Tox extra -> DHT.TransactionId -> Onion.OnionDestination RouteId -> STM (Onion.OnionDestination RouteId, Int) onionTimeout Tox { toxOnionRoutes = or } (DHT.TransactionId n8 _) od = lookupTimeout or n8 od routing4nodeInfo :: DHT.Routing -> IO NodeInfo routing4nodeInfo (DHT.routing4 -> tv) = R.thisNode <$> readTVarIO tv dnssdAnnounce :: Tox extra -> IO () dnssdAnnounce tox = do ni <- routing4nodeInfo (toxRouting tox) keys <- fmap (key2id . snd) <$> atomically (userKeys $ toxCryptoKeys tox) announceToxService (nodePort ni) (nodeId ni) (listToMaybe keys) dnssdDiscover :: Tox extra -> NodeInfo -> (Maybe NodeId) -> IO () dnssdDiscover tox ni toxid = do acts <- atomically $ readTVar $ accounts $ toxContactInfo tox now <- getPOSIXTime forM toxid $ \tid -> forM acts $ \act -> atomically $ setContactAddr now (id2key tid) ni act void $ DHT.ping (toxDHT tox) ni forkTox :: Tox extra -> Bool -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ()) forkTox tox with_avahi = do quitHs <- forkListener "toxHandshakes" (toxHandshakes tox) quitToRoute <- forkListener "toxToRoute" (toxToRoute tox) quitOnion <- forkListener "toxOnion" (clientNet $ toxOnion tox) quitDHT <- forkListener "toxDHT" (clientNet $ toxDHT tox) quitNC <- forkListener "toxCrypto" (toxCrypto tox) quitAvahi <- if with_avahi then do forkPollForRefresh (DHT.refresher4 $ toxRouting tox) forkPollForRefresh (DHT.refresher6 $ toxRouting tox) dnssdIn <- forkIO $ queryToxService (dnssdDiscover tox) dnssdOut <- forkIO $ dnssdAnnounce tox labelThread dnssdIn "tox-avahi-monitor" labelThread dnssdOut "tox-avahi-publish" return $ forM_ [dnssdIn,dnssdOut] killThread else return $ return () keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox) return ( do quitAvahi killThread keygc quitNC quitDHT quitOnion quitToRoute quitHs , bootstrap (DHT.refresher4 $ toxRouting tox) , bootstrap (DHT.refresher6 $ toxRouting tox) ) -- TODO: Don't export this. The exported interface is 'toxAnnounceToLan'. announceToLan :: Socket -> NodeId -> IO () announceToLan sock nid = do addrs <- broadcastAddrs forM_ addrs $ \addr -> do (broadcast_info:_) <- getAddrInfo (Just defaultHints { addrFlags = [AI_NUMERICHOST], addrSocketType = Datagram }) (Just addr) (Just "33445") let broadcast = addrAddress broadcast_info bs = S.runPut $ DHT.putMessage (DHT.DHTLanDiscovery nid) saferSendTo sock bs broadcast toxQSearch :: Tox extra -> Search NodeId (IP, PortNumber) Nonce32 NodeInfo Onion.Rendezvous toxQSearch tox = Onion.toxidSearch (onionTimeout tox) (toxCryptoKeys tox) (toxOnion tox)