summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/DHT/Routing.hs12
1 files changed, 10 insertions, 2 deletions
diff --git a/src/Network/DHT/Routing.hs b/src/Network/DHT/Routing.hs
index 58e0cbd3..0eb1078b 100644
--- a/src/Network/DHT/Routing.hs
+++ b/src/Network/DHT/Routing.hs
@@ -23,6 +23,7 @@
23{-# LANGUAGE DeriveFunctor #-} 23{-# LANGUAGE DeriveFunctor #-}
24{-# LANGUAGE GADTs #-} 24{-# LANGUAGE GADTs #-}
25{-# LANGUAGE ScopedTypeVariables #-} 25{-# LANGUAGE ScopedTypeVariables #-}
26{-# LANGUAGE TupleSections #-}
26{-# LANGUAGE StandaloneDeriving, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-} 27{-# LANGUAGE StandaloneDeriving, FlexibleContexts, MultiParamTypeClasses, FlexibleInstances #-}
27{-# OPTIONS_GHC -fno-warn-orphans #-} 28{-# OPTIONS_GHC -fno-warn-orphans #-}
28module Network.DHT.Routing 29module Network.DHT.Routing
@@ -304,7 +305,8 @@ updateBucketForInbound curTime info bucket
304 -- map_q f = bucket { bktQ = runIdentity \$ f (bktQ bucket) } 305 -- map_q f = bucket { bktQ = runIdentity \$ f (bktQ bucket) }
305 306
306updateBucketForPingResult bad_node got_response bucket 307updateBucketForPingResult bad_node got_response bucket
307 = pure ( replacements 308 = pure ( map (,Nothing) forgotten
309 ++ map (second Just) replacements
308 , Bucket (foldr replace 310 , Bucket (foldr replace
309 (bktNodes bucket) 311 (bktNodes bucket)
310 replacements) 312 replacements)
@@ -312,6 +314,7 @@ updateBucketForPingResult bad_node got_response bucket
312 ) 314 )
313 where 315 where
314 (top, popped) = runIdentity $ popFront bucketQ (bktQ bucket) 316 (top, popped) = runIdentity $ popFront bucketQ (bktQ bucket)
317
315 replacements | got_response = [] -- Timestamp was already updated by TryInsert. 318 replacements | got_response = [] -- Timestamp was already updated by TryInsert.
316 | Just info <- top = do 319 | Just info <- top = do
317 -- Insert only if there's a removal. 320 -- Insert only if there's a removal.
@@ -319,6 +322,9 @@ updateBucketForPingResult bad_node got_response bucket
319 return (bad_node, info) 322 return (bad_node, info)
320 | otherwise = [] 323 | otherwise = []
321 324
325 forgotten | got_response = maybeToList $ fmap snd top
326
327
322 replace (bad_node, (tm, info)) = 328 replace (bad_node, (tm, info)) =
323 PSQ.insert (coerce info) tm 329 PSQ.insert (coerce info) tm
324 . PSQ.delete (coerce bad_node) 330 . PSQ.delete (coerce bad_node)
@@ -447,6 +453,8 @@ instance Pretty (BucketList ni) where
447 ss = shape t 453 ss = shape t
448 454
449-- | Empty table with specified /spine/ node id. 455-- | Empty table with specified /spine/ node id.
456--
457-- XXX: The comparison function argument is awkward here.
450nullTable :: (ni -> ni -> Ordering) -> ni -> Int -> BucketList ni 458nullTable :: (ni -> ni -> Ordering) -> ni -> Int -> BucketList ni
451nullTable cmp ni n = 459nullTable cmp ni n =
452 reify (Compare cmp) 460 reify (Compare cmp)
@@ -704,7 +712,7 @@ updateForPingResult ::
704 -> ni -- ^ The pinged node. 712 -> ni -- ^ The pinged node.
705 -> Bool -- ^ True if we got a reply, False if it timed out. 713 -> Bool -- ^ True if we got a reply, False if it timed out.
706 -> BucketList ni -- ^ The routing table. 714 -> BucketList ni -- ^ The routing table.
707 -> ( [(ni,(Timestamp, ni))], BucketList ni ) 715 -> ( [(ni,Maybe (Timestamp, ni))], BucketList ni )
708updateForPingResult space ni got_reply tbl = 716updateForPingResult space ni got_reply tbl =
709 fromMaybe ([],tbl) 717 fromMaybe ([],tbl)
710 $ modifyBucket space 718 $ modifyBucket space