summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Kademlia/Routing/Bucket.hs139
-rw-r--r--src/Data/Kademlia/Routing/Table.hs50
-rw-r--r--src/Data/Kademlia/Routing/Tree.hs57
-rw-r--r--src/Data/Kademlia/RoutingTable.hs28
-rw-r--r--src/Network/BitTorrent/Peer/Addr.hs2
-rw-r--r--src/Network/DHT/Kademlia.hs21
6 files changed, 256 insertions, 41 deletions
diff --git a/src/Data/Kademlia/Routing/Bucket.hs b/src/Data/Kademlia/Routing/Bucket.hs
new file mode 100644
index 00000000..8d7f3e50
--- /dev/null
+++ b/src/Data/Kademlia/Routing/Bucket.hs
@@ -0,0 +1,139 @@
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 #-}
25module 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
41import Control.Applicative hiding (empty)
42import Data.Bits
43import Data.List as L hiding (insert)
44
45
46type Size = Int
47
48data 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--
63size :: Bucket k v -> Size
64size = L.length . kvs
65
66isFull :: Bucket k v -> Bool
67isFull Bucket {..} = L.length kvs == maxSize
68
69member :: Eq k => k -> Bucket k v -> Bool
70member k = elem k . map fst . kvs
71
72empty :: Size -> Bucket k v
73empty s = Bucket (max 0 s) []
74
75singleton :: Size -> k -> v -> Bucket k v
76singleton s k v = Bucket (max 1 s) [(k, v)]
77
78
79-- | Increase size of a given bucket.
80enlarge :: Size -> Bucket k v -> Bucket k v
81enlarge additional b = b { maxSize = maxSize b + additional }
82
83split :: Bits k => Int -> Bucket k v -> (Bucket k v, Bucket k v)
84split 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
92moveToEnd :: Eq k => (k, v) -> Bucket k v -> Bucket k v
93moveToEnd 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
100insertToEnd :: (k, v) -> Bucket k v -> Bucket k v
101insertToEnd 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--
116insert :: Applicative f => Eq k
117 => (v -> f Bool) -- ^ Ping RPC
118 -> (k, v) -> Bucket k v -> f (Bucket k v)
119
120insert 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
131lookup :: k -> Bucket k v -> Maybe v
132lookup = undefined
133
134closest :: Int -> k -> Bucket k v -> [(k, v)]
135closest = undefined
136
137-- | Most clients use this value for maximum bucket size.
138defaultBucketSize :: Int
139defaultBucketSize = 20
diff --git a/src/Data/Kademlia/Routing/Table.hs b/src/Data/Kademlia/Routing/Table.hs
new file mode 100644
index 00000000..056692f3
--- /dev/null
+++ b/src/Data/Kademlia/Routing/Table.hs
@@ -0,0 +1,50 @@
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 table used to lookup . Internally it uses not balanced tree
9--
10-- TODO write module synopsis
11module Data.Kademlia.Routing.Table
12 ( -- ContactInfo
13-- , Table
14 ) where
15
16import Control.Applicative
17import Data.ByteString
18import Data.List as L
19import Data.Maybe
20
21import Network.BitTorrent.Peer
22
23{-
24type NodeID = ByteString
25type InfoHash = ByteString
26
27data ContactInfo = ContactInfo {
28 peerAddr :: PeerAddr
29 , nodeID :: NodeID
30 } deriving (Show, Eq)
31
32
33type Distance = NodeID
34
35-- |
36data Table = Table {
37 routeTree :: Tree
38 , maxBucketSize :: Int
39 }
40
41insert :: NodeID -> Table -> Table
42insert x t = undefined
43
44closest :: InfoHash -> Table -> [NodeID]
45closest = undefined
46
47
48-- TODO table serialization: usually we need to save table between
49-- target program executions for bootstrapping
50-} \ No newline at end of file
diff --git a/src/Data/Kademlia/Routing/Tree.hs b/src/Data/Kademlia/Routing/Tree.hs
new file mode 100644
index 00000000..f415d1e1
--- /dev/null
+++ b/src/Data/Kademlia/Routing/Tree.hs
@@ -0,0 +1,57 @@
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 ( empty
26 ,
27 ) where
28
29import Control.Applicative hiding (empty)
30import Data.Bits
31
32import Data.Kademlia.Routing.Bucket (Bucket, split, isFull)
33import qualified Data.Kademlia.Routing.Bucket as Bucket
34
35
36
37data Tree k v
38 = Tip (Bucket k v)
39 | Bin (Tree k v) (Bucket k v)
40
41empty :: Int -> Tree k v
42empty = Tip . Bucket.empty
43
44insert :: Applicative f
45 => Bits k
46 => (v -> f Bool)
47 -> (k, v) -> Tree k v -> f (Tree k v)
48insert ping (k, v) = go 0
49 where
50 go n (Tip bucket)
51 | isFull bucket, (near, far) <- split n bucket
52 = pure (Tip near `Bin` far)
53 | otherwise = Tip <$> Bucket.insert ping (k, v) bucket
54
55 go n (Bin near far)
56 | k `testBit` n = Bin <$> pure near <*> Bucket.insert ping (k, v) far
57 | otherwise = Bin <$> go (succ n) near <*> pure far
diff --git a/src/Data/Kademlia/RoutingTable.hs b/src/Data/Kademlia/RoutingTable.hs
deleted file mode 100644
index 98e15a0b..00000000
--- a/src/Data/Kademlia/RoutingTable.hs
+++ /dev/null
@@ -1,28 +0,0 @@
1module Data.Kademlia.RoutingTable
2 (
3 ) where
4
5import Data.ByteString
6
7type NodeID = ByteString
8type InfoHash = ByteString
9
10type Bucket = [NodeID]
11
12data Tree
13 = Tip Bucket
14 | Bin Table Table
15
16data Table = Table {
17 tree :: Tree
18 , bucketSize :: Int
19 }
20
21closest :: InfoHash -> Table -> [NodeID]
22closest = undefined
23
24insert :: NodeID -> Table -> Table
25insert x t = undefined
26
27-- TODO table serialization: usually we need to save table between
28-- target program executions
diff --git a/src/Network/BitTorrent/Peer/Addr.hs b/src/Network/BitTorrent/Peer/Addr.hs
index 0e6fcfb9..1c2ac2eb 100644
--- a/src/Network/BitTorrent/Peer/Addr.hs
+++ b/src/Network/BitTorrent/Peer/Addr.hs
@@ -28,7 +28,7 @@ data PeerAddr = PeerAddr {
28 peerID :: Maybe PeerID 28 peerID :: Maybe PeerID
29 , peerIP :: HostAddress 29 , peerIP :: HostAddress
30 , peerPort :: PortNumber 30 , peerPort :: PortNumber
31 } deriving Show 31 } deriving (Show, Eq)
32 32
33instance BEncodable PortNumber where 33instance BEncodable PortNumber where
34 toBEncode = toBEncode . fromEnum 34 toBEncode = toBEncode . fromEnum
diff --git a/src/Network/DHT/Kademlia.hs b/src/Network/DHT/Kademlia.hs
index d5418beb..bc03ac16 100644
--- a/src/Network/DHT/Kademlia.hs
+++ b/src/Network/DHT/Kademlia.hs
@@ -1,4 +1,3 @@
1-- TODO move to Network.DHT.Kademlia
2{-# LANGUAGE OverloadedStrings #-} 1{-# LANGUAGE OverloadedStrings #-}
3module Network.DHT.Kademlia 2module Network.DHT.Kademlia
4 ( 3 (
@@ -8,7 +7,8 @@ import Data.ByteString
8import Network 7import Network
9import Remote.KRPC 8import Remote.KRPC
10 9
11 10import Data.Kademlia.Routing.Table
11{-
12 12
13-- | Global unique identifier of the node. Size of the identifier 13-- | Global unique identifier of the node. Size of the identifier
14-- should(!) be equal to the size of DHT keys. This limitation arises 14-- should(!) be equal to the size of DHT keys. This limitation arises
@@ -32,11 +32,7 @@ type Token = ByteString
32ping :: Method NodeID NodeID 32ping :: Method NodeID NodeID
33ping = method "ping" ["id"] ["id"] 33ping = method "ping" ["id"] ["id"]
34 34
35type PeerContact = () 35
36data NodeContact = NodeContact {
37 peerContact :: PeerContact
38 , nodeID :: NodeID
39 }
40 36
41-- | Used to lookup peer ID from node ID. 37-- | Used to lookup peer ID from node ID.
42-- 38--
@@ -47,16 +43,16 @@ find_node = method "find_node" ["id", "target"] ["id", "nodes"]
47announce_peer :: Method (NodeID, InfoHash, PortNumber, Token) NodeID 43announce_peer :: Method (NodeID, InfoHash, PortNumber, Token) NodeID
48announce_peer = undefined 44announce_peer = undefined
49 45
46-- WARN is the 'system' random suitable for this?
47-- | Generate random NodeID used for the entire session.
48-- Distribution of ID's should be as uniform as possible.
49--
50genNodeID :: IO NodeID 50genNodeID :: IO NodeID
51genNodeID = undefined 51genNodeID = randomIO
52 52
53{- 53{-
54type InfoHash = Int
55type Token = Int 54type Token = Int
56 55
57ping :: Method NodeId NodeId
58ping = method "ping" ["id"] ["id"]
59
60get_peers :: Method (NodeId :*: InfoHash) (NodeId, Token, NodeAddr :|: NodeAddr) 56get_peers :: Method (NodeId :*: InfoHash) (NodeId, Token, NodeAddr :|: NodeAddr)
61get_peers = method "get_peers" 57get_peers = method "get_peers"
62 ("id", "target") 58 ("id", "target")
@@ -65,4 +61,5 @@ get_peers = method "get_peers"
65 61
66 62
67 63
64-}
68-} \ No newline at end of file 65-} \ No newline at end of file