Limitng size of response to get_peers.

1 files changed, 17 insertions, 1 deletions

diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 339b18eb..4f861a1e 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -33,6 +33,7 @@ module Network.BitTorrent.DHT.Session
        , myNodeIdAccordingTo
        , routingInfo
        , routableAddress
+       , getTimestamp
 
          -- ** Initialization
        , LogFun
@@ -86,6 +87,10 @@ import Data.Set as S
 import Data.Time
 import Network (PortNumber)
 import System.Random (randomIO)
+import Data.Time.Clock.POSIX
+import Data.Text as Text
+import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
+
 
 import Data.Torrent as Torrent
 import Network.KRPC as KRPC hiding (Options, def)
@@ -435,7 +440,18 @@ lookupPeers :: Ord ip => InfoHash -> DHT ip [PeerAddr ip]
 lookupPeers ih = do
   refreshContacts
   var <- asks contactInfo
-  liftIO $ P.lookup ih <$> readTVarIO var
+  tm <- getTimestamp
+  liftIO $ atomically $ do
+    (ps,store') <- P.freshPeers ih tm <$> readTVar var
+    writeTVar var store'
+    return ps
+
+getTimestamp :: DHT ip Timestamp
+getTimestamp = do
+  utcTime <- liftIO $ getCurrentTime
+  $(logDebugS) "routing.make_timestamp" (Text.pack (render (pPrint utcTime)))
+  return $ utcTimeToPOSIXSeconds utcTime
+
 
 -- | Prepare result for 'get_peers' query.
 --