summaryrefslogtreecommitdiff
path: root/src/Network/Kademlia/Routing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Kademlia/Routing.hs')
-rw-r--r--src/Network/Kademlia/Routing.hs16
1 files changed, 13 insertions, 3 deletions
diff --git a/src/Network/Kademlia/Routing.hs b/src/Network/Kademlia/Routing.hs
index 7f76ac77..a52cca73 100644
--- a/src/Network/Kademlia/Routing.hs
+++ b/src/Network/Kademlia/Routing.hs
@@ -1,5 +1,6 @@
1-- | 1-- |
2-- Copyright : (c) Sam Truzjan 2013 2-- Copyright : (c) Sam Truzjan 2013
3-- (c) Joe Crayne 2017
3-- License : BSD3 4-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com 5-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental 6-- Stability : experimental
@@ -73,6 +74,7 @@ import Control.Applicative as A
73import Control.Arrow 74import Control.Arrow
74import Control.Monad 75import Control.Monad
75import Data.Function 76import Data.Function
77import Data.Functor.Contravariant
76import Data.Functor.Identity 78import Data.Functor.Identity
77import Data.List as L hiding (insert) 79import Data.List as L hiding (insert)
78import Data.Maybe 80import Data.Maybe
@@ -95,6 +97,7 @@ import Data.Typeable
95import Data.Coerce 97import Data.Coerce
96import Data.Hashable 98import Data.Hashable
97 99
100
98-- | Last time the node was responding to our queries. 101-- | Last time the node was responding to our queries.
99-- 102--
100-- Not all nodes that we learn about are equal. Some are \"good\" and 103-- Not all nodes that we learn about are equal. Some are \"good\" and
@@ -273,6 +276,10 @@ delta = 15 * 60
273-- | Should maintain a set of stable long running nodes. 276-- | Should maintain a set of stable long running nodes.
274-- 277--
275-- Note: pings are triggerd only when a bucket is full. 278-- Note: pings are triggerd only when a bucket is full.
279updateBucketForInbound :: ( Coercible t1 t
280 , Alternative f
281 , Reifies s (Compare t1)
282 ) => NominalDiffTime -> t1 -> Bucket s t1 -> f ([t], Bucket s t1)
276updateBucketForInbound curTime info bucket 283updateBucketForInbound curTime info bucket
277 -- Just update timestamp if a node is already in bucket. 284 -- Just update timestamp if a node is already in bucket.
278 -- 285 --
@@ -316,6 +323,8 @@ updateBucketForInbound curTime info bucket
316 map_ns f = bucket { bktNodes = f (bktNodes bucket) } 323 map_ns f = bucket { bktNodes = f (bktNodes bucket) }
317 -- map_q f = bucket { bktQ = runIdentity \$ f (bktQ bucket) } 324 -- map_q f = bucket { bktQ = runIdentity \$ f (bktQ bucket) }
318 325
326updateBucketForPingResult :: (Applicative f, Reifies s (Compare a)) =>
327 a -> Bool -> Bucket s a -> f ([(a, Maybe (Timestamp, a))], Bucket s a)
319updateBucketForPingResult bad_node got_response bucket 328updateBucketForPingResult bad_node got_response bucket
320 = pure ( map (,Nothing) forgotten 329 = pure ( map (,Nothing) forgotten
321 ++ map (second Just) replacements 330 ++ map (second Just) replacements
@@ -792,7 +801,8 @@ data KademliaSpace nid ni = KademliaSpace
792 , kademliaSample :: forall m. Applicative m => (Int -> m BS.ByteString) -> nid -> (Int,Word8,Word8) -> m nid 801 , kademliaSample :: forall m. Applicative m => (Int -> m BS.ByteString) -> nid -> (Int,Word8,Word8) -> m nid
793 } 802 }
794 803
795contramapKS f ks = ks 804instance Contravariant (KademliaSpace nid) where
796 { kademliaLocation = kademliaLocation ks . f 805 contramap f ks = ks
797 } 806 { kademliaLocation = kademliaLocation ks . f
807 }
798 808