summaryrefslogtreecommitdiff
path: root/src/Data/Kademlia/Routing/Tree.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Kademlia/Routing/Tree.hs')
-rw-r--r--src/Data/Kademlia/Routing/Tree.hs56
1 files changed, 56 insertions, 0 deletions
diff --git a/src/Data/Kademlia/Routing/Tree.hs b/src/Data/Kademlia/Routing/Tree.hs
new file mode 100644
index 00000000..522bb0c2
--- /dev/null
+++ b/src/Data/Kademlia/Routing/Tree.hs
@@ -0,0 +1,56 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- Routing tree should contain key -> value pairs in this way:
9--
10-- * More keys that near to our node key, and less keys that far
11-- from our node key.
12--
13-- * Tree might be saturated. If this happen we can only update
14-- buckets, but we can't add new buckets.
15--
16-- Instead of using ordinary binary tree and keep track is it
17-- following restrictions above (that's somewhat non-trivial) we
18-- store distance -> value keys. This lead to simple data structure
19-- that actually isomorphic to non-empty list. So we first map our
20-- keys to distances using our node ID and store them in tree. When
21-- we need to extract a pair we map distances to keys back, again
22-- using our node ID. This normalization happen in routing table.
23--
24module Data.Kademlia.Routing.Tree
25 ( Tree, empty, insert
26 ) where
27
28import Control.Applicative hiding (empty)
29import Data.Bits
30
31import Data.Kademlia.Routing.Bucket (Bucket, split, isFull)
32import qualified Data.Kademlia.Routing.Bucket as Bucket
33
34
35
36data Tree k v
37 = Tip (Bucket k v)
38 | Bin (Tree k v) (Bucket k v)
39
40empty :: Int -> Tree k v
41empty = Tip . Bucket.empty
42
43insert :: Applicative f
44 => Bits k
45 => (v -> f Bool)
46 -> (k, v) -> Tree k v -> f (Tree k v)
47insert ping (k, v) = go 0
48 where
49 go n (Tip bucket)
50 | isFull bucket, (near, far) <- split n bucket
51 = pure (Tip near `Bin` far)
52 | otherwise = Tip <$> Bucket.insert ping (k, v) bucket
53
54 go n (Bin near far)
55 | k `testBit` n = Bin <$> pure near <*> Bucket.insert ping (k, v) far
56 | otherwise = Bin <$> go (succ n) near <*> pure far