diff options
-rw-r--r-- | Announcer.hs | 3 | ||||
-rw-r--r-- | examples/dhtd.hs | 35 |
2 files changed, 30 insertions, 8 deletions
diff --git a/Announcer.hs b/Announcer.hs index 72d70a1e..c66d26b4 100644 --- a/Announcer.hs +++ b/Announcer.hs | |||
@@ -40,6 +40,9 @@ import qualified GHC.Generics as Generics | |||
40 | newtype AnnounceKey = AnnounceKey ByteString | 40 | newtype AnnounceKey = AnnounceKey ByteString |
41 | deriving (Hashable,Ord,Eq) | 41 | deriving (Hashable,Ord,Eq) |
42 | 42 | ||
43 | instance Show AnnounceKey where | ||
44 | show (AnnounceKey bs) = "AnnounceKey " ++ show (Char8.unpack bs) | ||
45 | |||
43 | packAnnounceKey :: Announcer -> String -> STM AnnounceKey | 46 | packAnnounceKey :: Announcer -> String -> STM AnnounceKey |
44 | packAnnounceKey _ = return . AnnounceKey . Char8.pack | 47 | packAnnounceKey _ = return . AnnounceKey . Char8.pack |
45 | 48 | ||
diff --git a/examples/dhtd.hs b/examples/dhtd.hs index 27e3c4ef..b24a90fb 100644 --- a/examples/dhtd.hs +++ b/examples/dhtd.hs | |||
@@ -1453,10 +1453,12 @@ toxman announcer toxbkts tox presence = ToxManager | |||
1453 | 1453 | ||
1454 | forkAccountWatcher acnt tox presence | 1454 | forkAccountWatcher acnt tox presence |
1455 | return () | 1455 | return () |
1456 | |||
1456 | , deactivateAccount = \k pubname -> do | 1457 | , deactivateAccount = \k pubname -> do |
1457 | bStopped <- fmap (fromMaybe False) $ atomically $ do | 1458 | hPutStrLn stderr $ "toxman DECTIVATE (todo) 1 " ++ show pubname |
1458 | let ContactInfo{ accounts } = Tox.toxContactInfo tox | 1459 | let ContactInfo{ accounts } = Tox.toxContactInfo tox |
1459 | mpubid = readMaybe $ T.unpack $ T.take 43 pubname | 1460 | mpubid = readMaybe $ T.unpack $ T.take 43 pubname |
1461 | bStopped <- fmap (fromMaybe Nothing) $ atomically $ do | ||
1460 | forM mpubid $ \pubid -> do | 1462 | forM mpubid $ \pubid -> do |
1461 | refs <- do | 1463 | refs <- do |
1462 | macnt <- HashMap.lookup pubid <$> readTVar accounts | 1464 | macnt <- HashMap.lookup pubid <$> readTVar accounts |
@@ -1464,13 +1466,30 @@ toxman announcer toxbkts tox presence = ToxManager | |||
1464 | forM_ macnt $ \acnt -> do | 1466 | forM_ macnt $ \acnt -> do |
1465 | modifyTVar' (clientRefs acnt) $ Set.delete k | 1467 | modifyTVar' (clientRefs acnt) $ Set.delete k |
1466 | return rs | 1468 | return rs |
1467 | if (not $ Set.null $ refs Set.\\ Set.singleton k) then do | 1469 | if (Set.null $ refs Set.\\ Set.singleton k) then do |
1468 | -- Stop recurring announce. | 1470 | -- TODO |
1469 | -- If this is the last reference to a non-connected contact: | 1471 | -- If this is the last reference to a non-connected contact: |
1470 | -- Stop the recurring search for that contact | 1472 | -- Stop the recurring search for that contact |
1471 | return True | 1473 | -- |
1472 | else return False | 1474 | -- Stop recurring announce. |
1473 | when bStopped $ hPutStrLn stderr $ "toxman DECTIVATE (todo) " ++ show pubname | 1475 | fmap Just $ forM toxbkts $ \(nm,bkts) -> do |
1476 | akey <- packAnnounceKey announcer (nm ++ "id:" ++ show pubid) | ||
1477 | return (akey,bkts) | ||
1478 | else return Nothing | ||
1479 | forM_ bStopped $ \kbkts -> do | ||
1480 | hPutStrLn stderr $ "toxman DECTIVATE (todo) 3 " ++ show pubname | ||
1481 | let Just pubid = mpubid | ||
1482 | pub = Tox.id2key pubid | ||
1483 | forM_ kbkts $ \(akey,bkts) -> do | ||
1484 | cancel announcer | ||
1485 | akey | ||
1486 | (AnnounceMethod (toxQSearch tox) | ||
1487 | (Right $ toxAnnounceSendData tox) | ||
1488 | bkts | ||
1489 | pubid | ||
1490 | toxAnnounceInterval) | ||
1491 | pub | ||
1492 | |||
1474 | , setToxConnectionPolicy = \me them p -> do | 1493 | , setToxConnectionPolicy = \me them p -> do |
1475 | hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p) | 1494 | hPutStrLn stderr $ "toxman ConnectionPolicy " ++ show (me,them,p) |
1476 | case p of | 1495 | case p of |