diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Routing.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Routing.hs | 28 |
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 | |||
43 | import Data.Function | 43 | import Data.Function |
44 | import Data.List as L hiding (insert) | 44 | import Data.List as L hiding (insert) |
45 | import Data.Maybe | 45 | import Data.Maybe |
46 | import Data.Monoid | ||
46 | import Data.PSQueue as PSQ | 47 | import Data.PSQueue as PSQ |
47 | import Data.Serialize as S hiding (Result, Done) | 48 | import Data.Serialize as S hiding (Result, Done) |
48 | import Data.Time | 49 | import Data.Time |
@@ -128,15 +129,19 @@ instance Applicative (Routing ip) where | |||
128 | 129 | ||
129 | instance Alternative (Routing ip) where | 130 | instance 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 | ||
134 | runRouting :: (Monad m, Eq ip) | 139 | runRouting :: (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 |
140 | runRouting ping_node find_nodes timestamper = go | 145 | runRouting 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. |
283 | instance Pretty (Table ip) where | 288 | instance 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. |
287 | nullTable :: Eq ip => NodeId -> Table ip | 299 | nullTable :: Eq ip => NodeId -> Table ip |