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.hs595
1 files changed, 0 insertions, 595 deletions
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
deleted file mode 100644
index 54c0f7c5..00000000
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ /dev/null
@@ -1,595 +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-- Every node maintains a routing table of known good nodes. The
9-- nodes in the routing table are used as starting points for
10-- queries in the DHT. Nodes from the routing table are returned in
11-- response to queries from other nodes.
12--
13-- For more info see:
14-- <http://www.bittorrent.org/beps/bep_0005.html#routing-table>
15--
16{-# LANGUAGE CPP #-}
17{-# LANGUAGE RecordWildCards #-}
18{-# LANGUAGE BangPatterns #-}
19{-# LANGUAGE ViewPatterns #-}
20{-# LANGUAGE TypeOperators #-}
21{-# LANGUAGE DeriveGeneric #-}
22{-# LANGUAGE ScopedTypeVariables #-}
23{-# LANGUAGE StandaloneDeriving, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
24{-# OPTIONS_GHC -fno-warn-orphans #-}
25module Network.BitTorrent.DHT.Routing
26 ( -- * Table
27 Table
28 , Info(..)
29
30 -- * Attributes
31 , BucketCount
32 , defaultBucketCount
33 , BucketSize
34 , defaultBucketSize
35 , NodeCount
36
37 -- * Query
38 , Network.BitTorrent.DHT.Routing.null
39 , Network.BitTorrent.DHT.Routing.full
40 , thisId
41 , shape
42 , Network.BitTorrent.DHT.Routing.size
43 , Network.BitTorrent.DHT.Routing.depth
44 , compatibleNodeId
45
46 -- * Lookup
47 , K
48 , defaultK
49 , TableKey (..)
50 , kclosest
51
52 -- * Construction
53 , Network.BitTorrent.DHT.Routing.nullTable
54 , Event(..)
55 , CheckPing(..)
56 , Network.BitTorrent.DHT.Routing.insert
57
58 -- * Conversion
59 , Network.BitTorrent.DHT.Routing.TableEntry
60 , Network.BitTorrent.DHT.Routing.toList
61
62 -- * Routing
63 , Timestamp
64 ) where
65
66import Control.Applicative as A
67import Control.Arrow
68import Control.Monad
69import Data.Function
70import Data.Functor.Identity
71import Data.List as L hiding (insert)
72import Data.Maybe
73import Data.Monoid
74import Data.Wrapper.PSQ as PSQ
75import Data.Serialize as S hiding (Result, Done)
76import qualified Data.Sequence as Seq
77import Data.Time
78import Data.Time.Clock.POSIX
79import Data.Word
80import GHC.Generics
81import Text.PrettyPrint as PP hiding ((<>))
82import Text.PrettyPrint.HughesPJClass (pPrint,Pretty)
83import qualified Data.ByteString as BS
84import Data.Bits
85
86import Network.BitTorrent.Address
87
88
89{-----------------------------------------------------------------------
90-- Routing monad
91-----------------------------------------------------------------------}
92
93-- | Last time the node was responding to our queries.
94--
95-- Not all nodes that we learn about are equal. Some are \"good\" and
96-- some are not. Many nodes using the DHT are able to send queries
97-- and receive responses, but are not able to respond to queries
98-- from other nodes. It is important that each node's routing table
99-- must contain only known good nodes. A good node is a node has
100-- responded to one of our queries within the last 15 minutes. A
101-- node is also good if it has ever responded to one of our queries
102-- and has sent us a query within the last 15 minutes. After 15
103-- minutes of inactivity, a node becomes questionable. Nodes become
104-- bad when they fail to respond to multiple queries in a row. Nodes
105-- that we know are good are given priority over nodes with unknown
106-- status.
107--
108type Timestamp = POSIXTime
109
110{-----------------------------------------------------------------------
111 Bucket
112-----------------------------------------------------------------------}
113-- TODO: add replacement cache to the bucket
114--
115-- When a k-bucket is full and a new node is discovered for that
116-- k-bucket, the least recently seen node in the k-bucket is
117-- PINGed. If the node is found to be still alive, the new node is
118-- place in a secondary list, a replacement cache. The replacement
119-- cache is used only if a node in the k-bucket stops responding. In
120-- other words: new nodes are used only when older nodes disappear.
121
122-- | Timestamp - last time this node is pinged.
123type NodeEntry dht ip u = Binding (NodeInfo dht ip u) Timestamp
124
125-- TODO instance Pretty where
126
127-- | Number of nodes in a bucket.
128type BucketSize = Int
129
130-- | Maximum number of 'NodeInfo's stored in a bucket. Most clients
131-- use this value.
132defaultBucketSize :: BucketSize
133defaultBucketSize = 8
134
135data QueueMethods m elem fifo = QueueMethods
136 { pushBack :: elem -> fifo -> m fifo
137 , popFront :: fifo -> m (Maybe elem, fifo)
138 , emptyQueue :: m fifo
139 }
140
141{-
142fromQ :: Functor m =>
143 ( a -> b )
144 -> ( b -> a )
145 -> QueueMethods m elem a
146 -> QueueMethods m elem b
147fromQ embed project QueueMethods{..} =
148 QueueMethods { pushBack = \e -> fmap embed . pushBack e . project
149 , popFront = fmap (second embed) . popFront . project
150 , emptyQueue = fmap embed emptyQueue
151 }
152-}
153
154seqQ :: QueueMethods Identity (NodeInfo dht ip u) (Seq.Seq (NodeInfo dht ip u))
155seqQ = QueueMethods
156 { pushBack = \e fifo -> pure (fifo Seq.|> e)
157 , popFront = \fifo -> case Seq.viewl fifo of
158 e Seq.:< fifo' -> pure (Just e, fifo')
159 Seq.EmptyL -> pure (Nothing, Seq.empty)
160 , emptyQueue = pure Seq.empty
161 }
162
163type BucketQueue dht ip u = Seq.Seq (NodeInfo dht ip u)
164
165bucketQ :: QueueMethods Identity (NodeInfo dht ip u) (BucketQueue dht ip u)
166bucketQ = seqQ
167
168-- | Bucket is also limited in its length — thus it's called k-bucket.
169-- When bucket becomes full, we should split it in two lists by
170-- current span bit. Span bit is defined by depth in the routing
171-- table tree. Size of the bucket should be choosen such that it's
172-- very unlikely that all nodes in bucket fail within an hour of
173-- each other.
174--
175data Bucket dht ip u = Bucket { bktNodes :: !(PSQ (NodeInfo dht ip u) Timestamp)
176 , bktQ :: !(BucketQueue dht ip u)
177 } deriving Generic
178
179deriving instance (Show ip, Show u, Show (NodeId dht)) => Show (Bucket dht ip u)
180
181
182getGenericNode :: ( Serialize (NodeId dht)
183 , Serialize ip
184 , Serialize u
185 ) => Get (NodeInfo dht ip u)
186getGenericNode = do
187 nid <- get
188 naddr <- get
189 u <- get
190 return NodeInfo
191 { nodeId = nid
192 , nodeAddr = naddr
193 , nodeAnnotation = u
194 }
195
196putGenericNode :: ( Serialize (NodeId dht)
197 , Serialize ip
198 , Serialize u
199 ) => NodeInfo dht ip u -> Put
200putGenericNode (NodeInfo nid naddr u) = do
201 put nid
202 put naddr
203 put u
204
205instance (Eq ip, Ord (NodeId dht), Serialize (NodeId dht), Serialize ip, Serialize u) => Serialize (Bucket dht ip u) where
206 get = Bucket . psqFromPairList <$> getListOf ( (,) <$> getGenericNode <*> get ) <*> pure (runIdentity $ emptyQueue bucketQ)
207 put = putListOf (\(ni,stamp) -> putGenericNode ni >> put stamp) . psqToPairList . bktNodes
208
209
210psqFromPairList :: (Ord p, Ord k) => [(k, p)] -> OrdPSQ k p ()
211psqFromPairList xs = PSQ.fromList $ map (\(a,b) -> a :-> b) xs
212
213psqToPairList :: OrdPSQ t t1 () -> [(t, t1)]
214psqToPairList psq = map (\(a :-> b) -> (a,b)) $ PSQ.toList psq
215
216-- | Update interval, in seconds.
217delta :: NominalDiffTime
218delta = 15 * 60
219
220-- | Should maintain a set of stable long running nodes.
221--
222-- Note: pings are triggerd only when a bucket is full.
223insertBucket :: (Eq ip, Alternative f, Ord (NodeId dht)) => Timestamp -> Event dht ip u -> Bucket dht ip u
224 -> f ([CheckPing dht ip u], Bucket dht ip u)
225insertBucket curTime (TryInsert info) bucket
226 -- just update timestamp if a node is already in bucket
227 | already_have
228 = pure ( [], map_ns $ PSQ.insertWith max info curTime )
229 -- bucket is good, but not full => we can insert a new node
230 | PSQ.size (bktNodes bucket) < defaultBucketSize
231 = pure ( [], map_ns $ PSQ.insert info curTime )
232 -- If there are any questionable nodes in the bucket have not been
233 -- seen in the last 15 minutes, the least recently seen node is
234 -- pinged. If any nodes in the bucket are known to have become bad,
235 -- then one is replaced by the new node in the next insertBucket
236 -- iteration.
237 | not (L.null stales)
238 = pure ( [CheckPing stales]
239 , bucket { -- Update timestamps so that we don't redundantly ping.
240 bktNodes = updateStamps curTime stales $ bktNodes bucket
241 -- Update queue with the pending NodeInfo in case of ping fail.
242 , bktQ = runIdentity $ pushBack bucketQ info $ bktQ bucket } )
243 -- When the bucket is full of good nodes, the new node is simply discarded.
244 -- We must return 'A.empty' here to ensure that bucket splitting happens
245 -- inside 'modifyBucket'.
246 | otherwise = A.empty
247 where
248 -- We (take 1) to keep a 1-to-1 correspondence between pending pings and
249 -- waiting nodes in the bktQ. This way, we don't have to worry about what
250 -- to do with failed pings for which there is no ready replacements.
251 stales = -- One stale:
252 do (n :-> t) <- maybeToList $ PSQ.findMin (bktNodes bucket)
253 guard (t < curTime - delta)
254 return n
255 -- All stale:
256 -- map key $ PSQ.atMost (curTime - delta) $ bktNodes bucket
257
258 already_have = maybe False (const True) $ PSQ.lookup info (bktNodes bucket)
259
260 map_ns f = bucket { bktNodes = f (bktNodes bucket) }
261 -- map_q f = bucket { bktQ = runIdentity $ f (bktQ bucket) }
262
263insertBucket curTime (PingResult bad_node got_response) bucket
264 = pure ([], Bucket (upd $ bktNodes bucket) popped)
265 where
266 (top, popped) = runIdentity $ popFront bucketQ (bktQ bucket)
267 upd | got_response = id
268 | Just info <- top = \nodes ->
269 fromMaybe nodes $ do
270 _ <- PSQ.lookup bad_node nodes -- Insert only if there's a removal.
271 let nodes' = PSQ.delete bad_node nodes
272 pure $ PSQ.insert info curTime nodes'
273 | otherwise = id
274
275updateStamps :: ( Eq ip
276 , Ord (NodeId dht)
277 ) => Timestamp -> [NodeInfo dht ip u] -> PSQ (NodeInfo dht ip u) Timestamp -> PSQ (NodeInfo dht ip u) Timestamp
278updateStamps curTime stales nodes = foldl' (\q n -> PSQ.insert n curTime q) nodes stales
279
280
281type BitIx = Word
282
283partitionQ :: Monad f => QueueMethods f elem b -> (elem -> Bool) -> b -> f (b, b)
284partitionQ imp test q0 = do
285 pass0 <- emptyQueue imp
286 fail0 <- emptyQueue imp
287 let flipfix a b f = fix f a b
288 flipfix q0 (pass0,fail0) $ \rec q qs -> do
289 (mb,q') <- popFront imp q
290 case mb of
291 Nothing -> return qs
292 Just e -> do qs' <- select (pushBack imp e) qs
293 rec q' qs'
294 where
295 select :: Functor f => (b -> f b) -> (b, b) -> f (b, b)
296 select f = if test e then \(a,b) -> flip (,) b <$> f a
297 else \(a,b) -> (,) a <$> f b
298
299split :: forall dht ip u.
300 ( Eq ip
301 , Ord (NodeId dht)
302 , FiniteBits (NodeId dht)
303 ) => BitIx -> Bucket dht ip u -> (Bucket dht ip u, Bucket dht ip u)
304split i b = (Bucket ns qs, Bucket ms rs)
305 where
306 (ns,ms) = (PSQ.fromList *** PSQ.fromList) . partition (spanBit . key) . PSQ.toList $ bktNodes b
307 (qs,rs) = runIdentity $ partitionQ bucketQ spanBit $ bktQ b
308 {-
309 spanBit :: forall (dht :: * -> *) addr u.
310 FiniteBits (Network.DatagramServer.Types.NodeId dht) =>
311 NodeInfo dht addr u -> Bool
312 -}
313 spanBit :: NodeInfo dht addr u -> Bool
314 spanBit entry = testIdBit (nodeId entry) i
315
316{-----------------------------------------------------------------------
317-- Table
318-----------------------------------------------------------------------}
319
320-- | Number of buckets in a routing table.
321type BucketCount = Int
322
323defaultBucketCount :: BucketCount
324defaultBucketCount = 20
325
326data Info dht ip u = Info
327 { myBuckets :: Table dht ip u
328 , myNodeId :: NodeId dht
329 , myAddress :: SockAddr
330 }
331 deriving Generic
332
333deriving instance (Eq ip, Eq u, Eq (NodeId dht)) => Eq (Info dht ip u)
334deriving instance (Show ip, Show u, Show (NodeId dht)) => Show (Info dht ip u)
335
336-- instance (Eq ip, Serialize ip) => Serialize (Info ip)
337
338-- | The routing table covers the entire 'NodeId' space from 0 to 2 ^
339-- 160. The routing table is subdivided into 'Bucket's that each cover
340-- a portion of the space. An empty table has one bucket with an ID
341-- space range of @min = 0, max = 2 ^ 160@. When a node with ID \"N\"
342-- is inserted into the table, it is placed within the bucket that has
343-- @min <= N < max@. An empty table has only one bucket so any node
344-- must fit within it. Each bucket can only hold 'K' nodes, currently
345-- eight, before becoming 'Full'. When a bucket is full of known good
346-- nodes, no more nodes may be added unless our own 'NodeId' falls
347-- within the range of the 'Bucket'. In that case, the bucket is
348-- replaced by two new buckets each with half the range of the old
349-- bucket and the nodes from the old bucket are distributed among the
350-- two new ones. For a new table with only one bucket, the full bucket
351-- is always split into two new buckets covering the ranges @0..2 ^
352-- 159@ and @2 ^ 159..2 ^ 160@.
353--
354data Table dht ip u
355 -- most nearest bucket
356 = Tip (NodeId dht) BucketCount (Bucket dht ip u)
357
358 -- left biased tree branch
359 | Zero (Table dht ip u) (Bucket dht ip u)
360
361 -- right biased tree branch
362 | One (Bucket dht ip u) (Table dht ip u)
363 deriving Generic
364
365instance (Eq ip, Eq (NodeId dht)) => Eq (Table dht ip u) where
366 (==) = (==) `on` Network.BitTorrent.DHT.Routing.toList
367
368instance Serialize NominalDiffTime where
369 put = putWord32be . fromIntegral . fromEnum
370 get = (toEnum . fromIntegral) <$> getWord32be
371
372deriving instance (Show ip, Show u, Show (NodeId dht)) => Show (Table dht ip u)
373
374-- | Normally, routing table should be saved between invocations of
375-- the client software. Note that you don't need to store /this/
376-- 'NodeId' since it is already included in routing table.
377instance (Eq ip, Serialize ip, Ord (NodeId dht), Serialize (NodeId dht), Serialize u) => Serialize (Table dht ip u)
378
379-- | Shape of the table.
380instance Pretty (Table dht ip u) where
381 pPrint t
382 | bucketCount < 6 = hcat $ punctuate ", " $ L.map PP.int ss
383 | otherwise = brackets $
384 PP.int (L.sum ss) <> " nodes, " <>
385 PP.int bucketCount <> " buckets"
386 where
387 bucketCount = L.length ss
388 ss = shape t
389
390-- | Empty table with specified /spine/ node id.
391nullTable :: Eq ip => NodeId dht -> BucketCount -> Table dht ip u
392nullTable nid n = Tip nid (bucketCount (pred n)) (Bucket PSQ.empty (runIdentity $ emptyQueue bucketQ))
393 where
394 bucketCount x = max 0 (min 159 x)
395
396-- | Test if table is empty. In this case DHT should start
397-- bootstrapping process until table becomes 'full'.
398null :: Table dht ip u -> Bool
399null (Tip _ _ b) = PSQ.null $ bktNodes b
400null _ = False
401
402-- | Test if table have maximum number of nodes. No more nodes can be
403-- 'insert'ed, except old ones becomes bad.
404full :: Table dht ip u -> Bool
405full (Tip _ n _) = n == 0
406full (Zero t b) = PSQ.size (bktNodes b) == defaultBucketSize && full t
407full (One b t) = PSQ.size (bktNodes b) == defaultBucketSize && full t
408
409-- | Get the /spine/ node id.
410thisId :: Table dht ip u -> NodeId dht
411thisId (Tip nid _ _) = nid
412thisId (Zero table _) = thisId table
413thisId (One _ table) = thisId table
414
415-- | Number of nodes in a bucket or a table.
416type NodeCount = Int
417
418-- | Internally, routing table is similar to list of buckets or a
419-- /matrix/ of nodes. This function returns the shape of the matrix.
420shape :: Table dht ip u -> [BucketSize]
421shape = map (PSQ.size . bktNodes) . toBucketList
422
423-- | Get number of nodes in the table.
424size :: Table dht ip u -> NodeCount
425size = L.sum . shape
426
427-- | Get number of buckets in the table.
428depth :: Table dht ip u -> BucketCount
429depth = L.length . shape
430
431lookupBucket :: ( FiniteBits (NodeId dht)
432 ) => NodeId dht -> Table dht ip u -> [Bucket dht ip u]
433lookupBucket nid = go 0 []
434 where
435 go i bs (Zero table bucket)
436 | testIdBit nid i = bucket : toBucketList table ++ bs
437 | otherwise = go (succ i) (bucket:bs) table
438 go i bs (One bucket table)
439 | testIdBit nid i = go (succ i) (bucket:bs) table
440 | otherwise = bucket : toBucketList table ++ bs
441 go _ bs (Tip _ _ bucket) = bucket : bs
442
443compatibleNodeId :: forall dht ip u.
444 ( Serialize (NodeId dht)
445 , FiniteBits (NodeId dht)
446 ) => Table dht ip u -> IO (NodeId dht)
447compatibleNodeId tbl = genBucketSample prefix br
448 where
449 br = bucketRange (L.length (shape tbl) - 1) True
450 nodeIdSize = finiteBitSize (undefined :: NodeId dht) `div` 8
451 bs = BS.pack $ take nodeIdSize $ tablePrefix tbl ++ repeat 0
452 prefix = either error id $ S.decode bs
453
454tablePrefix :: Table dht ip u -> [Word8]
455tablePrefix = map (packByte . take 8 . (++repeat False))
456 . chunksOf 8
457 . tableBits
458 where
459 packByte = foldl1' (.|.) . zipWith bitmask [7,6 .. 0]
460 bitmask ix True = bit ix
461 bitmask _ _ = 0
462
463tableBits :: Table dht ip u -> [Bool]
464tableBits (One _ tbl) = True : tableBits tbl
465tableBits (Zero tbl _) = False : tableBits tbl
466tableBits (Tip _ _ _) = []
467
468chunksOf :: Int -> [e] -> [[e]]
469chunksOf i ls = map (take i) (build (splitter ls)) where
470 splitter :: [e] -> ([e] -> a -> a) -> a -> a
471 splitter [] _ n = n
472 splitter l c n = l `c` splitter (drop i l) c n
473
474build :: ((a -> [a] -> [a]) -> [a] -> [a]) -> [a]
475build g = g (:) []
476
477-- | Count of closest nodes in find_node request.
478type K = Int
479
480-- | Default 'K' is equal to 'defaultBucketSize'.
481defaultK :: K
482defaultK = 8
483
484class TableKey dht k where
485 toNodeId :: k -> NodeId dht
486
487instance TableKey dht (NodeId dht) where
488 toNodeId = id
489
490-- | Get a list of /K/ closest nodes using XOR metric. Used in
491-- 'find_node' and 'get_peers' queries.
492kclosest :: ( Eq ip
493 , Ord (NodeId dht)
494 , FiniteBits (NodeId dht)
495 ) => TableKey dht a => K -> a -> Table dht ip u -> [NodeInfo dht ip u]
496kclosest k (toNodeId -> nid) tbl = take k $ rank nodeId nid (L.concat bucket)
497 ++ rank nodeId nid (L.concat everyone)
498 where
499 (bucket,everyone) =
500 L.splitAt 1
501 . L.map (L.map PSQ.key . PSQ.toList . bktNodes)
502 . lookupBucket nid
503 $ tbl
504
505{-----------------------------------------------------------------------
506-- Routing
507-----------------------------------------------------------------------}
508
509splitTip :: ( Eq ip
510 , Ord (NodeId dht)
511 , FiniteBits (NodeId dht)
512 ) => NodeId dht -> BucketCount -> BitIx -> Bucket dht ip u -> Table dht ip u
513splitTip nid n i bucket
514 | testIdBit nid i = (One zeros (Tip nid (pred n) ones))
515 | otherwise = (Zero (Tip nid (pred n) zeros) ones)
516 where
517 (ones, zeros) = split i bucket
518
519-- | Used in each query.
520--
521-- TODO: Kademlia non-empty subtrees should should split if they have less than
522-- k nodes in them. Which subtrees I mean is illustrated in Fig 1. of Kademlia
523-- paper. The rule requiring additional splits is in section 2.4.
524modifyBucket
525 :: forall xs dht ip u.
526 ( Eq ip
527 , Ord (NodeId dht)
528 , FiniteBits (NodeId dht)
529 ) =>
530 NodeId dht -> (Bucket dht ip u -> Maybe (xs, Bucket dht ip u)) -> Table dht ip u -> Maybe (xs,Table dht ip u)
531modifyBucket nodeId f = go (0 :: BitIx)
532 where
533 go :: BitIx -> Table dht ip u -> Maybe (xs, Table dht ip u)
534 go !i (Zero table bucket)
535 | testIdBit nodeId i = second (Zero table) <$> f bucket
536 | otherwise = second (`Zero` bucket) <$> go (succ i) table
537 go !i (One bucket table )
538 | testIdBit nodeId i = second (One bucket) <$> go (succ i) table
539 | otherwise = second (`One` table) <$> f bucket
540 go !i (Tip nid n bucket)
541 | n == 0 = second (Tip nid n) <$> f bucket
542 | otherwise = second (Tip nid n) <$> f bucket
543 <|> go i (splitTip nid n i bucket)
544
545-- | Triggering event for atomic table update
546data Event dht ip u = TryInsert { foreignNode :: NodeInfo dht ip u }
547 | PingResult { foreignNode :: NodeInfo dht ip u
548 , ponged :: Bool
549 }
550deriving instance Eq (NodeId dht) => Eq (Event dht ip u)
551deriving instance ( Show ip
552 , Show (NodeId dht)
553 , Show u
554 ) => Show (Event dht ip u)
555
556eventId :: Event dht ip u -> NodeId dht
557eventId (TryInsert NodeInfo{..}) = nodeId
558eventId (PingResult NodeInfo{..} _) = nodeId
559
560-- | Actions requested by atomic table update
561data CheckPing dht ip u = CheckPing [NodeInfo dht ip u]
562
563deriving instance Eq (NodeId dht) => Eq (CheckPing dht ip u)
564deriving instance ( Show ip
565 , Show (NodeId dht)
566 , Show u
567 ) => Show (CheckPing dht ip u)
568
569
570-- | Atomic 'Table' update
571insert :: ( Eq ip
572 , Applicative m
573 , Ord (NodeId dht)
574 , FiniteBits (NodeId dht)
575 ) => Timestamp -> Event dht ip u -> Table dht ip u -> m ([CheckPing dht ip u], Table dht ip u)
576insert tm event tbl = pure $ fromMaybe ([],tbl) $ modifyBucket (eventId event) (insertBucket tm event) tbl
577
578
579{-----------------------------------------------------------------------
580-- Conversion
581-----------------------------------------------------------------------}
582
583type TableEntry dht ip u = (NodeInfo dht ip u, Timestamp)
584
585tableEntry :: NodeEntry dht ip u -> TableEntry dht ip u
586tableEntry (a :-> b) = (a, b)
587
588-- | Non-empty list of buckets.
589toBucketList :: Table dht ip u -> [Bucket dht ip u]
590toBucketList (Tip _ _ b) = [b]
591toBucketList (Zero t b) = b : toBucketList t
592toBucketList (One b t) = b : toBucketList t
593
594toList :: Eq ip => Table dht ip u -> [[TableEntry dht ip u]]
595toList = L.map (L.map tableEntry . PSQ.toList . bktNodes) . toBucketList
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-22 10:19:08 +0000