summaryrefslogtreecommitdiff
path: root/src/Network/DHT/Routing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/DHT/Routing.hs')
-rw-r--r--src/Network/DHT/Routing.hs46
1 files changed, 29 insertions, 17 deletions
diff --git a/src/Network/DHT/Routing.hs b/src/Network/DHT/Routing.hs
index 396c4b1d..46ebe472 100644
--- a/src/Network/DHT/Routing.hs
+++ b/src/Network/DHT/Routing.hs
@@ -536,19 +536,31 @@ depth = L.length . shape
536#endif 536#endif
537 537
538lookupBucket :: forall ni nid x. 538lookupBucket :: forall ni nid x.
539 ( FiniteBits nid 539 ( -- FiniteBits nid
540 , Ord nid 540 Ord nid
541 ) => (ni -> nid) -> nid -> (forall s. Reifies s (Compare ni) => [Bucket s ni] -> x) -> BucketList ni -> x 541 ) => KademliaSpace nid ni -> nid -> (forall s. Reifies s (Compare ni) => [Bucket s ni] -> x) -> BucketList ni -> x
542lookupBucket nodeId nid kont (BucketList self _ bkts) = kont $ go 0 [] bkts 542lookupBucket space nid kont (BucketList self _ bkts) = kont $ go 0 [] bkts
543 where 543 where
544 d = nid `xor` nodeId self 544 d = kademliaXor space nid (kademliaLocation space self)
545 545
546 go :: Word -> [Bucket s ni] -> [Bucket s ni] -> [Bucket s ni] 546 go :: Word -> [Bucket s ni] -> [Bucket s ni] -> [Bucket s ni]
547 go i bs (bucket : buckets) 547 go i bs (bucket : buckets)
548 | testIdBit d i = go (succ i) (bucket:bs) buckets 548 | kademliaTestBit space d i = bucket : buckets ++ bs
549 | otherwise = bucket : buckets ++ bs 549 | otherwise = go (succ i) (bucket:bs) buckets
550 go _ bs [] = bs 550 go _ bs [] = bs
551 551
552bucketNumber :: forall ni nid.
553 KademliaSpace nid ni -> nid -> BucketList ni -> Int
554bucketNumber space nid (BucketList self _ bkts) = fromIntegral $ go 0 bkts
555 where
556 d = kademliaXor space nid (kademliaLocation space self)
557
558 go :: Word -> [Bucket s ni] -> Word
559 go i (bucket : buckets)
560 | kademliaTestBit space d i = i
561 | otherwise = go (succ i) buckets
562 go i [] = i
563
552 564
553compatibleNodeId :: forall ni nid. 565compatibleNodeId :: forall ni nid.
554 ( Serialize nid, FiniteBits nid) => 566 ( Serialize nid, FiniteBits nid) =>
@@ -614,23 +626,23 @@ distance :: Bits nid => nid -> nid -> NodeDistance nid
614distance a b = NodeDistance $ xor a b 626distance a b = NodeDistance $ xor a b
615 627
616-- | Order by closeness: nearest nodes first. 628-- | Order by closeness: nearest nodes first.
617rank :: ( FiniteBits nid 629rank :: ( Ord nid
618 , Ord nid 630 ) => KademliaSpace nid ni -> nid -> [ni] -> [ni]
619 ) => (x -> nid) -> nid -> [x] -> [x] 631rank space nid = L.sortBy (comparing (kademliaXor space nid . kademliaLocation space))
620rank f nid = L.sortBy (comparing (distance nid . f))
621 632
622 633
623-- | Get a list of /K/ closest nodes using XOR metric. Used in 634-- | Get a list of /K/ closest nodes using XOR metric. Used in
624-- 'find_node' and 'get_peers' queries. 635-- 'find_node' and 'get_peers' queries.
625kclosest :: ( FiniteBits nid 636kclosest :: ( -- FiniteBits nid
626 , Ord nid 637 Ord nid
627 ) => (ni -> nid) -> Int -> nid -> BucketList ni -> [ni] 638 ) =>
628kclosest nodeId k nid tbl = take k $ rank nodeId nid (L.concat bucket) 639 KademliaSpace nid ni -> Int -> nid -> BucketList ni -> [ni]
629 ++ rank nodeId nid (L.concat everyone) 640kclosest space k nid tbl = take k $ rank space nid (L.concat bucket)
641 ++ rank space nid (L.concat everyone)
630 where 642 where
631 (bucket,everyone) = 643 (bucket,everyone) =
632 L.splitAt 1 644 L.splitAt 1
633 . lookupBucket nodeId nid (L.map (coerce . L.map PSQ.key . PSQ.toList . bktNodes)) 645 . lookupBucket space nid (L.map (coerce . L.map PSQ.key . PSQ.toList . bktNodes))
634 $ tbl 646 $ tbl
635 647
636 648