summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Announcer.hs3
-rw-r--r--examples/dhtd.hs35
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
40newtype AnnounceKey = AnnounceKey ByteString 40newtype AnnounceKey = AnnounceKey ByteString
41 deriving (Hashable,Ord,Eq) 41 deriving (Hashable,Ord,Eq)
42 42
43instance Show AnnounceKey where
44 show (AnnounceKey bs) = "AnnounceKey " ++ show (Char8.unpack bs)
45
43packAnnounceKey :: Announcer -> String -> STM AnnounceKey 46packAnnounceKey :: Announcer -> String -> STM AnnounceKey
44packAnnounceKey _ = return . AnnounceKey . Char8.pack 47packAnnounceKey _ = 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