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.hs28
1 files changed, 20 insertions, 8 deletions
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
index af10513d..43792b0b 100644
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ b/src/Network/BitTorrent/DHT/Routing.hs
@@ -43,6 +43,7 @@ import Control.Monad
43import Data.Function 43import Data.Function
44import Data.List as L hiding (insert) 44import Data.List as L hiding (insert)
45import Data.Maybe 45import Data.Maybe
46import Data.Monoid
46import Data.PSQueue as PSQ 47import Data.PSQueue as PSQ
47import Data.Serialize as S hiding (Result, Done) 48import Data.Serialize as S hiding (Result, Done)
48import Data.Time 49import Data.Time
@@ -128,15 +129,19 @@ instance Applicative (Routing ip) where
128 129
129instance Alternative (Routing ip) where 130instance Alternative (Routing ip) where
130 empty = Full 131 empty = Full
131 Full <|> m = m 132
132 m <|> _ = m 133 Full <|> m = m
134 Done a <|> _ = Done a
135 GetTime f <|> m = GetTime $ \ t -> f t <|> m
136 NeedPing a f <|> m = NeedPing a $ \ p -> f p <|> m
137 Refresh n f <|> m = Refresh n $ \ i -> f i <|> m
133 138
134runRouting :: (Monad m, Eq ip) 139runRouting :: (Monad m, Eq ip)
135 => (NodeAddr ip -> m Bool) -- ^ ping_node 140 => (NodeAddr ip -> m Bool) -- ^ ping_node
136 -> (NodeId -> m [NodeInfo ip]) -- ^ find_nodes 141 -> (NodeId -> m [NodeInfo ip]) -- ^ find_nodes
137 -> m Timestamp -- ^ timestamper 142 -> m Timestamp -- ^ timestamper
138 -> Routing ip f -- ^ action 143 -> Routing ip f -- ^ action
139 -> m (Maybe f) -- ^ result 144 -> m (Maybe f) -- ^ result
140runRouting ping_node find_nodes timestamper = go 145runRouting ping_node find_nodes timestamper = go
141 where 146 where
142 go Full = return (Nothing) 147 go Full = return (Nothing)
@@ -281,7 +286,14 @@ instance (Eq ip, Serialize ip) => Serialize (Table ip)
281 286
282-- | Shape of the table. 287-- | Shape of the table.
283instance Pretty (Table ip) where 288instance Pretty (Table ip) where
284 pretty = hcat . punctuate "," . L.map PP.int . shape 289 pretty t
290 | bucketCount < 6 = hcat $ punctuate ", " $ L.map PP.int ss
291 | otherwise = brackets $
292 PP.int (L.sum ss) <> " nodes, " <>
293 PP.int bucketCount <> " buckets"
294 where
295 bucketCount = L.length ss
296 ss = shape t
285 297
286-- | Empty table with specified /spine/ node id. 298-- | Empty table with specified /spine/ node id.
287nullTable :: Eq ip => NodeId -> Table ip 299nullTable :: Eq ip => NodeId -> Table ip