diff options
Diffstat (limited to 'src/Network/Tox/DHT')
-rw-r--r-- | src/Network/Tox/DHT/Handlers.hs | 20 |
1 files changed, 12 insertions, 8 deletions
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs index 4e43c4a7..c9adc860 100644 --- a/src/Network/Tox/DHT/Handlers.hs +++ b/src/Network/Tox/DHT/Handlers.hs | |||
@@ -14,6 +14,7 @@ import Network.Address (WantIP (..), ipFamily, testIdBit,fromSockA | |||
14 | import qualified Network.Kademlia.Routing as R | 14 | import qualified Network.Kademlia.Routing as R |
15 | import Control.TriadCommittee | 15 | import Control.TriadCommittee |
16 | import System.Global6 | 16 | import System.Global6 |
17 | import OnionRouter | ||
17 | 18 | ||
18 | import qualified Data.ByteArray as BA | 19 | import qualified Data.ByteArray as BA |
19 | import qualified Data.ByteString.Char8 as C8 | 20 | import qualified Data.ByteString.Char8 as C8 |
@@ -104,6 +105,7 @@ data Routing = Routing | |||
104 | , sched6 :: !( TVar (Int.PSQ POSIXTime) ) | 105 | , sched6 :: !( TVar (Int.PSQ POSIXTime) ) |
105 | , routing6 :: !( TVar (R.BucketList NodeInfo) ) | 106 | , routing6 :: !( TVar (R.BucketList NodeInfo) ) |
106 | , committee6 :: TriadCommittee NodeId SockAddr | 107 | , committee6 :: TriadCommittee NodeId SockAddr |
108 | , orouter :: OnionRouter | ||
107 | } | 109 | } |
108 | 110 | ||
109 | newRouting :: SockAddr -> TransportCrypto | 111 | newRouting :: SockAddr -> TransportCrypto |
@@ -123,6 +125,7 @@ newRouting addr crypto update4 update6 = do | |||
123 | maybe (tentative_info { nodeIP = tentative_ip6 }) | 125 | maybe (tentative_info { nodeIP = tentative_ip6 }) |
124 | (\ip6 -> tentative_info { nodeIP = IPv6 ip6 }) | 126 | (\ip6 -> tentative_info { nodeIP = IPv6 ip6 }) |
125 | <$> global6 | 127 | <$> global6 |
128 | orouter <- newOnionRouter | ||
126 | atomically $ do | 129 | atomically $ do |
127 | let nobkts = R.defaultBucketCount :: Int | 130 | let nobkts = R.defaultBucketCount :: Int |
128 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts | 131 | tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts |
@@ -131,7 +134,7 @@ newRouting addr crypto update4 update6 = do | |||
131 | committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6 | 134 | committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6 |
132 | sched4 <- newTVar Int.empty | 135 | sched4 <- newTVar Int.empty |
133 | sched6 <- newTVar Int.empty | 136 | sched6 <- newTVar Int.empty |
134 | return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 | 137 | return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 orouter |
135 | 138 | ||
136 | 139 | ||
137 | -- TODO: This should cover more cases | 140 | -- TODO: This should cover more cases |
@@ -241,24 +244,25 @@ updateRouting client routing naddr msg = do | |||
241 | hPutStrLn stderr $ "updateRouting "++show (typ,tid) | 244 | hPutStrLn stderr $ "updateRouting "++show (typ,tid) |
242 | -- TODO: check msg type | 245 | -- TODO: check msg type |
243 | case prefer4or6 naddr Nothing of | 246 | case prefer4or6 naddr Nothing of |
244 | Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing) | 247 | Want_IP4 -> updateTable client naddr (orouter routing) (routing4 routing) (committee4 routing) (sched4 routing) |
245 | Want_IP6 -> updateTable client naddr (routing6 routing) (committee6 routing) (sched6 routing) | 248 | Want_IP6 -> updateTable client naddr (orouter routing) (routing6 routing) (committee6 routing) (sched6 routing) |
246 | 249 | ||
247 | updateTable :: Client -> NodeInfo -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO () | 250 | updateTable :: Client -> NodeInfo -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO () |
248 | updateTable client naddr tbl committee sched = do | 251 | updateTable client naddr orouter tbl committee sched = do |
249 | self <- atomically $ R.thisNode <$> readTVar tbl | 252 | self <- atomically $ R.thisNode <$> readTVar tbl |
250 | when (nodeIP self /= nodeIP naddr) $ do | 253 | when (nodeIP self /= nodeIP naddr) $ do |
251 | -- TODO: IP address vote? | 254 | -- TODO: IP address vote? |
252 | insertNode (toxKademlia client committee tbl sched) naddr | 255 | insertNode (toxKademlia client committee orouter tbl sched) naddr |
253 | 256 | ||
254 | toxKademlia :: Client -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo | 257 | toxKademlia :: Client -> TriadCommittee NodeId SockAddr -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo |
255 | toxKademlia client committee var sched | 258 | toxKademlia client committee orouter var sched |
256 | = Kademlia quietInsertions | 259 | = Kademlia quietInsertions |
257 | toxSpace | 260 | toxSpace |
258 | (vanillaIO var $ ping client) | 261 | (vanillaIO var $ ping client) |
259 | { tblTransition = \tr -> do | 262 | { tblTransition = \tr -> do |
260 | io1 <- transitionCommittee committee tr | 263 | io1 <- transitionCommittee committee tr |
261 | io2 <- touchBucket toxSpace (15*60) var sched tr | 264 | io2 <- touchBucket toxSpace (15*60) var sched tr |
265 | hookBucketList orouter tr | ||
262 | return $ do | 266 | return $ do |
263 | io1 >> io2 | 267 | io1 >> io2 |
264 | {- | 268 | {- |