summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Mainline.hs36
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
268data Routing = Routing 268data 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
274type MainlineClient = Client String Method TransactionId NodeInfo (Message BValue) 276type 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
341mainlineKademlia :: MainlineClient -> TVar (R.BucketList NodeInfo) -> Kademlia NodeId NodeInfo 345mainlineKademlia :: MainlineClient -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) -> Kademlia NodeId NodeInfo
342mainlineKademlia client var = Kademlia quietInsertions 346mainlineKademlia 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
346mainlineSpace :: R.KademliaSpace NodeId NodeInfo 353mainlineSpace :: R.KademliaSpace NodeId NodeInfo
347mainlineSpace = R.KademliaSpace 354mainlineSpace = R.KademliaSpace
@@ -350,14 +357,23 @@ mainlineSpace = R.KademliaSpace
350 , R.kademliaXor = xor 357 , R.kademliaXor = xor
351 } 358 }
352 359
360transitionCommittee :: TriadCommittee NodeId SockAddr -> RoutingTransition NodeInfo -> STM (IO ())
361transitionCommittee committee (RoutingTransition ni Stranger) = do
362 delVote committee (nodeId ni)
363 return $ return ()
353 364
354updateRouting :: MainlineClient -> Routing -> NodeInfo -> Message BValue -> IO () 365updateRouting :: MainlineClient -> Routing -> NodeInfo -> Message BValue -> IO ()
355updateRouting client routing naddr _ = do 366updateRouting 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
362data Ping = Ping deriving Show 378data Ping = Ping deriving Show
363 379