diff options
author | joe <joe@jerkface.net> | 2017-01-22 19:38:43 -0500 |
---|---|---|
committer | joe <joe@jerkface.net> | 2017-01-22 19:38:43 -0500 |
commit | 655efe0e7e1b25e2b4d333cf7551998ed69a4dfa (patch) | |
tree | 937780aacbd6f0c8f53168bb76b89ba025d21cf2 /src/Network/BitTorrent/DHT/ContactInfo.hs | |
parent | e7c2f98454a4e52b7e7b62b49f91b59cfc77a91b (diff) |
Limitng size of response to get_peers.
Diffstat (limited to 'src/Network/BitTorrent/DHT/ContactInfo.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/ContactInfo.hs | 29 |
1 files changed, 24 insertions, 5 deletions
diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs index 979dbb62..823982d4 100644 --- a/src/Network/BitTorrent/DHT/ContactInfo.hs +++ b/src/Network/BitTorrent/DHT/ContactInfo.hs | |||
@@ -1,6 +1,6 @@ | |||
1 | module Network.BitTorrent.DHT.ContactInfo | 1 | module Network.BitTorrent.DHT.ContactInfo |
2 | ( PeerStore | 2 | ( PeerStore |
3 | , Network.BitTorrent.DHT.ContactInfo.lookup | 3 | , Network.BitTorrent.DHT.ContactInfo.freshPeers |
4 | , Network.BitTorrent.DHT.ContactInfo.insertPeer | 4 | , Network.BitTorrent.DHT.ContactInfo.insertPeer |
5 | , knownSwarms | 5 | , knownSwarms |
6 | ) where | 6 | ) where |
@@ -124,8 +124,8 @@ data SwarmData ip = SwarmData | |||
124 | knownSwarms :: PeerStore ip -> [ (InfoHash, Int, Maybe ByteString) ] | 124 | knownSwarms :: PeerStore ip -> [ (InfoHash, Int, Maybe ByteString) ] |
125 | knownSwarms (PeerStore m) = L.map (\(ih,SwarmData q n) -> (ih,PSQ.size q,n)) $ HM.toList m | 125 | knownSwarms (PeerStore m) = L.map (\(ih,SwarmData q n) -> (ih,PSQ.size q,n)) $ HM.toList m |
126 | 126 | ||
127 | swarmSinglton :: Ord ip => PeerAddr ip -> SwarmData ip | 127 | swarmSingleton :: Ord ip => PeerAddr ip -> SwarmData ip |
128 | swarmSinglton a = SwarmData | 128 | swarmSingleton a = SwarmData |
129 | { peers = PSQ.singleton a 0 | 129 | { peers = PSQ.singleton a 0 |
130 | , name = Nothing } | 130 | , name = Nothing } |
131 | 131 | ||
@@ -157,8 +157,27 @@ instance Serialize (PeerStore a) where | |||
157 | put = undefined | 157 | put = undefined |
158 | 158 | ||
159 | -- | Used in 'get_peers' DHT queries. | 159 | -- | Used in 'get_peers' DHT queries. |
160 | lookup :: Ord a => InfoHash -> PeerStore a -> [PeerAddr a] | 160 | -- lookup :: Ord a => InfoHash -> PeerStore a -> [PeerAddr a] |
161 | lookup ih (PeerStore m) = maybe [] (PSQ.keys . peers) $ HM.lookup ih m | 161 | -- lookup ih (PeerStore m) = maybe [] (PSQ.keys . peers) $ HM.lookup ih m |
162 | |||
163 | batchSize = 64 | ||
164 | |||
165 | -- | Used in 'get_peers' DHT queries. | ||
166 | freshPeers :: Ord a => InfoHash -> Timestamp -> PeerStore a -> ([PeerAddr a], PeerStore a) | ||
167 | freshPeers ih tm (PeerStore m) = (ps, PeerStore m') | ||
168 | where | ||
169 | swarm = fromMaybe (SwarmData PSQ.empty Nothing) $ HM.lookup ih m | ||
170 | ps0 = take batchSize $ unfoldr (incomp minView) (peers swarm) | ||
171 | peers' = case reverse ps0 of | ||
172 | (_,psq):_ -> psq | ||
173 | _ -> peers swarm | ||
174 | ps = L.map (key . fst) ps0 | ||
175 | m' = HM.insert ih swarm { peers = L.foldl' (\q p -> PSQ.insert p tm q) peers' ps } m | ||
176 | |||
177 | incomp :: (x -> Maybe (r,x)) -> x -> Maybe ((r,x),x) | ||
178 | incomp f x = do | ||
179 | (result,x') <- f x | ||
180 | pure $ ( (result,x'), x' ) | ||
162 | 181 | ||
163 | -- | Used in 'announce_peer' DHT queries. | 182 | -- | Used in 'announce_peer' DHT queries. |
164 | insertPeer :: Ord a => InfoHash -> Maybe ByteString -> PeerAddr a -> PeerStore a -> PeerStore a | 183 | insertPeer :: Ord a => InfoHash -> Maybe ByteString -> PeerAddr a -> PeerStore a -> PeerStore a |