tox: mechanism to register node-info callbacks.

1 files changed, 22 insertions, 0 deletions

diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index 25244a9b..091374f5 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -130,6 +130,28 @@ data Routing = Routing
     , nodesOfInterest :: TVar (HashMap NodeId [NodeInfoCallback])
     }
 
+registerNodeCallback :: Routing -> NodeInfoCallback -> STM ()
+registerNodeCallback Routing{nodesOfInterest} cb = do
+    cbm <- readTVar nodesOfInterest
+    let ns = fromMaybe [] $ HashMap.lookup (interestingNodeId cb) cbm
+        bs = filter nonMatching ns
+                    where nonMatching n = (listenerId n /= listenerId cb)
+    writeTVar nodesOfInterest $ HashMap.insert (interestingNodeId cb)
+                                               (cb : bs)
+                                               cbm
+
+unregisterNodeCallback :: Int -> Routing -> NodeId -> STM ()
+unregisterNodeCallback callbackId Routing{nodesOfInterest} nid = do
+    cbm <- readTVar nodesOfInterest
+    let ns = fromMaybe [] $ HashMap.lookup nid cbm
+        bs = filter nonMatching ns
+                    where nonMatching n = (listenerId n /= callbackId)
+    writeTVar nodesOfInterest
+        $ if null bs
+            then HashMap.delete nid cbm
+            else HashMap.insert nid bs cbm
+
+
 sched4 :: Routing -> TVar (Int.PSQ POSIXTime)
 sched4 Routing { refresher4 = BucketRefresher { refreshQueue } } = refreshQueue