diff options
-rw-r--r-- | Mainline.hs | 36 |
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 | |||
268 | data Routing = Routing | 268 | data Routing = Routing |
269 | { tentativeId :: NodeInfo | 269 | { tentativeId :: NodeInfo |
270 | , routing4 :: !( TVar (R.BucketList NodeInfo) ) | 270 | , routing4 :: !( TVar (R.BucketList NodeInfo) ) |
271 | , committee4 :: TriadCommittee NodeId SockAddr | ||
271 | , routing6 :: !( TVar (R.BucketList NodeInfo) ) | 272 | , routing6 :: !( TVar (R.BucketList NodeInfo) ) |
273 | , committee6 :: TriadCommittee NodeId SockAddr | ||
272 | } | 274 | } |
273 | 275 | ||
274 | type MainlineClient = Client String Method TransactionId NodeInfo (Message BValue) | 276 | type MainlineClient = Client String Method TransactionId NodeInfo (Message BValue) |
@@ -286,7 +288,9 @@ newClient addr = do | |||
286 | let nobkts = R.defaultBucketCount :: Int | 288 | let nobkts = R.defaultBucketCount :: Int |
287 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts | 289 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts |
288 | tbl6 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts | 290 | tbl6 <- newTVar $ R.nullTable (comparing nodeId) tenative_info nobkts |
289 | return $ Routing tenative_info tbl4 tbl6 | 291 | committee4 <- newTriadCommittee (const $ return ()) -- TODO: update tbl4 |
292 | committee6 <- newTriadCommittee (const $ return ()) -- TODO: update tbl6 | ||
293 | return $ Routing tenative_info tbl4 committee4 tbl6 committee6 | ||
290 | swarms <- newSwarmsDatabase | 294 | swarms <- newSwarmsDatabase |
291 | map_var <- atomically $ newTVar (0, mempty) | 295 | map_var <- atomically $ newTVar (0, mempty) |
292 | let net = onInbound (updateRouting outgoingClient routing) | 296 | let net = onInbound (updateRouting outgoingClient routing) |
@@ -338,10 +342,13 @@ defaultHandler meth = MethodHandler decodePayload errorPayload returnError | |||
338 | returnError :: NodeInfo -> BValue -> IO Error | 342 | returnError :: NodeInfo -> BValue -> IO Error |
339 | returnError _ _ = return $ Error MethodUnknown ("Unknown method " <> meth) | 343 | returnError _ _ = return $ Error MethodUnknown ("Unknown method " <> meth) |
340 | 344 | ||
341 | mainlineKademlia :: MainlineClient -> TVar (R.BucketList NodeInfo) -> Kademlia NodeId NodeInfo | 345 | mainlineKademlia :: MainlineClient -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) -> Kademlia NodeId NodeInfo |
342 | mainlineKademlia client var = Kademlia quietInsertions | 346 | mainlineKademlia client committee var |
343 | mainlineSpace | 347 | = Kademlia quietInsertions |
344 | (vanillaIO var $ ping client) | 348 | mainlineSpace |
349 | (vanillaIO var $ ping client) | ||
350 | { tblTransition = transitionCommittee committee } | ||
351 | |||
345 | 352 | ||
346 | mainlineSpace :: R.KademliaSpace NodeId NodeInfo | 353 | mainlineSpace :: R.KademliaSpace NodeId NodeInfo |
347 | mainlineSpace = R.KademliaSpace | 354 | mainlineSpace = R.KademliaSpace |
@@ -350,14 +357,23 @@ mainlineSpace = R.KademliaSpace | |||
350 | , R.kademliaXor = xor | 357 | , R.kademliaXor = xor |
351 | } | 358 | } |
352 | 359 | ||
360 | transitionCommittee :: TriadCommittee NodeId SockAddr -> RoutingTransition NodeInfo -> STM (IO ()) | ||
361 | transitionCommittee committee (RoutingTransition ni Stranger) = do | ||
362 | delVote committee (nodeId ni) | ||
363 | return $ return () | ||
353 | 364 | ||
354 | updateRouting :: MainlineClient -> Routing -> NodeInfo -> Message BValue -> IO () | 365 | updateRouting :: MainlineClient -> Routing -> NodeInfo -> Message BValue -> IO () |
355 | updateRouting client routing naddr _ = do | 366 | updateRouting client routing naddr msg = do |
356 | case prefer4or6 naddr Nothing of | 367 | case prefer4or6 naddr Nothing of |
357 | Want_IP4 -> insertNode (mainlineKademlia client $ routing4 routing) naddr | 368 | Want_IP4 -> go (routing4 routing) (committee4 routing) |
358 | Want_IP6 -> insertNode (mainlineKademlia client $ routing6 routing) naddr | 369 | Want_IP6 -> go (routing6 routing) (committee6 routing) |
359 | -- TODO Update external ip address and update BEP-42 node id. | 370 | where |
360 | return () | 371 | go tbl committee = do |
372 | case msg of | ||
373 | R { rspReflectedIP = Just sockaddr } | ||
374 | -> atomically $ addVote committee (nodeId naddr) sockaddr | ||
375 | _ -> return () | ||
376 | insertNode (mainlineKademlia client committee tbl) naddr | ||
361 | 377 | ||
362 | data Ping = Ping deriving Show | 378 | data Ping = Ping deriving Show |
363 | 379 | ||