3 files changed, 156 insertions, 114 deletions
diff --git a/ToxManager.hs b/ToxManager.hs
new file mode 100644
index 00000000..81def17f
--- /dev/null
+++ b/ToxManager.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE CPP            #-}
+{-# LANGUAGE LambdaCase     #-}
+{-# LANGUAGE NamedFieldPuns #-}
+module ToxManager where
+import Announcer
+import Connection
+-- import Control.Concurrent
+import Control.Concurrent.STM
+import Control.Monad
+import Crypto.Tox
+import Data.HashMap.Strict                   as HashMap
+import Data.Maybe
+import qualified Data.Set                    as Set
+import qualified Data.Text                   as T
+import Data.Time.Clock.POSIX
+import Network.Address
+import Network.Kademlia.Routing              as R
+import Network.Kademlia.Search
+import qualified Network.Tox                 as Tox
+import Network.Tox.ContactInfo               as Tox
+import qualified Network.Tox.Crypto.Handlers as Tox
+-- import qualified Network.Tox.DHT.Handlers    as Tox
+import qualified Network.Tox.DHT.Transport   as Tox
+import qualified Network.Tox.Onion.Handlers  as Tox
+import qualified Network.Tox.Onion.Transport as Tox
+import Presence
+import System.IO
+import Text.Read
+import ToxToXMPP
+import XMPPServer                            (ConnectionKey)
+#ifdef THREAD_DEBUG
+import Control.Concurrent.Lifted.Instrument
+#else
+import Control.Concurrent.Lifted
+import GHC.Conc                  (labelThread)
+#endif
+toxAnnounceInterval :: POSIXTime
+toxAnnounceInterval = 15
+toxAnnounceSendData :: Tox.Tox -> PublicKey
+                               -> Nonce32
+                               -> Maybe Tox.NodeInfo
+                               -> IO (Maybe (Tox.Rendezvous, Tox.AnnounceResponse))
+toxAnnounceSendData tox pubkey token = \case
+    Just ni -> Tox.putRendezvous (Tox.onionTimeout tox)
+                                 (Tox.toxCryptoKeys tox)
+                                 (Tox.toxOnion tox)
+                                 (pubkey :: PublicKey)
+                                 (token :: Nonce32)
+                                 ni
+    Nothing -> return Nothing
+toxQSearch :: Tox.Tox -> Search Tox.NodeId (IP, PortNumber) Nonce32 Tox.NodeInfo Tox.Rendezvous
+toxQSearch tox = Tox.toxidSearch (Tox.onionTimeout tox) (Tox.toxCryptoKeys tox) (Tox.toxOnion tox)
+-- |
+--
+-- These hooks will be invoked in order to connect to *.tox hosts in a user's
+-- XMPP roster.
+toxman :: Announcer -> [(String,TVar (BucketList Tox.NodeInfo))] -> Tox.Tox -> PresenceState -> ToxManager ConnectionKey
+toxman announcer toxbkts tox presence = ToxManager
+    { activateAccount        = \k pubname seckey -> do
+        hPutStrLn stderr $ "toxman ACTIVATE " ++ show (Tox.key2id $ toPublic seckey)
+        let ContactInfo{ accounts } = Tox.toxContactInfo tox
+            pub = toPublic seckey
+            pubid = Tox.key2id pub
+        (acnt,newlyActive) <- atomically $ do
+            macnt <- HashMap.lookup pubid <$> readTVar accounts
+            acnt <- maybe (newAccount seckey) return macnt
+            rs <- readTVar $ clientRefs acnt
+            writeTVar (clientRefs acnt) $! Set.insert k rs
+            modifyTVar accounts (HashMap.insert pubid acnt)
+            if not (Set.null rs)
+                then return (acnt,[])
+                else do
+                    fmap ((,) acnt) $ forM toxbkts $ \(nm,bkts) -> do
+                        akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
+                        return (akey,bkts)
+        forM_ newlyActive $ \(akey,bkts) -> do
+            -- Schedule recurring announce.
+            --
+            schedule announcer
+                     akey
+                     (AnnounceMethod (toxQSearch tox)
+                                     (Right $ toxAnnounceSendData tox)
+                                     bkts
+                                     pubid
+                                     toxAnnounceInterval)
+                     pub
+            forkAccountWatcher acnt tox presence
+            return ()
+    , deactivateAccount      = \k pubname -> do
+       hPutStrLn stderr $ "toxman DECTIVATE (todo) 1 " ++ show pubname
+       let ContactInfo{ accounts } = Tox.toxContactInfo tox
+           mpubid = readMaybe $ T.unpack $ T.take 43 pubname
+       bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
+        forM mpubid $ \pubid -> do
+        refs <- do
+            macnt <- HashMap.lookup pubid <$> readTVar accounts
+            rs <- fromMaybe Set.empty <$> mapM (readTVar . clientRefs) macnt
+            forM_ macnt $ \acnt -> do
+                modifyTVar' (clientRefs acnt) $ Set.delete k
+            return rs
+        if (Set.null $ refs Set.\\ Set.singleton k) then do
+            --   TODO
+            --   If this is the last reference to a non-connected contact:
+            --      Stop the recurring search for that contact
+            --
+            -- Stop recurring announce.
+            fmap Just $ forM toxbkts $ \(nm,bkts) -> do
+                akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
+                return (akey,bkts)
+        else return Nothing
+       forM_ bStopped $ \kbkts -> do
+           hPutStrLn stderr $ "toxman DECTIVATE (todo) 3 " ++ show pubname
+           let Just pubid = mpubid
+               pub        = Tox.id2key pubid
+           forM_ kbkts $ \(akey,bkts) -> do
+                cancel announcer
+                     akey
+                     (AnnounceMethod (toxQSearch tox)
+                                     (Right $ toxAnnounceSendData tox)
+                                     bkts
+                                     pubid
+                                     toxAnnounceInterval)
+                     pub
+    , setToxConnectionPolicy = \me them p -> do
+       let m = do meid   <- readMaybe $ T.unpack $ T.take 43 me
+                  themid <- readMaybe $ T.unpack $ T.take 43 them
+                  return $ Tox.Key meid themid
+       hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p,fmap (const ()) m)
+       forM_  m $ \k -> do
+       setPolicy (Tox.toxMgr tox) k p
+       case p of
+        TryingToConnect -> do
+            let db@ContactInfo{ accounts } = Tox.toxContactInfo tox
+            sequence_ $ do
+            let Tox.Key meid themid = k
+            Just $ atomically $ do
+            accs <- readTVar accounts
+            case HashMap.lookup meid accs of
+                Nothing  -> return () -- Unknown account.
+                Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
+            -- If unscheduled and unconnected, schedule recurring search for this contact.
+        _ -> return () -- Remove contact.
+    }
diff --git a/dht-client.cabal b/dht-client.cabal
index 0ac652ce..9dc5ceb9 100644
--- a/dht-client.cabal
+++ b/dht-client.cabal
@@ -141,6 +141,7 @@ library
                    PingMachine
                    Connection
                    ToxToXMPP
+                    ToxManager
  build-depends:      base
                    , containers
diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 56d9544d..28e9f261 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -67,6 +67,7 @@ import System.Posix.Signals
 import Announcer
+import ToxManager
 import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)
 import Network.UPNP as UPNP
 import Network.Address hiding (NodeId, NodeInfo(..))
