summaryrefslogtreecommitdiff
path: root/src/Network/Tox.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox.hs')
-rw-r--r--src/Network/Tox.hs34
1 files changed, 24 insertions, 10 deletions
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 00dfcf9f..d81ed1e3 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -389,6 +389,17 @@ newTox :: TVar Onion.AnnouncedKeys -- ^ Store of announced keys we are a rende
389 -> IO (Tox extra) 389 -> IO (Tox extra)
390newTox keydb addr mbSessionsState suppliedDHTKey = do 390newTox keydb addr mbSessionsState suppliedDHTKey = do
391 (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr 391 (udp,sock) <- {- addVerbosity <$> -} udpTransport' addr
392 tox <- newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp
393 return tox { toxAnnounceToLan = announceToLan sock (key2id $ transportPublic $ toxCryptoKeys tox) }
394
395-- | This version of 'newTox' is useful for automated tests using 'testPairTransport'.
396newToxOverTransport :: TVar Onion.AnnouncedKeys
397 -> SockAddr
398 -> Maybe NetCryptoSessions
399 -> Maybe SecretKey
400 -> Onion.UDPTransport
401 -> IO (Tox extra)
402newToxOverTransport keydb addr mbSessionsState suppliedDHTKey udp = do
392 roster <- newContactInfo 403 roster <- newContactInfo
393 (crypto0,sessionsState0) <- case mbSessionsState of 404 (crypto0,sessionsState0) <- case mbSessionsState of
394 Nothing -> do 405 Nothing -> do
@@ -475,7 +486,7 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
475 , toxAnnouncedKeys = keydb 486 , toxAnnouncedKeys = keydb
476 , toxOnionRoutes = orouter 487 , toxOnionRoutes = orouter
477 , toxContactInfo = roster 488 , toxContactInfo = roster
478 , toxAnnounceToLan = announceToLan sock (key2id $ transportPublic crypto) 489 , toxAnnounceToLan = return ()
479 , toxMgr = mgr 490 , toxMgr = mgr
480 } 491 }
481 492
@@ -501,21 +512,24 @@ dnssdDiscover tox ni toxid = do
501 512
502 void $ DHT.ping (toxDHT tox) ni 513 void $ DHT.ping (toxDHT tox) ni
503 514
504forkTox :: Tox extra -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ()) 515forkTox :: Tox extra -> Bool -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ())
505forkTox tox = do 516forkTox tox with_avahi = do
506 _ <- forkListener "toxHandshakes" (toxHandshakes tox) 517 _ <- forkListener "toxHandshakes" (toxHandshakes tox)
507 _ <- forkListener "toxToRoute" (toxToRoute tox) 518 _ <- forkListener "toxToRoute" (toxToRoute tox)
508 _ <- forkListener "toxOnion" (clientNet $ toxOnion tox) 519 _ <- forkListener "toxOnion" (clientNet $ toxOnion tox)
509 _ <- forkListener "toxDHT" (clientNet $ toxDHT tox) 520 _ <- forkListener "toxDHT" (clientNet $ toxDHT tox)
510 quit <- forkListener "toxCrypto" (toxCrypto tox) 521 quit <- forkListener "toxCrypto" (toxCrypto tox)
511 forkPollForRefresh (DHT.refresher4 $ toxRouting tox) 522 quitAvahi <- if with_avahi then do
512 forkPollForRefresh (DHT.refresher6 $ toxRouting tox) 523 forkPollForRefresh (DHT.refresher4 $ toxRouting tox)
513 dnssdIn <- forkIO $ queryToxService (dnssdDiscover tox) 524 forkPollForRefresh (DHT.refresher6 $ toxRouting tox)
514 dnssdOut <- forkIO $ dnssdAnnounce tox 525 dnssdIn <- forkIO $ queryToxService (dnssdDiscover tox)
515 labelThread dnssdIn "tox-avahi-monitor" 526 dnssdOut <- forkIO $ dnssdAnnounce tox
516 labelThread dnssdOut "tox-avahi-publish" 527 labelThread dnssdIn "tox-avahi-monitor"
528 labelThread dnssdOut "tox-avahi-publish"
529 return $ forM_ [dnssdIn,dnssdOut] killThread
530 else return $ return ()
517 keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox) 531 keygc <- Onion.forkAnnouncedKeysGC (toxAnnouncedKeys tox)
518 return ( forM_ [dnssdIn, dnssdOut, keygc] killThread >> quit 532 return ( quitAvahi >> killThread keygc >> quit
519 , bootstrap (DHT.refresher4 $ toxRouting tox) 533 , bootstrap (DHT.refresher4 $ toxRouting tox)
520 , bootstrap (DHT.refresher6 $ toxRouting tox) 534 , bootstrap (DHT.refresher6 $ toxRouting tox)
521 ) 535 )