summaryrefslogtreecommitdiff
path: root/src/Data/Kademlia/Routing/Table.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Data/Kademlia/Routing/Table.hs')
-rw-r--r--src/Data/Kademlia/Routing/Table.hs182
1 files changed, 0 insertions, 182 deletions
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 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8{-# LANGUAGE RecordWildCards #-}
9module Data.Kademlia.Routing.Table
10 ( Table(nodeID)
11 ) where
12
13import Control.Applicative hiding (empty)
14import Data.Bits
15import Data.List as L hiding (insert)
16import Data.Maybe
17
18{-----------------------------------------------------------------------
19 Bucket
20-----------------------------------------------------------------------}
21
22type Size = Int
23
24-- | Bucket is kept sorted by time last seen — least-recently seen
25-- node at the head, most-recently seen at the tail. Reason: when we
26-- insert a node into the bucket we first filter nodes with smaller
27-- lifetime since they more likely leave network and we more likely
28-- don't reach list end. This should reduce list traversal, we don't
29-- need to reverse list in insertion routines.
30--
31-- Bucket is also limited in its length — thus it's called k-bucket.
32-- When bucket becomes full we should split it in two lists by
33-- current span bit. Span bit is defined by depth in the routing
34-- table tree. Size of the bucket should be choosen such that it's
35-- very unlikely that all nodes in bucket fail within an hour of
36-- each other.
37--
38data Bucket = Empty
39 | Cons {-# UNPACK #-} !NodeAddr {-# UNPACK #-} !TimeStamp !Bucket
40
41-- | Gives /current/ size of bucket.
42--
43-- forall bucket. size bucket <= maxSize bucket
44--
45size :: Bucket k v -> Size
46size = L.length . kvs
47
48isFull :: Bucket k v -> Bool
49isFull Bucket {..} = L.length kvs == maxSize
50
51member :: Eq k => k -> Bucket k v -> Bool
52member k = elem k . map fst . kvs
53
54empty :: Size -> Bucket k v
55empty s = Bucket (max 0 s) []
56
57singleton :: Size -> k -> v -> Bucket k v
58singleton s k v = Bucket (max 1 s) [(k, v)]
59
60
61-- | Increase size of a given bucket.
62enlarge :: Size -> Bucket k v -> Bucket k v
63enlarge additional b = b { maxSize = maxSize b + additional }
64
65split :: Bits k => Int -> Bucket k v -> (Bucket k v, Bucket k v)
66split index Bucket {..} =
67 let (far, near) = partition spanBit kvs
68 in (Bucket maxSize near, Bucket maxSize far)
69 where
70 spanBit = (`testBit` index) . fst
71
72
73-- move elem to the end in one traversal
74moveToEnd :: Eq k => (k, v) -> Bucket k v -> Bucket k v
75moveToEnd kv@(k, _) b = b { kvs = go (kvs b) }
76 where
77 go [] = []
78 go (x : xs)
79 | fst x == k = xs ++ [kv]
80 | otherwise = x : go xs
81
82insertToEnd :: (k, v) -> Bucket k v -> Bucket k v
83insertToEnd kv b = b { kvs = kvs b ++ [kv] }
84
85-- | * If the info already exists in bucket then move it to the end.
86--
87-- * If bucket is not full then insert the info to the end.
88--
89-- * If bucket is full then ping the least recently seen node.
90-- Here we have a choice:
91--
92-- If node respond then move it the end and discard node
93-- we want to insert.
94--
95-- If not remove it from the bucket and add the
96-- (we want to insert) node to the end.
97--
98insert :: Applicative f => Eq k
99 => (v -> f Bool) -- ^ Ping RPC
100 -> (k, v) -> Bucket k v -> f (Bucket k v)
101
102insert ping new bucket@(Bucket {..})
103 | fst new `member` bucket = pure (new `moveToEnd` bucket)
104 | size bucket < maxSize = pure (new `insertToEnd` bucket)
105 | least : rest <- kvs =
106 let select alive = if alive then least else new
107 mk most = Bucket maxSize (rest ++ [most])
108 in mk . select <$> ping (snd least)
109 where
110-- | otherwise = pure bucket
111 -- WARN: or maybe error "insertBucket: max size should not be 0" ?
112
113lookup :: k -> Bucket k v -> Maybe v
114lookup = undefined
115
116closest :: Int -> k -> Bucket k v -> [(k, v)]
117closest = undefined
118
119-- | Most clients use this value for maximum bucket size.
120defaultBucketSize :: Int
121defaultBucketSize = 20
122
123{-----------------------------------------------------------------------
124 Tree
125-----------------------------------------------------------------------}
126
127-- | Routing tree should contain key -> value pairs in this way:
128--
129-- * More keys that near to our node key, and less keys that far
130-- from our node key.
131--
132-- * Tree might be saturated. If this happen we can only update
133-- buckets, but we can't add new buckets.
134--
135-- Instead of using ordinary binary tree and keep track is it
136-- following restrictions above (that's somewhat non-trivial) we
137-- store distance -> value keys. This lead to simple data structure
138-- that actually isomorphic to non-empty list. So we first map our
139-- keys to distances using our node ID and store them in tree. When
140-- we need to extract a pair we map distances to keys back, again
141-- using our node ID. This normalization happen in routing table.
142--
143data Tree k v
144 = Tip (Bucket k v)
145 | Bin (Tree k v) (Bucket k v)
146
147empty :: Int -> Tree k v
148empty = Tip . Bucket.empty
149
150insert :: Applicative f => Bits k
151 => (v -> f Bool) -> (k, v) -> Tree k v -> f (Tree k v)
152insert ping (k, v) = go 0
153 where
154 go n (Tip bucket)
155 | isFull bucket, (near, far) <- split n bucket
156 = pure (Tip near `Bin` far)
157 | otherwise = Tip <$> Bucket.insert ping (k, v) bucket
158
159 go n (Bin near far)
160 | k `testBit` n = Bin <$> pure near <*> Bucket.insert ping (k, v) far
161 | otherwise = Bin <$> go (succ n) near <*> pure far
162
163{-----------------------------------------------------------------------
164 Table
165-----------------------------------------------------------------------}
166
167data Table k v = Table {
168 routeTree :: Tree k v
169
170 -- | Set degree of parallelism in node lookup calls.
171 , alpha :: Int
172 , nodeID :: k
173 }
174
175--insert :: NodeID -> Table -> Table
176--insert x t = undefined
177
178--closest :: InfoHash -> Table -> [NodeID]
179--closest = undefined
180
181-- TODO table serialization: usually we need to save table between
182-- target program executions for bootstrapping