From 8cca6e0577d127d8de1624e31a7a47dca74e2ada Mon Sep 17 00:00:00 2001
From: joe <joe@jerkface.net>
Date: Tue, 26 Jun 2018 07:56:02 -0400
Subject: testTox: a pair of simulated tox nodes.

---
 src/Network/Tox.hs | 34 ++++++++++++++++++++++++----------
 1 file changed, 24 insertions(+), 10 deletions(-)

(limited to 'src')

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
        -> 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
@@ -475,7 +486,7 @@ newTox keydb addr mbSessionsState suppliedDHTKey = do
         , toxAnnouncedKeys  = keydb
         , toxOnionRoutes    = orouter
         , toxContactInfo    = roster
-        , toxAnnounceToLan  = announceToLan sock (key2id $ transportPublic crypto)
+        , toxAnnounceToLan  = return ()
         , toxMgr            = mgr
         }
 
@@ -501,21 +512,24 @@ dnssdDiscover tox ni toxid = do
 
   void $ DHT.ping (toxDHT tox) ni
 
-forkTox :: Tox extra -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ())
-forkTox tox = do
+forkTox :: Tox extra -> Bool -> IO (IO (), [NodeInfo] -> [NodeInfo] -> IO (), [NodeInfo] -> [NodeInfo] -> IO ())
+forkTox tox with_avahi = do
     _ <- forkListener "toxHandshakes" (toxHandshakes tox)
     _ <- forkListener "toxToRoute" (toxToRoute tox)
     _ <- forkListener "toxOnion" (clientNet $ toxOnion tox)
     _ <- forkListener "toxDHT" (clientNet $ toxDHT tox)
     quit <- forkListener "toxCrypto" (toxCrypto tox)
-    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"
+    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 ( forM_ [dnssdIn, dnssdOut, keygc] killThread >> quit
+    return ( quitAvahi >> killThread keygc >> quit
            , bootstrap (DHT.refresher4 $ toxRouting tox)
            , bootstrap (DHT.refresher6 $ toxRouting tox)
            )
-- 
cgit v1.2.3