diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/DHT/Routing.hs | 12 |
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 #-} |
28 | module Network.DHT.Routing | 29 | module 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 | ||
306 | updateBucketForPingResult bad_node got_response bucket | 307 | updateBucketForPingResult 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. | ||
450 | nullTable :: (ni -> ni -> Ordering) -> ni -> Int -> BucketList ni | 458 | nullTable :: (ni -> ni -> Ordering) -> ni -> Int -> BucketList ni |
451 | nullTable cmp ni n = | 459 | nullTable 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 ) |
708 | updateForPingResult space ni got_reply tbl = | 716 | updateForPingResult space ni got_reply tbl = |
709 | fromMaybe ([],tbl) | 717 | fromMaybe ([],tbl) |
710 | $ modifyBucket space | 718 | $ modifyBucket space |