tox: Node-address notifications.

1 files changed, 28 insertions, 6 deletions

diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index e6986bf4..2bce382a 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -30,6 +30,8 @@ import Control.Concurrent.STM
 import Data.Time.Clock.POSIX  (POSIXTime, getPOSIXTime)
 import Network.Socket
 import Data.Hashable
+import qualified Data.HashMap.Strict as HashMap
+         ;import Data.HashMap.Strict (HashMap)
 import Data.IP
 import Data.Ord
 import Data.Maybe
@@ -112,12 +114,20 @@ classify client msg = fromMaybe (IsUnknown "unknown")
     go (DHTCookie        {}) = IsResponse
     go (DHTDHTRequest    {}) = IsQuery DHTRequestType
 
+data NodeInfoCallback = NodeInfoCallback
+    { interestingNodeId :: NodeId
+    , listenerId        :: Int
+    , observedAddress   :: NodeInfo -> STM ()
+    , rumoredAddress    :: SockAddr -> NodeInfo -> STM ()
+    }
+
 data Routing = Routing
-    { tentativeId :: NodeInfo
-    , committee4  :: TriadCommittee NodeId SockAddr
-    , committee6  :: TriadCommittee NodeId SockAddr
-    , refresher4  :: BucketRefresher NodeId NodeInfo
-    , refresher6  :: BucketRefresher NodeId NodeInfo
+    { tentativeId     :: NodeInfo
+    , committee4      :: TriadCommittee NodeId SockAddr
+    , committee6      :: TriadCommittee NodeId SockAddr
+    , refresher4      :: BucketRefresher NodeId NodeInfo
+    , refresher6      :: BucketRefresher NodeId NodeInfo
+    , nodesOfInterest :: TVar (HashMap NodeId [NodeInfoCallback])
     }
 
 sched4 :: Routing -> TVar (Int.PSQ POSIXTime)
@@ -166,10 +176,17 @@ newRouting addr crypto update4 update6 = do
             tbl6 = refreshBuckets refresher6
         committee4 <- newTriadCommittee (update4 tbl4) -- updateIPVote tbl4 addr4
         committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6
+        cbvar <- newTVar HashMap.empty
         return $ \client ->
             -- Now we have a client, so tell the BucketRefresher how to search and ping.
             let updIO r = updateRefresherIO (nodeSearch client) (ping client) r
-            in Routing tentative_info committee4 committee6 (updIO refresher4) (updIO refresher6)
+            in Routing { tentativeId     = tentative_info
+                       , committee4      = committee4
+                       , committee6      = committee6
+                       , refresher4      = updIO refresher4
+                       , refresher6      = updIO refresher6
+                       , nodesOfInterest = cbvar
+                       }
 
 
 -- TODO: This should cover more cases
@@ -370,6 +387,11 @@ updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO (
 updateRouting client routing orouter naddr msg
     | PacketKind 0x21 <- msgType msg = hPutStrLn stderr "(tox)updateRouting: ignoring lan discovery" -- ignore lan discovery
     | otherwise                      = do
+    atomically $ do
+        m <- HashMap.lookup (nodeId naddr) <$> readTVar (nodesOfInterest routing)
+        forM_ m $ mapM_ $ \NodeInfoCallback{interestingNodeId,observedAddress} -> do
+            when (interestingNodeId == nodeId naddr)
+                $ observedAddress naddr
     case prefer4or6 naddr Nothing of
         Want_IP4 -> updateTable client naddr orouter (committee4 routing) (refresher4 routing)
         Want_IP6 -> updateTable client naddr orouter (committee6 routing) (refresher6 routing)