diff options
Diffstat (limited to 'src/Network/Tox/DHT/Handlers.hs')
-rw-r--r-- | src/Network/Tox/DHT/Handlers.hs | 26 |
1 files changed, 13 insertions, 13 deletions
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs index c9adc860..a3f13ac7 100644 --- a/src/Network/Tox/DHT/Handlers.hs +++ b/src/Network/Tox/DHT/Handlers.hs | |||
@@ -105,7 +105,6 @@ data Routing = Routing | |||
105 | , sched6 :: !( TVar (Int.PSQ POSIXTime) ) | 105 | , sched6 :: !( TVar (Int.PSQ POSIXTime) ) |
106 | , routing6 :: !( TVar (R.BucketList NodeInfo) ) | 106 | , routing6 :: !( TVar (R.BucketList NodeInfo) ) |
107 | , committee6 :: TriadCommittee NodeId SockAddr | 107 | , committee6 :: TriadCommittee NodeId SockAddr |
108 | , orouter :: OnionRouter | ||
109 | } | 108 | } |
110 | 109 | ||
111 | newRouting :: SockAddr -> TransportCrypto | 110 | newRouting :: SockAddr -> TransportCrypto |
@@ -124,8 +123,9 @@ newRouting addr crypto update4 update6 = do | |||
124 | tentative_info6 <- | 123 | tentative_info6 <- |
125 | maybe (tentative_info { nodeIP = tentative_ip6 }) | 124 | maybe (tentative_info { nodeIP = tentative_ip6 }) |
126 | (\ip6 -> tentative_info { nodeIP = IPv6 ip6 }) | 125 | (\ip6 -> tentative_info { nodeIP = IPv6 ip6 }) |
127 | <$> global6 | 126 | <$> case addr of |
128 | orouter <- newOnionRouter | 127 | SockAddrInet {} -> return Nothing |
128 | _ -> global6 | ||
129 | atomically $ do | 129 | atomically $ do |
130 | let nobkts = R.defaultBucketCount :: Int | 130 | let nobkts = R.defaultBucketCount :: Int |
131 | 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 |
@@ -134,7 +134,7 @@ newRouting addr crypto update4 update6 = do | |||
134 | committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6 | 134 | committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6 |
135 | sched4 <- newTVar Int.empty | 135 | sched4 <- newTVar Int.empty |
136 | sched6 <- newTVar Int.empty | 136 | sched6 <- newTVar Int.empty |
137 | return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 orouter | 137 | return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 |
138 | 138 | ||
139 | 139 | ||
140 | -- TODO: This should cover more cases | 140 | -- TODO: This should cover more cases |
@@ -200,7 +200,7 @@ serializer :: PacketKind | |||
200 | -> (Message -> Maybe (Assym (Nonce8,pong))) | 200 | -> (Message -> Maybe (Assym (Nonce8,pong))) |
201 | -> MethodSerializer TransactionId NodeInfo Message PacketKind ping (Maybe pong) | 201 | -> MethodSerializer TransactionId NodeInfo Message PacketKind ping (Maybe pong) |
202 | serializer pktkind mkping mkpong = MethodSerializer | 202 | serializer pktkind mkping mkpong = MethodSerializer |
203 | { methodTimeout = 5 | 203 | { methodTimeout = \tid addr -> return (addr, 5000000) |
204 | , method = pktkind | 204 | , method = pktkind |
205 | -- wrapQuery :: tid -> addr -> addr -> qry -> x | 205 | -- wrapQuery :: tid -> addr -> addr -> qry -> x |
206 | , wrapQuery = \tid src dst ping -> mkping $ wrapAssym tid src dst (, ping) | 206 | , wrapQuery = \tid src dst ping -> mkping $ wrapAssym tid src dst (, ping) |
@@ -232,20 +232,20 @@ unwrapNodes (SendNodes ns) = (ns,ns,()) | |||
232 | 232 | ||
233 | getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],())) | 233 | getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],())) |
234 | getNodes client nid addr = do | 234 | getNodes client nid addr = do |
235 | hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid | 235 | -- hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid |
236 | reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr | 236 | reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr |
237 | hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply | 237 | -- hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply |
238 | return $ fmap unwrapNodes $ join reply | 238 | return $ fmap unwrapNodes $ join reply |
239 | 239 | ||
240 | updateRouting :: Client -> Routing -> NodeInfo -> Message -> IO () | 240 | updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO () |
241 | updateRouting client routing naddr msg = do | 241 | updateRouting client routing orouter naddr msg = do |
242 | let typ = fst $ dhtMessageType $ fst $ DHTTransport.encrypt (error "updateRouting") msg naddr | 242 | let typ = fst $ dhtMessageType $ fst $ DHTTransport.encrypt (error "updateRouting") msg naddr |
243 | tid = mapMessage (\n24 (n8,_) -> TransactionId n8 n24) msg | 243 | tid = mapMessage (\n24 (n8,_) -> TransactionId n8 n24) msg |
244 | hPutStrLn stderr $ "updateRouting "++show (typ,tid) | 244 | -- hPutStrLn stderr $ "updateRouting "++show (typ,tid) |
245 | -- TODO: check msg type | 245 | -- TODO: check msg type |
246 | case prefer4or6 naddr Nothing of | 246 | case prefer4or6 naddr Nothing of |
247 | Want_IP4 -> updateTable client naddr (orouter routing) (routing4 routing) (committee4 routing) (sched4 routing) | 247 | Want_IP4 -> updateTable client naddr orouter (routing4 routing) (committee4 routing) (sched4 routing) |
248 | Want_IP6 -> updateTable client naddr (orouter routing) (routing6 routing) (committee6 routing) (sched6 routing) | 248 | Want_IP6 -> updateTable client naddr orouter (routing6 routing) (committee6 routing) (sched6 routing) |
249 | 249 | ||
250 | updateTable :: Client -> NodeInfo -> OnionRouter -> 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 () |
251 | updateTable client naddr orouter tbl committee sched = do | 251 | updateTable client naddr orouter tbl committee sched = do |
@@ -262,7 +262,7 @@ toxKademlia client committee orouter var sched | |||
262 | { tblTransition = \tr -> do | 262 | { tblTransition = \tr -> do |
263 | io1 <- transitionCommittee committee tr | 263 | io1 <- transitionCommittee committee tr |
264 | io2 <- touchBucket toxSpace (15*60) var sched tr | 264 | io2 <- touchBucket toxSpace (15*60) var sched tr |
265 | hookBucketList orouter tr | 265 | hookBucketList toxSpace var orouter tr |
266 | return $ do | 266 | return $ do |
267 | io1 >> io2 | 267 | io1 >> io2 |
268 | {- | 268 | {- |