Added external IP address voting for Mainline DHT.

1 files changed, 26 insertions, 10 deletions

diff --git a/Mainline.hs b/Mainline.hs
index 84fe96bf..17fb32ee 100644
--- a/Mainline.hs
+++ b/Mainline.hs
@@ -268,7 +268,9 @@ type RoutingInfo = Info NodeInfo NodeId
 data Routing = Routing
     { tentativeId :: NodeInfo
     , routing4 :: !( TVar (R.BucketList NodeInfo) )
+    , committee4 :: TriadCommittee NodeId SockAddr
     , routing6 :: !( TVar (R.BucketList NodeInfo) )
+    , committee6 :: TriadCommittee NodeId SockAddr
     }
 
 type MainlineClient = Client String Method TransactionId NodeInfo (Message BValue)
@@ -286,7 +288,9 @@ newClient addr = do
         let nobkts = R.defaultBucketCount :: Int
         tbl4 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts
         tbl6 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts
-        return $ Routing tenative_info tbl4 tbl6
+        committee4 <- newTriadCommittee (const $ return ()) -- TODO: update tbl4
+        committee6 <- newTriadCommittee (const $ return ()) -- TODO: update tbl6
+        return $ Routing tenative_info tbl4 committee4 tbl6 committee6
     swarms <- newSwarmsDatabase
     map_var <- atomically $ newTVar (0, mempty)
     let net = onInbound (updateRouting outgoingClient routing)
@@ -338,10 +342,13 @@ defaultHandler meth = MethodHandler decodePayload errorPayload returnError
     returnError :: NodeInfo -> BValue -> IO Error
     returnError _ _ = return $ Error MethodUnknown ("Unknown method " <> meth)
 
-mainlineKademlia :: MainlineClient -> TVar (R.BucketList NodeInfo) ->  Kademlia NodeId NodeInfo
-mainlineKademlia client var = Kademlia quietInsertions
-                                       mainlineSpace
-                                       (vanillaIO var $ ping client)
+mainlineKademlia :: MainlineClient -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) ->  Kademlia NodeId NodeInfo
+mainlineKademlia client committee var
+    = Kademlia quietInsertions
+               mainlineSpace
+               (vanillaIO var $ ping client)
+                   { tblTransition = transitionCommittee committee }
+
 
 mainlineSpace :: R.KademliaSpace NodeId NodeInfo
 mainlineSpace = R.KademliaSpace
@@ -350,14 +357,23 @@ mainlineSpace = R.KademliaSpace
     , R.kademliaXor      = xor
     }
 
+transitionCommittee :: TriadCommittee NodeId SockAddr -> RoutingTransition NodeInfo -> STM (IO ())
+transitionCommittee committee (RoutingTransition ni Stranger) = do
+    delVote committee (nodeId ni)
+    return $ return ()
 
 updateRouting :: MainlineClient -> Routing -> NodeInfo -> Message BValue -> IO ()
-updateRouting client routing naddr _ = do
+updateRouting client routing naddr msg = do
     case prefer4or6 naddr Nothing of
-        Want_IP4 -> insertNode (mainlineKademlia client $ routing4 routing) naddr
-        Want_IP6 -> insertNode (mainlineKademlia client $ routing6 routing) naddr
-    -- TODO Update external ip address and update BEP-42 node id.
-    return ()
+        Want_IP4 -> go (routing4 routing) (committee4 routing)
+        Want_IP6 -> go (routing6 routing) (committee6 routing)
+ where
+    go tbl committee = do
+        case msg of
+            R { rspReflectedIP = Just sockaddr }
+                -> atomically $ addVote committee (nodeId naddr) sockaddr
+            _   -> return ()
+        insertNode (mainlineKademlia client committee tbl) naddr
 
 data Ping = Ping deriving Show