@@ -1300,120 +1301,6 @@ newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue
    liftIO $ sendit session flush_cyptomessage
-toxAnnounceSendData :: Tox.Tox -> PublicKey
-                               -> Nonce32
-                               -> Maybe Tox.NodeInfo
-                               -> IO (Maybe (Tox.Rendezvous, Tox.AnnounceResponse))
-toxAnnounceSendData tox pubkey token = \case
-    Just ni -> Tox.putRendezvous (Tox.onionTimeout tox)
-                                 (Tox.toxCryptoKeys tox)
-                                 (Tox.toxOnion tox)
-                                 (pubkey :: PublicKey)
-                                 (token :: Nonce32)
-                                 ni
-    Nothing -> return Nothing
-toxQSearch :: Tox.Tox -> Search Tox.NodeId (IP, PortNumber) Nonce32 Tox.NodeInfo Tox.Rendezvous
-toxQSearch tox = Tox.toxidSearch (Tox.onionTimeout tox) (Tox.toxCryptoKeys tox) (Tox.toxOnion tox)
-toxAnnounceInterval :: POSIXTime
-toxAnnounceInterval = 15
-- |
--
-- These hooks will be invoked in order to connect to *.tox hosts in a user's
-- XMPP roster.
-toxman :: Announcer -> [(String,TVar (BucketList Tox.NodeInfo))] -> Tox.Tox -> PresenceState -> ToxManager ConnectionKey
-toxman announcer toxbkts tox presence = ToxManager
-    { activateAccount        = \k pubname seckey -> do
-        hPutStrLn stderr $ "toxman ACTIVATE " ++ show (Tox.key2id $ toPublic seckey)
-        let ContactInfo{ accounts } = Tox.toxContactInfo tox
-            pub = toPublic seckey
-            pubid = Tox.key2id pub
-        (acnt,newlyActive) <- atomically $ do
-            macnt <- HashMap.lookup pubid <$> readTVar accounts
-            acnt <- maybe (newAccount seckey) return macnt
-            rs <- readTVar $ clientRefs acnt
-            writeTVar (clientRefs acnt) $! Set.insert k rs
-            modifyTVar accounts (HashMap.insert pubid acnt)
-            if not (Set.null rs)
-                then return (acnt,[])
-                else do
-                    fmap ((,) acnt) $ forM toxbkts $ \(nm,bkts) -> do
-                        akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
-                        return (akey,bkts)
-        forM_ newlyActive $ \(akey,bkts) -> do
-            -- Schedule recurring announce.
-            --
-            schedule announcer
-                     akey
-                     (AnnounceMethod (toxQSearch tox)
-                                     (Right $ toxAnnounceSendData tox)
-                                     bkts
-                                     pubid
-                                     toxAnnounceInterval)
-                     pub
-            forkAccountWatcher acnt tox presence
-            return ()
-    , deactivateAccount      = \k pubname -> do
-       hPutStrLn stderr $ "toxman DECTIVATE (todo) 1 " ++ show pubname
-       let ContactInfo{ accounts } = Tox.toxContactInfo tox
-           mpubid = readMaybe $ T.unpack $ T.take 43 pubname
-       bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
-        forM mpubid $ \pubid -> do
-        refs <- do
-            macnt <- HashMap.lookup pubid <$> readTVar accounts
-            rs <- fromMaybe Set.empty <$> mapM (readTVar . clientRefs) macnt
-            forM_ macnt $ \acnt -> do
-                modifyTVar' (clientRefs acnt) $ Set.delete k
-            return rs
-        if (Set.null $ refs Set.\\ Set.singleton k) then do
-            --   TODO
-            --   If this is the last reference to a non-connected contact:
-            --      Stop the recurring search for that contact
-            --
-            -- Stop recurring announce.
-            fmap Just $ forM toxbkts $ \(nm,bkts) -> do
-                akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
-                return (akey,bkts)
-        else return Nothing
-       forM_ bStopped $ \kbkts -> do
-           hPutStrLn stderr $ "toxman DECTIVATE (todo) 3 " ++ show pubname
-           let Just pubid = mpubid
-               pub        = Tox.id2key pubid
-           forM_ kbkts $ \(akey,bkts) -> do
-                cancel announcer
-                     akey
-                     (AnnounceMethod (toxQSearch tox)
-                                     (Right $ toxAnnounceSendData tox)
-                                     bkts
-                                     pubid
-                                     toxAnnounceInterval)
-                     pub
-    , setToxConnectionPolicy = \me them p -> do
-       let m = do meid   <- readMaybe $ T.unpack $ T.take 43 me
-                  themid <- readMaybe $ T.unpack $ T.take 43 them
-                  return $ Tox.Key meid themid
-       hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p,fmap (const ()) m)
-       forM_  m $ \k -> do
-       setPolicy (Tox.toxMgr tox) k p
-       case p of
-        TryingToConnect -> do
-            let db@ContactInfo{ accounts } = Tox.toxContactInfo tox
-            sequence_ $ do
-            let Tox.Key meid themid = k
-            Just $ atomically $ do
-            accs <- readTVar accounts
-            case HashMap.lookup meid accs of
-                Nothing  -> return () -- Unknown account.
-                Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
-            -- If unscheduled and unconnected, schedule recurring search for this contact.
-        _ -> return () -- Remove contact.
-    }
 -- | Called upon a new Tox friend-connection session with a remote peer in
 -- order to set up translating conduits that simulate a remote XMPP server.
 announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.

