diff options
Diffstat (limited to 'src/Data/Kademlia/Routing/Bucket.hs')
-rw-r--r-- | src/Data/Kademlia/Routing/Bucket.hs | 139 |
1 files changed, 0 insertions, 139 deletions
diff --git a/src/Data/Kademlia/Routing/Bucket.hs b/src/Data/Kademlia/Routing/Bucket.hs deleted file mode 100644 index 8d7f3e50..00000000 --- a/src/Data/Kademlia/Routing/Bucket.hs +++ /dev/null | |||
@@ -1,139 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam T. 2013 | ||
3 | -- License : MIT | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- Bucket is used to | ||
9 | -- | ||
10 | -- Bucket is kept sorted by time last seen — least-recently seen | ||
11 | -- node at the head, most-recently seen at the tail. Reason: when we | ||
12 | -- insert a node into the bucket we first filter nodes with smaller | ||
13 | -- lifetime since they more likely leave network and we more likely | ||
14 | -- don't reach list end. This should reduce list traversal, we don't | ||
15 | -- need to reverse list in insertion routines. | ||
16 | -- | ||
17 | -- Bucket is also limited in its length — thus it's called k-bucket. | ||
18 | -- When bucket becomes full we should split it in two lists by | ||
19 | -- current span bit. Span bit is defined by depth in the routing | ||
20 | -- table tree. Size of the bucket should be choosen such that it's | ||
21 | -- very unlikely that all nodes in bucket fail within an hour of | ||
22 | -- each other. | ||
23 | -- | ||
24 | {-# LANGUAGE RecordWildCards #-} | ||
25 | module Data.Kademlia.Routing.Bucket | ||
26 | ( Bucket(maxSize, kvs) | ||
27 | |||
28 | -- * Query | ||
29 | , size, isFull, member | ||
30 | |||
31 | -- * Construction | ||
32 | , empty, singleton | ||
33 | |||
34 | -- * Modification | ||
35 | , enlarge, split, insert | ||
36 | |||
37 | -- * Defaults | ||
38 | , defaultBucketSize | ||
39 | ) where | ||
40 | |||
41 | import Control.Applicative hiding (empty) | ||
42 | import Data.Bits | ||
43 | import Data.List as L hiding (insert) | ||
44 | |||
45 | |||
46 | type Size = Int | ||
47 | |||
48 | data Bucket k v = Bucket { | ||
49 | -- | We usually use equally sized buckets in the all routing table | ||
50 | -- so keeping max size in each bucket lead to redundancy. Altrough | ||
51 | -- it allow us to use some interesting schemes in route tree. | ||
52 | maxSize :: Size | ||
53 | |||
54 | -- | Key -> value pairs as described above. | ||
55 | -- Each key in a given bucket should be unique. | ||
56 | , kvs :: [(k, v)] | ||
57 | } | ||
58 | |||
59 | -- | Gives /current/ size of bucket. | ||
60 | -- | ||
61 | -- forall bucket. size bucket <= maxSize bucket | ||
62 | -- | ||
63 | size :: Bucket k v -> Size | ||
64 | size = L.length . kvs | ||
65 | |||
66 | isFull :: Bucket k v -> Bool | ||
67 | isFull Bucket {..} = L.length kvs == maxSize | ||
68 | |||
69 | member :: Eq k => k -> Bucket k v -> Bool | ||
70 | member k = elem k . map fst . kvs | ||
71 | |||
72 | empty :: Size -> Bucket k v | ||
73 | empty s = Bucket (max 0 s) [] | ||
74 | |||
75 | singleton :: Size -> k -> v -> Bucket k v | ||
76 | singleton s k v = Bucket (max 1 s) [(k, v)] | ||
77 | |||
78 | |||
79 | -- | Increase size of a given bucket. | ||
80 | enlarge :: Size -> Bucket k v -> Bucket k v | ||
81 | enlarge additional b = b { maxSize = maxSize b + additional } | ||
82 | |||
83 | split :: Bits k => Int -> Bucket k v -> (Bucket k v, Bucket k v) | ||
84 | split index Bucket {..} = | ||
85 | let (far, near) = partition spanBit kvs | ||
86 | in (Bucket maxSize near, Bucket maxSize far) | ||
87 | where | ||
88 | spanBit = (`testBit` index) . fst | ||
89 | |||
90 | |||
91 | -- move elem to the end in one traversal | ||
92 | moveToEnd :: Eq k => (k, v) -> Bucket k v -> Bucket k v | ||
93 | moveToEnd kv@(k, _) b = b { kvs = go (kvs b) } | ||
94 | where | ||
95 | go [] = [] | ||
96 | go (x : xs) | ||
97 | | fst x == k = xs ++ [kv] | ||
98 | | otherwise = x : go xs | ||
99 | |||
100 | insertToEnd :: (k, v) -> Bucket k v -> Bucket k v | ||
101 | insertToEnd kv b = b { kvs = kvs b ++ [kv] } | ||
102 | |||
103 | -- | * If the info already exists in bucket then move it to the end. | ||
104 | -- | ||
105 | -- * If bucket is not full then insert the info to the end. | ||
106 | -- | ||
107 | -- * If bucket is full then ping the least recently seen node. | ||
108 | -- Here we have a choice: | ||
109 | -- | ||
110 | -- If node respond then move it the end and discard node | ||
111 | -- we want to insert. | ||
112 | -- | ||
113 | -- If not remove it from the bucket and add the | ||
114 | -- (we want to insert) node to the end. | ||
115 | -- | ||
116 | insert :: Applicative f => Eq k | ||
117 | => (v -> f Bool) -- ^ Ping RPC | ||
118 | -> (k, v) -> Bucket k v -> f (Bucket k v) | ||
119 | |||
120 | insert ping new bucket@(Bucket {..}) | ||
121 | | fst new `member` bucket = pure (new `moveToEnd` bucket) | ||
122 | | size bucket < maxSize = pure (new `insertToEnd` bucket) | ||
123 | | least : rest <- kvs = | ||
124 | let select alive = if alive then least else new | ||
125 | mk most = Bucket maxSize (rest ++ [most]) | ||
126 | in mk . select <$> ping (snd least) | ||
127 | where | ||
128 | -- | otherwise = pure bucket | ||
129 | -- WARN: or maybe error "insertBucket: max size should not be 0" ? | ||
130 | |||
131 | lookup :: k -> Bucket k v -> Maybe v | ||
132 | lookup = undefined | ||
133 | |||
134 | closest :: Int -> k -> Bucket k v -> [(k, v)] | ||
135 | closest = undefined | ||
136 | |||
137 | -- | Most clients use this value for maximum bucket size. | ||
138 | defaultBucketSize :: Int | ||
139 | defaultBucketSize = 20 | ||