summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2017-07-25 06:16:37 -0400
committerjoe <joe@jerkface.net>2017-07-25 06:16:37 -0400
commit895f5da85bc18640db7194df7553db84abb7f29a (patch)
tree50e809cb00c1f35d8414a4d489631460ab28b7a3
parentfd10ed050a3155197b0b5a196b2ea8212350677c (diff)
Removed broken bktCount parameter to BucketList.
-rw-r--r--src/Network/DHT/Routing.hs46
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--
416data BucketList ni = forall s. Reifies s (Compare ni) => 416data 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
423mapTable :: (b -> t) -> (t -> b) -> BucketList t -> BucketList b 422mapTable :: (b -> t) -> (t -> b) -> BucketList t -> BucketList b
424mapTable g f tbl@(BucketList self n bkts) = reify (contramapC g $ bucketCompare bkts) 423mapTable 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
446deriving instance (Show ni) => Show (BucketList ni) 444deriving instance (Show ni) => Show (BucketList ni)
447#else 445#else
448instance Show ni => Show (BucketList ni) where 446instance 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.
523shape :: BucketList ni -> [Int] 516shape :: BucketList ni -> [Int]
524shape (BucketList _ _ tbl) = map (PSQ.size . bktNodes) tbl 517shape (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
542lookupBucket space nid kont (BucketList self _ bkts) = kont $ go 0 [] bkts 535lookupBucket 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
552bucketNumber :: forall ni nid. 545bucketNumber :: forall ni nid.
553 KademliaSpace nid ni -> nid -> BucketList ni -> Int 546 KademliaSpace nid ni -> nid -> BucketList ni -> Int
554bucketNumber space nid (BucketList self _ bkts) = fromIntegral $ go 0 bkts 547bucketNumber 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
584tableBits :: (ni -> Word -> Bool) -> BucketList ni -> [Bool] 577tableBits :: (ni -> Word -> Bool) -> BucketList ni -> [Bool]
585tableBits testbit (BucketList self _ bkts) = 578tableBits testbit (BucketList self bkts) =
586 zipWith const (map (testbit self) [0..]) 579 zipWith const (map (testbit self) [0..])
587 bkts 580 bkts
588 581
589selfNode :: BucketList ni -> ni 582selfNode :: BucketList ni -> ni
590selfNode (BucketList self _ _) = self 583selfNode (BucketList self _) = self
591 584
592chunksOf :: Int -> [e] -> [[e]] 585chunksOf :: Int -> [e] -> [[e]]
593chunksOf i ls = map (take i) (build (splitter ls)) where 586chunksOf 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)
654splitTip :: -- ( Eq ip , Ord (NodeId) , FiniteBits (NodeId)) => 647splitTip :: -- ( 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 ]
658splitTip testNodeBit ni n i bucket 651splitTip 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)
674modifyBucket space nid f (BucketList self n bkts) 667modifyBucket 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
682bktCount :: BucketList ni -> Int
683bktCount (BucketList _ bkts) = L.length bkts
690 684
691-- | Triggering event for atomic table update 685-- | Triggering event for atomic table update
692data Event ni = TryInsert { foreignNode :: ni } 686data Event ni = TryInsert { foreignNode :: ni }
@@ -735,7 +729,7 @@ deriving instance ( Show ip
735updateForInbound :: 729updateForInbound ::
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)
738updateForInbound space tm ni tbl@(BucketList _ _ bkts) = 732updateForInbound 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
770tableEntry (a :-> b) = (a, b) 764tableEntry (a :-> b) = (a, b)
771 765
772toList :: BucketList ni -> [[TableEntry ni]] 766toList :: BucketList ni -> [[TableEntry ni]]
773toList (BucketList _ _ bkts) = coerce $ L.map (L.map tableEntry . PSQ.toList . bktNodes) bkts 767toList (BucketList _ bkts) = coerce $ L.map (L.map tableEntry . PSQ.toList . bktNodes) bkts
774 768
775data KademliaSpace nid ni = KademliaSpace 769data 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