From 4b5b7b56445fe2521e89146b2761de6b7534e59d Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Wed, 18 Dec 2013 22:00:45 +0400 Subject: Add the new purified routing table --- src/Data/Kademlia/Routing/Table.hs | 182 ------------------------------------- 1 file changed, 182 deletions(-) delete mode 100644 src/Data/Kademlia/Routing/Table.hs (limited to 'src/Data/Kademlia/Routing/Table.hs') diff --git a/src/Data/Kademlia/Routing/Table.hs b/src/Data/Kademlia/Routing/Table.hs deleted file mode 100644 index b3b2a655..00000000 --- a/src/Data/Kademlia/Routing/Table.hs +++ /dev/null @@ -1,182 +0,0 @@ --- | --- Copyright : (c) Sam Truzjan 2013 --- License : BSD3 --- Maintainer : pxqr.sta@gmail.com --- Stability : experimental --- Portability : portable --- -{-# LANGUAGE RecordWildCards #-} -module Data.Kademlia.Routing.Table - ( Table(nodeID) - ) where - -import Control.Applicative hiding (empty) -import Data.Bits -import Data.List as L hiding (insert) -import Data.Maybe - -{----------------------------------------------------------------------- - Bucket ------------------------------------------------------------------------} - -type Size = Int - --- | Bucket is kept sorted by time last seen — least-recently seen --- node at the head, most-recently seen at the tail. Reason: when we --- insert a node into the bucket we first filter nodes with smaller --- lifetime since they more likely leave network and we more likely --- don't reach list end. This should reduce list traversal, we don't --- need to reverse list in insertion routines. --- --- Bucket is also limited in its length — thus it's called k-bucket. --- When bucket becomes full we should split it in two lists by --- current span bit. Span bit is defined by depth in the routing --- table tree. Size of the bucket should be choosen such that it's --- very unlikely that all nodes in bucket fail within an hour of --- each other. --- -data Bucket = Empty - | Cons {-# UNPACK #-} !NodeAddr {-# UNPACK #-} !TimeStamp !Bucket - --- | Gives /current/ size of bucket. --- --- forall bucket. size bucket <= maxSize bucket --- -size :: Bucket k v -> Size -size = L.length . kvs - -isFull :: Bucket k v -> Bool -isFull Bucket {..} = L.length kvs == maxSize - -member :: Eq k => k -> Bucket k v -> Bool -member k = elem k . map fst . kvs - -empty :: Size -> Bucket k v -empty s = Bucket (max 0 s) [] - -singleton :: Size -> k -> v -> Bucket k v -singleton s k v = Bucket (max 1 s) [(k, v)] - - --- | Increase size of a given bucket. -enlarge :: Size -> Bucket k v -> Bucket k v -enlarge additional b = b { maxSize = maxSize b + additional } - -split :: Bits k => Int -> Bucket k v -> (Bucket k v, Bucket k v) -split index Bucket {..} = - let (far, near) = partition spanBit kvs - in (Bucket maxSize near, Bucket maxSize far) - where - spanBit = (`testBit` index) . fst - - --- move elem to the end in one traversal -moveToEnd :: Eq k => (k, v) -> Bucket k v -> Bucket k v -moveToEnd kv@(k, _) b = b { kvs = go (kvs b) } - where - go [] = [] - go (x : xs) - | fst x == k = xs ++ [kv] - | otherwise = x : go xs - -insertToEnd :: (k, v) -> Bucket k v -> Bucket k v -insertToEnd kv b = b { kvs = kvs b ++ [kv] } - --- | * If the info already exists in bucket then move it to the end. --- --- * If bucket is not full then insert the info to the end. --- --- * If bucket is full then ping the least recently seen node. --- Here we have a choice: --- --- If node respond then move it the end and discard node --- we want to insert. --- --- If not remove it from the bucket and add the --- (we want to insert) node to the end. --- -insert :: Applicative f => Eq k - => (v -> f Bool) -- ^ Ping RPC - -> (k, v) -> Bucket k v -> f (Bucket k v) - -insert ping new bucket@(Bucket {..}) - | fst new `member` bucket = pure (new `moveToEnd` bucket) - | size bucket < maxSize = pure (new `insertToEnd` bucket) - | least : rest <- kvs = - let select alive = if alive then least else new - mk most = Bucket maxSize (rest ++ [most]) - in mk . select <$> ping (snd least) - where --- | otherwise = pure bucket - -- WARN: or maybe error "insertBucket: max size should not be 0" ? - -lookup :: k -> Bucket k v -> Maybe v -lookup = undefined - -closest :: Int -> k -> Bucket k v -> [(k, v)] -closest = undefined - --- | Most clients use this value for maximum bucket size. -defaultBucketSize :: Int -defaultBucketSize = 20 - -{----------------------------------------------------------------------- - Tree ------------------------------------------------------------------------} - --- | Routing tree should contain key -> value pairs in this way: --- --- * More keys that near to our node key, and less keys that far --- from our node key. --- --- * Tree might be saturated. If this happen we can only update --- buckets, but we can't add new buckets. --- --- Instead of using ordinary binary tree and keep track is it --- following restrictions above (that's somewhat non-trivial) we --- store distance -> value keys. This lead to simple data structure --- that actually isomorphic to non-empty list. So we first map our --- keys to distances using our node ID and store them in tree. When --- we need to extract a pair we map distances to keys back, again --- using our node ID. This normalization happen in routing table. --- -data Tree k v - = Tip (Bucket k v) - | Bin (Tree k v) (Bucket k v) - -empty :: Int -> Tree k v -empty = Tip . Bucket.empty - -insert :: Applicative f => Bits k - => (v -> f Bool) -> (k, v) -> Tree k v -> f (Tree k v) -insert ping (k, v) = go 0 - where - go n (Tip bucket) - | isFull bucket, (near, far) <- split n bucket - = pure (Tip near `Bin` far) - | otherwise = Tip <$> Bucket.insert ping (k, v) bucket - - go n (Bin near far) - | k `testBit` n = Bin <$> pure near <*> Bucket.insert ping (k, v) far - | otherwise = Bin <$> go (succ n) near <*> pure far - -{----------------------------------------------------------------------- - Table ------------------------------------------------------------------------} - -data Table k v = Table { - routeTree :: Tree k v - - -- | Set degree of parallelism in node lookup calls. - , alpha :: Int - , nodeID :: k - } - ---insert :: NodeID -> Table -> Table ---insert x t = undefined - ---closest :: InfoHash -> Table -> [NodeID] ---closest = undefined - --- TODO table serialization: usually we need to save table between --- target program executions for bootstrapping -- cgit v1.2.3