summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT/Routing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/DHT/Routing.hs')
-rw-r--r--src/Network/BitTorrent/DHT/Routing.hs49
1 files changed, 34 insertions, 15 deletions
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
index fd2197f0..a007c279 100644
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ b/src/Network/BitTorrent/DHT/Routing.hs
@@ -12,7 +12,6 @@
12module Network.BitTorrent.DHT.Routing 12module Network.BitTorrent.DHT.Routing
13 ( -- * Routing table 13 ( -- * Routing table
14 Table 14 Table
15 , BucketCount
16 15
17 -- * Routing 16 -- * Routing
18 , Timestamp 17 , Timestamp
@@ -35,15 +34,18 @@ module Network.BitTorrent.DHT.Routing
35import Control.Applicative hiding (empty) 34import Control.Applicative hiding (empty)
36import Control.Arrow 35import Control.Arrow
37import Control.Monad 36import Control.Monad
37import Data.Function
38import Data.List as L hiding (insert) 38import Data.List as L hiding (insert)
39import Data.Maybe 39import Data.Maybe
40import Data.Function 40import Data.Monoid
41import Data.PSQueue as PSQ 41import Data.PSQueue as PSQ
42import Data.Serialize as S hiding (Result, Done) 42import Data.Serialize as S hiding (Result, Done)
43import Data.Time 43import Data.Time
44import Data.Time.Clock.POSIX 44import Data.Time.Clock.POSIX
45import Data.Word 45import Data.Word
46import GHC.Generics 46import GHC.Generics
47import Text.PrettyPrint as PP hiding ((<>))
48import Text.PrettyPrint.Class
47 49
48import Data.Torrent.InfoHash 50import Data.Torrent.InfoHash
49import Network.BitTorrent.Core 51import Network.BitTorrent.Core
@@ -95,12 +97,14 @@ type Timestamp = POSIXTime
95data Routing ip result 97data Routing ip result
96 = Full result 98 = Full result
97 | Done (Timestamp -> result) 99 | Done (Timestamp -> result)
100 | GetTime ( Timestamp -> Routing ip result)
98 | Refresh NodeId (([NodeInfo ip], Timestamp) -> Routing ip result) 101 | Refresh NodeId (([NodeInfo ip], Timestamp) -> Routing ip result)
99 | NeedPing (NodeAddr ip) (Maybe Timestamp -> Routing ip result) 102 | NeedPing (NodeAddr ip) (Maybe Timestamp -> Routing ip result)
100 103
101instance Functor (Routing ip) where 104instance Functor (Routing ip) where
102 fmap f (Full r) = Full ( f r) 105 fmap f (Full r) = Full ( f r)
103 fmap f (Done r) = Done ( f . r) 106 fmap f (Done r) = Done ( f . r)
107 fmap f (GetTime g) = GetTime (fmap f . g)
104 fmap f (Refresh addr g) = Refresh addr (fmap f . g) 108 fmap f (Refresh addr g) = Refresh addr (fmap f . g)
105 fmap f (NeedPing addr g) = NeedPing addr (fmap f . g) 109 fmap f (NeedPing addr g) = NeedPing addr (fmap f . g)
106 110
@@ -114,6 +118,10 @@ runRouting ping_node find_nodes timestamper = go
114 where 118 where
115 go (Full r) = return r 119 go (Full r) = return r
116 go (Done f) = liftM f timestamper 120 go (Done f) = liftM f timestamper
121 go (GetTime f) = do
122 t <- timestamper
123 go (f t)
124
117 go (NeedPing addr f) = do 125 go (NeedPing addr f) = do
118 pong <- ping_node addr 126 pong <- ping_node addr
119 if pong 127 if pong
@@ -171,7 +179,7 @@ leastRecently = minView
171 179
172-- | Update interval, in seconds. 180-- | Update interval, in seconds.
173delta :: NominalDiffTime 181delta :: NominalDiffTime
174delta = 15 182delta = 15 * 60
175 183
176-- | Max bucket size, in nodes. 184-- | Max bucket size, in nodes.
177type Alpha = Int 185type Alpha = Int
@@ -179,15 +187,16 @@ type Alpha = Int
179defaultAlpha :: Int 187defaultAlpha :: Int
180defaultAlpha = 8 188defaultAlpha = 8
181 189
182insertNode :: Eq ip => NodeInfo ip -> Bucket ip -> ip `Routing` Bucket ip 190insertBucket :: Eq ip => Timestamp -> NodeInfo ip -> Bucket ip
183insertNode info bucket 191 -> ip `Routing` Bucket ip
192insertBucket curTime info bucket
184 -- just update timestamp if a node is already in bucket 193 -- just update timestamp if a node is already in bucket
185 | Just _ <- PSQ.lookup info bucket 194 | Just _ <- PSQ.lookup info bucket
186 = Done $ \ t -> PSQ.insertWith max info t bucket 195 = Done $ \ t -> PSQ.insertWith max info t bucket
187 196
188 -- update the all bucket if it is too outdated 197 -- update the all bucket if it is too outdated
189 | Just (NodeInfo {..} :-> lastSeen) <- lastChanged bucket 198 | Just (NodeInfo {..} :-> lastSeen) <- lastChanged bucket
190 , lastSeen > delta 199 , curTime - lastSeen > delta
191 = Refresh nodeId $ \ (infos, t) -> 200 = Refresh nodeId $ \ (infos, t) ->
192 insertNode info $ 201 insertNode info $
193 L.foldr (\ x -> PSQ.insertWith max x t) bucket infos 202 L.foldr (\ x -> PSQ.insertWith max x t) bucket infos
@@ -195,9 +204,12 @@ insertNode info bucket
195 -- update questionable nodes, if any; then try to insert our new node 204 -- update questionable nodes, if any; then try to insert our new node
196 -- this case can remove bad nodes from bucket, so we can insert a new one 205 -- this case can remove bad nodes from bucket, so we can insert a new one
197 | Just ((old @ NodeInfo {..} :-> leastSeen), rest) <- leastRecently bucket 206 | Just ((old @ NodeInfo {..} :-> leastSeen), rest) <- leastRecently bucket
198 , leastSeen > delta 207 , curTime - leastSeen > delta
199 = NeedPing nodeAddr $ insertNode info . maybe rest 208 = NeedPing nodeAddr $ \ mtime ->
200 (\ pong_time -> PSQ.insert old pong_time bucket) 209 insertNode info $
210 case mtime of
211 Nothing -> bucket
212 Just pongTime -> PSQ.insert old pongTime bucket
201 213
202 -- bucket is good, but not full => we can insert a new node 214 -- bucket is good, but not full => we can insert a new node
203 | PSQ.size bucket < defaultAlpha = Done (\ t -> PSQ.insert info t bucket) 215 | PSQ.size bucket < defaultAlpha = Done (\ t -> PSQ.insert info t bucket)
@@ -205,6 +217,9 @@ insertNode info bucket
205 -- bucket is full of good nodes => ignore new node 217 -- bucket is full of good nodes => ignore new node
206 | otherwise = Full bucket 218 | otherwise = Full bucket
207 219
220insertNode :: Eq ip => NodeInfo ip -> Bucket ip -> ip `Routing` Bucket ip
221insertNode info bucket = GetTime $ \ curTime -> insertBucket curTime info bucket
222
208type BitIx = Word 223type BitIx = Word
209 224
210split :: Eq ip => BitIx -> Bucket ip -> (Bucket ip, Bucket ip) 225split :: Eq ip => BitIx -> Bucket ip -> (Bucket ip, Bucket ip)
@@ -216,13 +231,11 @@ split i = (PSQ.fromList *** PSQ.fromList) . partition spanBit . PSQ.toList
216-- Table 231-- Table
217-----------------------------------------------------------------------} 232-----------------------------------------------------------------------}
218 233
219type BucketCount = Word 234defaultBucketCount :: Int
220
221defaultBucketCount :: BucketCount
222defaultBucketCount = 20 235defaultBucketCount = 20
223 236
224data Table ip 237data Table ip
225 = Tip NodeId BucketCount (Bucket ip) 238 = Tip NodeId Int (Bucket ip)
226 | Zero (Table ip) (Bucket ip) 239 | Zero (Table ip) (Bucket ip)
227 | One (Bucket ip) (Table ip) 240 | One (Bucket ip) (Table ip)
228 deriving Generic 241 deriving Generic
@@ -236,6 +249,12 @@ instance Serialize NominalDiffTime where
236-- since it is included in routing table. 249-- since it is included in routing table.
237instance (Eq ip, Serialize ip) => Serialize (Table ip) 250instance (Eq ip, Serialize ip) => Serialize (Table ip)
238 251
252instance Pretty (Table ip) where
253 pretty t =
254 "size = " <> PP.int (Network.BitTorrent.DHT.Routing.size t) <>
255 ", depth = " <> PP.int (depth t)
256
257
239nullTable :: Eq ip => NodeId -> Table ip 258nullTable :: Eq ip => NodeId -> Table ip
240nullTable nid = Tip nid defaultBucketCount PSQ.empty 259nullTable nid = Tip nid defaultBucketCount PSQ.empty
241 260
@@ -253,7 +272,7 @@ size = go
253 go (One bucket t ) = PSQ.size bucket + go t 272 go (One bucket t ) = PSQ.size bucket + go t
254 273
255-- | Get number of buckets in the table. 274-- | Get number of buckets in the table.
256depth :: Table ip -> BucketCount 275depth :: Table ip -> Int
257depth = go 276depth = go
258 where 277 where
259 go (Tip _ _ _) = 1 278 go (Tip _ _ _) = 1
@@ -291,7 +310,7 @@ kclosestHash k nid t = kclosest k (coerseId nid) t
291-- Routing 310-- Routing
292-----------------------------------------------------------------------} 311-----------------------------------------------------------------------}
293 312
294splitTip :: Eq ip => NodeId -> BucketCount -> BitIx -> Bucket ip -> Table ip 313splitTip :: Eq ip => NodeId -> Int -> BitIx -> Bucket ip -> Table ip
295splitTip nid n i bucket 314splitTip nid n i bucket
296 | testIdBit nid i = (One zeros (Tip nid (pred n) ones)) 315 | testIdBit nid i = (One zeros (Tip nid (pred n) ones))
297 | otherwise = (Zero (Tip nid (pred n) zeros) ones) 316 | otherwise = (Zero (Tip nid (pred n) zeros) ones)