testTox now simulates netCrypto session

1 files changed, 33 insertions, 2 deletions

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