diff options
author | joe <joe@jerkface.net> | 2017-07-25 06:16:37 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-07-25 06:16:37 -0400 |
commit | 895f5da85bc18640db7194df7553db84abb7f29a (patch) | |
tree | 50e809cb00c1f35d8414a4d489631460ab28b7a3 | |
parent | fd10ed050a3155197b0b5a196b2ea8212350677c (diff) |
Removed broken bktCount parameter to BucketList.
-rw-r--r-- | src/Network/DHT/Routing.hs | 46 |
1 files changed, 20 insertions, 26 deletions
diff --git a/src/Network/DHT/Routing.hs b/src/Network/DHT/Routing.hs index 46ebe472..63ff46c7 100644 --- a/src/Network/DHT/Routing.hs +++ b/src/Network/DHT/Routing.hs | |||
@@ -415,16 +415,14 @@ deriving instance (Show ni, Show nid) => Show (Info ni nid) | |||
415 | -- | 415 | -- |
416 | data BucketList ni = forall s. Reifies s (Compare ni) => | 416 | data BucketList ni = forall s. Reifies s (Compare ni) => |
417 | BucketList { thisNode :: !ni | 417 | BucketList { thisNode :: !ni |
418 | , bktCount :: !Int | ||
419 | -- | Non-empty list of buckets. | 418 | -- | Non-empty list of buckets. |
420 | , buckets :: [Bucket s ni] | 419 | , buckets :: [Bucket s ni] |
421 | } | 420 | } |
422 | 421 | ||
423 | mapTable :: (b -> t) -> (t -> b) -> BucketList t -> BucketList b | 422 | mapTable :: (b -> t) -> (t -> b) -> BucketList t -> BucketList b |
424 | mapTable g f tbl@(BucketList self n bkts) = reify (contramapC g $ bucketCompare bkts) | 423 | mapTable g f tbl@(BucketList self bkts) = reify (contramapC g $ bucketCompare bkts) |
425 | $ \p -> BucketList | 424 | $ \p -> BucketList |
426 | { thisNode = f self | 425 | { thisNode = f self |
427 | , bktCount = n | ||
428 | , buckets = map (resolve p . mapBucket f) bkts | 426 | , buckets = map (resolve p . mapBucket f) bkts |
429 | } | 427 | } |
430 | where | 428 | where |
@@ -446,11 +444,9 @@ instance Serialize NominalDiffTime where | |||
446 | deriving instance (Show ni) => Show (BucketList ni) | 444 | deriving instance (Show ni) => Show (BucketList ni) |
447 | #else | 445 | #else |
448 | instance Show ni => Show (BucketList ni) where | 446 | instance Show ni => Show (BucketList ni) where |
449 | showsPrec d (BucketList self cnt bkts) = | 447 | showsPrec d (BucketList self bkts) = |
450 | mappend "BucketList " | 448 | mappend "BucketList " |
451 | . showsPrec (d+1) self | 449 | . showsPrec (d+1) self |
452 | . mappend " " | ||
453 | . showsPrec (d+1) cnt | ||
454 | . mappend " (fromList " | 450 | . mappend " (fromList " |
455 | . showsPrec (d+1) (L.map (L.map tableEntry . PSQ.toList . bktNodes) $ bkts) | 451 | . showsPrec (d+1) (L.map (L.map tableEntry . PSQ.toList . bktNodes) $ bkts) |
456 | . mappend ") " | 452 | . mappend ") " |
@@ -484,11 +480,8 @@ nullTable cmp hsh ni n = | |||
484 | reify (Compare cmp hsh) | 480 | reify (Compare cmp hsh) |
485 | $ \p -> BucketList | 481 | $ \p -> BucketList |
486 | ni | 482 | ni |
487 | (bucketCount (pred n)) | ||
488 | [Bucket (empty p) (runIdentity $ emptyQueue bucketQ)] | 483 | [Bucket (empty p) (runIdentity $ emptyQueue bucketQ)] |
489 | where | 484 | where |
490 | bucketCount x = max 0 (min 159 x) | ||
491 | |||
492 | empty :: Reifies s (Compare ni) => Proxy s -> PSQ (Ordered s ni) Timestamp | 485 | empty :: Reifies s (Compare ni) => Proxy s -> PSQ (Ordered s ni) Timestamp |
493 | empty = const $ PSQ.empty | 486 | empty = const $ PSQ.empty |
494 | 487 | ||
@@ -521,7 +514,7 @@ type NodeCount = Int | |||
521 | -- | Internally, routing table is similar to list of buckets or a | 514 | -- | Internally, routing table is similar to list of buckets or a |
522 | -- /matrix/ of nodes. This function returns the shape of the matrix. | 515 | -- /matrix/ of nodes. This function returns the shape of the matrix. |
523 | shape :: BucketList ni -> [Int] | 516 | shape :: BucketList ni -> [Int] |
524 | shape (BucketList _ _ tbl) = map (PSQ.size . bktNodes) tbl | 517 | shape (BucketList _ tbl) = map (PSQ.size . bktNodes) tbl |
525 | 518 | ||
526 | #if 0 | 519 | #if 0 |
527 | 520 | ||
@@ -539,7 +532,7 @@ lookupBucket :: forall ni nid x. | |||
539 | ( -- FiniteBits nid | 532 | ( -- FiniteBits nid |
540 | Ord nid | 533 | Ord nid |
541 | ) => KademliaSpace nid ni -> nid -> (forall s. Reifies s (Compare ni) => [Bucket s ni] -> x) -> BucketList ni -> x | 534 | ) => KademliaSpace nid ni -> nid -> (forall s. Reifies s (Compare ni) => [Bucket s ni] -> x) -> BucketList ni -> x |
542 | lookupBucket space nid kont (BucketList self _ bkts) = kont $ go 0 [] bkts | 535 | lookupBucket space nid kont (BucketList self bkts) = kont $ go 0 [] bkts |
543 | where | 536 | where |
544 | d = kademliaXor space nid (kademliaLocation space self) | 537 | d = kademliaXor space nid (kademliaLocation space self) |
545 | 538 | ||
@@ -551,7 +544,7 @@ lookupBucket space nid kont (BucketList self _ bkts) = kont $ go 0 [] bkts | |||
551 | 544 | ||
552 | bucketNumber :: forall ni nid. | 545 | bucketNumber :: forall ni nid. |
553 | KademliaSpace nid ni -> nid -> BucketList ni -> Int | 546 | KademliaSpace nid ni -> nid -> BucketList ni -> Int |
554 | bucketNumber space nid (BucketList self _ bkts) = fromIntegral $ go 0 bkts | 547 | bucketNumber space nid (BucketList self bkts) = fromIntegral $ go 0 bkts |
555 | where | 548 | where |
556 | d = kademliaXor space nid (kademliaLocation space self) | 549 | d = kademliaXor space nid (kademliaLocation space self) |
557 | 550 | ||
@@ -582,12 +575,12 @@ tablePrefix testbit = map (packByte . take 8 . (++repeat False)) | |||
582 | bitmask _ _ = 0 | 575 | bitmask _ _ = 0 |
583 | 576 | ||
584 | tableBits :: (ni -> Word -> Bool) -> BucketList ni -> [Bool] | 577 | tableBits :: (ni -> Word -> Bool) -> BucketList ni -> [Bool] |
585 | tableBits testbit (BucketList self _ bkts) = | 578 | tableBits testbit (BucketList self bkts) = |
586 | zipWith const (map (testbit self) [0..]) | 579 | zipWith const (map (testbit self) [0..]) |
587 | bkts | 580 | bkts |
588 | 581 | ||
589 | selfNode :: BucketList ni -> ni | 582 | selfNode :: BucketList ni -> ni |
590 | selfNode (BucketList self _ _) = self | 583 | selfNode (BucketList self _) = self |
591 | 584 | ||
592 | chunksOf :: Int -> [e] -> [[e]] | 585 | chunksOf :: Int -> [e] -> [[e]] |
593 | chunksOf i ls = map (take i) (build (splitter ls)) where | 586 | chunksOf i ls = map (take i) (build (splitter ls)) where |
@@ -654,8 +647,8 @@ kclosest space k nid tbl = take k $ rank space nid (L.concat bucket) | |||
654 | splitTip :: -- ( Eq ip , Ord (NodeId) , FiniteBits (NodeId)) => | 647 | splitTip :: -- ( Eq ip , Ord (NodeId) , FiniteBits (NodeId)) => |
655 | ( Reifies s (Compare ni) ) => | 648 | ( Reifies s (Compare ni) ) => |
656 | (ni -> Word -> Bool) | 649 | (ni -> Word -> Bool) |
657 | -> ni -> Int -> BitIx -> Bucket s ni -> [ Bucket s ni ] | 650 | -> ni -> BitIx -> Bucket s ni -> [ Bucket s ni ] |
658 | splitTip testNodeBit ni n i bucket | 651 | splitTip testNodeBit ni i bucket |
659 | | testNodeBit ni i = [zeros , ones ] | 652 | | testNodeBit ni i = [zeros , ones ] |
660 | | otherwise = [ones , zeros ] | 653 | | otherwise = [ones , zeros ] |
661 | where | 654 | where |
@@ -671,22 +664,23 @@ modifyBucket | |||
671 | forall ni nid xs. | 664 | forall ni nid xs. |
672 | KademliaSpace nid ni | 665 | KademliaSpace nid ni |
673 | -> nid -> (forall s. Reifies s (Compare ni) => Bucket s ni -> Maybe (xs, Bucket s ni)) -> BucketList ni -> Maybe (xs,BucketList ni) | 666 | -> nid -> (forall s. Reifies s (Compare ni) => Bucket s ni -> Maybe (xs, Bucket s ni)) -> BucketList ni -> Maybe (xs,BucketList ni) |
674 | modifyBucket space nid f (BucketList self n bkts) | 667 | modifyBucket space nid f (BucketList self bkts) |
675 | = second (BucketList self n) <$> go (0 :: BitIx) bkts | 668 | = second (BucketList self) <$> go (0 :: BitIx) bkts |
676 | where | 669 | where |
677 | d = kademliaXor space nid (kademliaLocation space self) | 670 | d = kademliaXor space nid (kademliaLocation space self) |
678 | 671 | ||
679 | -- go :: BitIx -> [Bucket s ni] -> Maybe (xs, [Bucket s ni]) | 672 | -- go :: BitIx -> [Bucket s ni] -> Maybe (xs, [Bucket s ni]) |
680 | 673 | ||
681 | go !i (bucket : buckets@(_:_)) | 674 | go !i (bucket : buckets@(_:_)) |
682 | | kademliaTestBit space d i = second (bucket :) <$> go (succ i) buckets | 675 | | kademliaTestBit space d i = second (: buckets) <$> f bucket |
683 | | otherwise = second (: buckets) <$> f bucket | 676 | | otherwise = second (bucket :) <$> go (succ i) buckets |
677 | |||
678 | go !i [bucket] = second (: []) <$> f bucket | ||
679 | <|> go i (splitTip (kademliaTestBit space . kademliaLocation space) self i bucket) | ||
684 | 680 | ||
685 | go !i [bucket] | ||
686 | | (n == 0) = second (: []) <$> f bucket | ||
687 | | otherwise = second (: []) <$> f bucket | ||
688 | <|> go i (splitTip (kademliaTestBit space . kademliaLocation space) self n i bucket) | ||
689 | 681 | ||
682 | bktCount :: BucketList ni -> Int | ||
683 | bktCount (BucketList _ bkts) = L.length bkts | ||
690 | 684 | ||
691 | -- | Triggering event for atomic table update | 685 | -- | Triggering event for atomic table update |
692 | data Event ni = TryInsert { foreignNode :: ni } | 686 | data Event ni = TryInsert { foreignNode :: ni } |
@@ -735,7 +729,7 @@ deriving instance ( Show ip | |||
735 | updateForInbound :: | 729 | updateForInbound :: |
736 | KademliaSpace nid ni | 730 | KademliaSpace nid ni |
737 | -> Timestamp -> ni -> BucketList ni -> (Bool, [ni], BucketList ni) | 731 | -> Timestamp -> ni -> BucketList ni -> (Bool, [ni], BucketList ni) |
738 | updateForInbound space tm ni tbl@(BucketList _ _ bkts) = | 732 | updateForInbound space tm ni tbl@(BucketList _ bkts) = |
739 | maybe (False, [],tbl) (\(ps,tbl') -> (True, ps, tbl')) | 733 | maybe (False, [],tbl) (\(ps,tbl') -> (True, ps, tbl')) |
740 | $ modifyBucket space | 734 | $ modifyBucket space |
741 | (kademliaLocation space ni) | 735 | (kademliaLocation space ni) |
@@ -770,7 +764,7 @@ tableEntry :: NodeEntry ni -> TableEntry ni | |||
770 | tableEntry (a :-> b) = (a, b) | 764 | tableEntry (a :-> b) = (a, b) |
771 | 765 | ||
772 | toList :: BucketList ni -> [[TableEntry ni]] | 766 | toList :: BucketList ni -> [[TableEntry ni]] |
773 | toList (BucketList _ _ bkts) = coerce $ L.map (L.map tableEntry . PSQ.toList . bktNodes) bkts | 767 | toList (BucketList _ bkts) = coerce $ L.map (L.map tableEntry . PSQ.toList . bktNodes) bkts |
774 | 768 | ||
775 | data KademliaSpace nid ni = KademliaSpace | 769 | data KademliaSpace nid ni = KademliaSpace |
776 | { -- | Given a node record (probably including IP address), yields a | 770 | { -- | Given a node record (probably including IP address), yields a |