diff --git a/ToxManager.hs b/ToxManager.hs new file mode 100644 index 00000000..81def17f --- /dev/null +++ b/ToxManager.hs
@@ -0,0 +1,154 @@
		1	{-# LANGUAGE CPP #-}
		2	{-# LANGUAGE LambdaCase #-}
		3	{-# LANGUAGE NamedFieldPuns #-}
		4	module ToxManager where
		5
		6	import Announcer
		7	import Connection
		8	-- import Control.Concurrent
		9	import Control.Concurrent.STM
		10	import Control.Monad
		11	import Crypto.Tox
		12	import Data.HashMap.Strict as HashMap
		13	import Data.Maybe
		14	import qualified Data.Set as Set
		15	import qualified Data.Text as T
		16	import Data.Time.Clock.POSIX
		17	import Network.Address
		18	import Network.Kademlia.Routing as R
		19	import Network.Kademlia.Search
		20	import qualified Network.Tox as Tox
		21	import Network.Tox.ContactInfo as Tox
		22	import qualified Network.Tox.Crypto.Handlers as Tox
		23	-- import qualified Network.Tox.DHT.Handlers as Tox
		24	import qualified Network.Tox.DHT.Transport as Tox
		25	import qualified Network.Tox.Onion.Handlers as Tox
		26	import qualified Network.Tox.Onion.Transport as Tox
		27	import Presence
		28	import System.IO
		29	import Text.Read
		30	import ToxToXMPP
		31	import XMPPServer (ConnectionKey)
		32
		33	#ifdef THREAD_DEBUG
		34	import Control.Concurrent.Lifted.Instrument
		35	#else
		36	import Control.Concurrent.Lifted
		37	import GHC.Conc (labelThread)
		38	#endif
		39
		40	toxAnnounceInterval :: POSIXTime
		41	toxAnnounceInterval = 15
		42
		43	toxAnnounceSendData :: Tox.Tox -> PublicKey
		44	-> Nonce32
		45	-> Maybe Tox.NodeInfo
		46	-> IO (Maybe (Tox.Rendezvous, Tox.AnnounceResponse))
		47	toxAnnounceSendData tox pubkey token = \case
		48	Just ni -> Tox.putRendezvous (Tox.onionTimeout tox)
		49	(Tox.toxCryptoKeys tox)
		50	(Tox.toxOnion tox)
		51	(pubkey :: PublicKey)
		52	(token :: Nonce32)
		53	ni
		54	Nothing -> return Nothing
		55
		56
		57	toxQSearch :: Tox.Tox -> Search Tox.NodeId (IP, PortNumber) Nonce32 Tox.NodeInfo Tox.Rendezvous
		58	toxQSearch tox = Tox.toxidSearch (Tox.onionTimeout tox) (Tox.toxCryptoKeys tox) (Tox.toxOnion tox)
		59
		60	-- \|
		61	--
		62	-- These hooks will be invoked in order to connect to *.tox hosts in a user's
		63	-- XMPP roster.
		64	toxman :: Announcer -> [(String,TVar (BucketList Tox.NodeInfo))] -> Tox.Tox -> PresenceState -> ToxManager ConnectionKey
		65	toxman announcer toxbkts tox presence = ToxManager
		66	{ activateAccount = \k pubname seckey -> do
		67	hPutStrLn stderr $ "toxman ACTIVATE " ++ show (Tox.key2id $ toPublic seckey)
		68	let ContactInfo{ accounts } = Tox.toxContactInfo tox
		69	pub = toPublic seckey
		70	pubid = Tox.key2id pub
		71	(acnt,newlyActive) <- atomically $ do
		72	macnt <- HashMap.lookup pubid <$> readTVar accounts
		73	acnt <- maybe (newAccount seckey) return macnt
		74	rs <- readTVar $ clientRefs acnt
		75	writeTVar (clientRefs acnt) $! Set.insert k rs
		76	modifyTVar accounts (HashMap.insert pubid acnt)
		77	if not (Set.null rs)
		78	then return (acnt,[])
		79	else do
		80	fmap ((,) acnt) $ forM toxbkts $ \(nm,bkts) -> do
		81	akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
		82	return (akey,bkts)
		83	forM_ newlyActive $ \(akey,bkts) -> do
		84	-- Schedule recurring announce.
		85	--
		86	schedule announcer
		87	akey
		88	(AnnounceMethod (toxQSearch tox)
		89	(Right $ toxAnnounceSendData tox)
		90	bkts
		91	pubid
		92	toxAnnounceInterval)
		93	pub
		94
		95	forkAccountWatcher acnt tox presence
		96	return ()
		97
		98	, deactivateAccount = \k pubname -> do
		99	hPutStrLn stderr $ "toxman DECTIVATE (todo) 1 " ++ show pubname
		100	let ContactInfo{ accounts } = Tox.toxContactInfo tox
		101	mpubid = readMaybe $ T.unpack $ T.take 43 pubname
		102	bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
		103	forM mpubid $ \pubid -> do
		104	refs <- do
		105	macnt <- HashMap.lookup pubid <$> readTVar accounts
		106	rs <- fromMaybe Set.empty <$> mapM (readTVar . clientRefs) macnt
		107	forM_ macnt $ \acnt -> do
		108	modifyTVar' (clientRefs acnt) $ Set.delete k
		109	return rs
		110	if (Set.null $ refs Set.\\ Set.singleton k) then do
		111	-- TODO
		112	-- If this is the last reference to a non-connected contact:
		113	-- Stop the recurring search for that contact
		114	--
		115	-- Stop recurring announce.
		116	fmap Just $ forM toxbkts $ \(nm,bkts) -> do
		117	akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
		118	return (akey,bkts)
		119	else return Nothing
		120	forM_ bStopped $ \kbkts -> do
		121	hPutStrLn stderr $ "toxman DECTIVATE (todo) 3 " ++ show pubname
		122	let Just pubid = mpubid
		123	pub = Tox.id2key pubid
		124	forM_ kbkts $ \(akey,bkts) -> do
		125	cancel announcer
		126	akey
		127	(AnnounceMethod (toxQSearch tox)
		128	(Right $ toxAnnounceSendData tox)
		129	bkts
		130	pubid
		131	toxAnnounceInterval)
		132	pub
		133
		134	, setToxConnectionPolicy = \me them p -> do
		135	let m = do meid <- readMaybe $ T.unpack $ T.take 43 me
		136	themid <- readMaybe $ T.unpack $ T.take 43 them
		137	return $ Tox.Key meid themid
		138	hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p,fmap (const ()) m)
		139	forM_ m $ \k -> do
		140	setPolicy (Tox.toxMgr tox) k p
		141	case p of
		142	TryingToConnect -> do
		143	let db@ContactInfo{ accounts } = Tox.toxContactInfo tox
		144	sequence_ $ do
		145	let Tox.Key meid themid = k
		146	Just $ atomically $ do
		147	accs <- readTVar accounts
		148	case HashMap.lookup meid accs of
		149	Nothing -> return () -- Unknown account.
		150	Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
		151	-- If unscheduled and unconnected, schedule recurring search for this contact.
		152	_ -> return () -- Remove contact.
		153	}
		154


diff --git a/dht-client.cabal b/dht-client.cabal index 0ac652ce..9dc5ceb9 100644 --- a/dht-client.cabal +++ b/dht-client.cabal
@@ -141,6 +141,7 @@ library
141	PingMachine	141	PingMachine
142	Connection	142	Connection
143	ToxToXMPP	143	ToxToXMPP
		144	ToxManager
144		145
145	build-depends: base	146	build-depends: base
146	, containers	147	, containers


diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 56d9544d..28e9f261 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs
@@ -67,6 +67,7 @@ import System.Posix.Signals
67		67
68		68
69	import Announcer	69	import Announcer
		70	import ToxManager
70	import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)	71	import Crypto.Tox -- (zeros32,SecretKey,PublicKey, generateSecretKey, toPublic, encodeSecret, decodeSecret, userKeys)
71	import Network.UPNP as UPNP	72	import Network.UPNP as UPNP
72	import Network.Address hiding (NodeId, NodeInfo(..))	73	import Network.Address hiding (NodeId, NodeInfo(..))
@@ -1300,120 +1301,6 @@ newXmmpSink session@(Tox.NCrypto { ncOutgoingQueue = outGoingQVar, ncPacketQueue
1300	liftIO $ sendit session flush_cyptomessage	1301	liftIO $ sendit session flush_cyptomessage
1301		1302
1302		1303
1303	toxAnnounceSendData :: Tox.Tox -> PublicKey
1304	-> Nonce32
1305	-> Maybe Tox.NodeInfo
1306	-> IO (Maybe (Tox.Rendezvous, Tox.AnnounceResponse))
1307	toxAnnounceSendData tox pubkey token = \case
1308	Just ni -> Tox.putRendezvous (Tox.onionTimeout tox)
1309	(Tox.toxCryptoKeys tox)
1310	(Tox.toxOnion tox)
1311	(pubkey :: PublicKey)
1312	(token :: Nonce32)
1313	ni
1314	Nothing -> return Nothing
1315
1316	toxQSearch :: Tox.Tox -> Search Tox.NodeId (IP, PortNumber) Nonce32 Tox.NodeInfo Tox.Rendezvous
1317	toxQSearch tox = Tox.toxidSearch (Tox.onionTimeout tox) (Tox.toxCryptoKeys tox) (Tox.toxOnion tox)
1318
1319	toxAnnounceInterval :: POSIXTime
1320	toxAnnounceInterval = 15
1321
1322	-- \|
1323	--
1324	-- These hooks will be invoked in order to connect to *.tox hosts in a user's
1325	-- XMPP roster.
1326	toxman :: Announcer -> [(String,TVar (BucketList Tox.NodeInfo))] -> Tox.Tox -> PresenceState -> ToxManager ConnectionKey
1327	toxman announcer toxbkts tox presence = ToxManager
1328	{ activateAccount = \k pubname seckey -> do
1329	hPutStrLn stderr $ "toxman ACTIVATE " ++ show (Tox.key2id $ toPublic seckey)
1330	let ContactInfo{ accounts } = Tox.toxContactInfo tox
1331	pub = toPublic seckey
1332	pubid = Tox.key2id pub
1333	(acnt,newlyActive) <- atomically $ do
1334	macnt <- HashMap.lookup pubid <$> readTVar accounts
1335	acnt <- maybe (newAccount seckey) return macnt
1336	rs <- readTVar $ clientRefs acnt
1337	writeTVar (clientRefs acnt) $! Set.insert k rs
1338	modifyTVar accounts (HashMap.insert pubid acnt)
1339	if not (Set.null rs)
1340	then return (acnt,[])
1341	else do
1342	fmap ((,) acnt) $ forM toxbkts $ \(nm,bkts) -> do
1343	akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
1344	return (akey,bkts)
1345	forM_ newlyActive $ \(akey,bkts) -> do
1346	-- Schedule recurring announce.
1347	--
1348	schedule announcer
1349	akey
1350	(AnnounceMethod (toxQSearch tox)
1351	(Right $ toxAnnounceSendData tox)
1352	bkts
1353	pubid
1354	toxAnnounceInterval)
1355	pub
1356
1357	forkAccountWatcher acnt tox presence
1358	return ()
1359
1360	, deactivateAccount = \k pubname -> do
1361	hPutStrLn stderr $ "toxman DECTIVATE (todo) 1 " ++ show pubname
1362	let ContactInfo{ accounts } = Tox.toxContactInfo tox
1363	mpubid = readMaybe $ T.unpack $ T.take 43 pubname
1364	bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
1365	forM mpubid $ \pubid -> do
1366	refs <- do
1367	macnt <- HashMap.lookup pubid <$> readTVar accounts
1368	rs <- fromMaybe Set.empty <$> mapM (readTVar . clientRefs) macnt
1369	forM_ macnt $ \acnt -> do
1370	modifyTVar' (clientRefs acnt) $ Set.delete k
1371	return rs
1372	if (Set.null $ refs Set.\\ Set.singleton k) then do
1373	-- TODO
1374	-- If this is the last reference to a non-connected contact:
1375	-- Stop the recurring search for that contact
1376	--
1377	-- Stop recurring announce.
1378	fmap Just $ forM toxbkts $ \(nm,bkts) -> do
1379	akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid)
1380	return (akey,bkts)
1381	else return Nothing
1382	forM_ bStopped $ \kbkts -> do
1383	hPutStrLn stderr $ "toxman DECTIVATE (todo) 3 " ++ show pubname
1384	let Just pubid = mpubid
1385	pub = Tox.id2key pubid
1386	forM_ kbkts $ \(akey,bkts) -> do
1387	cancel announcer
1388	akey
1389	(AnnounceMethod (toxQSearch tox)
1390	(Right $ toxAnnounceSendData tox)
1391	bkts
1392	pubid
1393	toxAnnounceInterval)
1394	pub
1395
1396	, setToxConnectionPolicy = \me them p -> do
1397	let m = do meid <- readMaybe $ T.unpack $ T.take 43 me
1398	themid <- readMaybe $ T.unpack $ T.take 43 them
1399	return $ Tox.Key meid themid
1400	hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p,fmap (const ()) m)
1401	forM_ m $ \k -> do
1402	setPolicy (Tox.toxMgr tox) k p
1403	case p of
1404	TryingToConnect -> do
1405	let db@ContactInfo{ accounts } = Tox.toxContactInfo tox
1406	sequence_ $ do
1407	let Tox.Key meid themid = k
1408	Just $ atomically $ do
1409	accs <- readTVar accounts
1410	case HashMap.lookup meid accs of
1411	Nothing -> return () -- Unknown account.
1412	Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
1413	-- If unscheduled and unconnected, schedule recurring search for this contact.
1414	_ -> return () -- Remove contact.
1415	}
1416
1417	-- \| Called upon a new Tox friend-connection session with a remote peer in	1304	-- \| Called upon a new Tox friend-connection session with a remote peer in
1418	-- order to set up translating conduits that simulate a remote XMPP server.	1305	-- order to set up translating conduits that simulate a remote XMPP server.
1419	announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.	1306	announceToxJabberPeer :: PublicKey -- ^ Remote tox node's long-term user key.