From af9a5df9b6c5fff2820cdeae6ac34a0206051c98 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Wed, 27 Jun 2018 03:31:02 +0000 Subject: testTox now simulates netCrypto session --- examples/testTox.hs | 35 +++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) (limited to 'examples/testTox.hs') diff --git a/examples/testTox.hs b/examples/testTox.hs index 531841be..a58c1fa0 100644 --- a/examples/testTox.hs +++ b/examples/testTox.hs @@ -1,10 +1,16 @@ {-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -import Control.Concurrent (threadDelay) +#ifdef THREAD_DEBUG +import Control.Concurrent.Lifted.Instrument +#else +import Control.Concurrent.Lifted +#endif import Control.Concurrent.STM.TChan import Control.Concurrent.STM.TMChan import Control.Concurrent.STM.TVar import Control.Concurrent.Supply +import Control.Monad import Control.Monad.STM import Crypto.Tox import qualified Data.IntMap.Strict as IntMap @@ -19,6 +25,11 @@ import Network.Tox.Crypto.Transport import Network.Tox.DHT.Handlers as DHT import Network.Tox.DHT.Transport import Network.Tox.Onion.Transport +import Connection +import qualified Data.HashMap.Strict as HashMap + ;import Data.HashMap.Strict (HashMap) +import Data.Time.Clock.POSIX +import System.Exit makeToxNode :: UDPTransport -> Maybe SecretKey -> IO (Tox extra) @@ -77,6 +88,21 @@ main = do threadReport False >>= putStrLn + [(a_secret,a_public)] <- atomically (userKeys (toxCryptoKeys a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf)) + [(_,b_public)] <- atomically (userKeys (toxCryptoKeys b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk)) + mbAccount <- atomically $ do + accs <- readTVar (accounts $ toxContactInfo a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) + return $ HashMap.lookup (key2id a_public) accs + now <- getPOSIXTime + case mbAccount of + Just account -> atomically $ do + setContactPolicy b_public TryingToConnect account + setContactAddr now b_public b account + Nothing -> dput XUnused "MISSING Account!" + + dput XUnused $ "a_public = " ++ show (key2id a_public) + dput XUnused $ "BDD... = " ++ show (read "BDDj3maMmK8hR3mTpju29wmtE2YJ5cf8NlNEWi1dXlI":: NodeId) + -- Tell /a/ about /b/'s DHT-key. updateContactInfo (toxContactInfo a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) (AnnouncedRendezvous (id2key $ read "AvETKhO-YqnNRopZrj8K3xUpGtGbX0sLhZZjh2VufJB") -- b toxid @@ -91,9 +117,14 @@ main = do DHT.ping (toxDHT a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) b - -- sendMessage (toxHandshakes a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf) (nodeAddr b) hs + (b_quit,_,_) <- forkTox b_OM7znaPMYkTbm'9GcZJAdnDATXmZxZ9fnaSTP3qNCZk False + + forkIO $ do + tid <- myThreadId + labelThread tid "testToxLaunch" + void $ netCrypto a_Ct7g5azVcJ8KnvxzbXs9GqeqcjrP7VdZXIC'uHeTlRf a_secret b_public putStrLn "Type Enter to quit..." getLine -- cgit v1.2.3