bittorrent: Expire old peer announcements.

1 files changed, 13 insertions, 0 deletions

diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs
index c8187772..dfc93ed7 100644
--- a/src/Network/BitTorrent/DHT/ContactInfo.hs
+++ b/src/Network/BitTorrent/DHT/ContactInfo.hs
@@ -5,6 +5,7 @@ module Network.BitTorrent.DHT.ContactInfo
        , Network.BitTorrent.DHT.ContactInfo.lookup
        , Network.BitTorrent.DHT.ContactInfo.freshPeers
        , Network.BitTorrent.DHT.ContactInfo.insertPeer
+       , deleteOlderThan
        , knownSwarms
        ) where
 
@@ -234,3 +235,15 @@ insertPeer !ih !name !a !(PeerStore m) = seq a' $ PeerStore (HM.insertWith swarm
  where
     a' = SwarmData { peers = PSQ.singleton a 0
                    , name = name }
+
+deleteOlderThan :: POSIXTime -> PeerStore -> PeerStore
+deleteOlderThan cutoff (PeerStore m) = PeerStore $ HM.mapMaybe gc m
+    where
+        gc :: SwarmData -> Maybe SwarmData
+        gc swarms = fmap (\ps -> swarms { peers = ps }) $ gcPSQ (peers swarms)
+
+        gcPSQ :: PSQKey a => PSQ a Timestamp -> Maybe (PSQ a Timestamp)
+        gcPSQ ps = case minView ps of
+            Nothing                            -> Nothing
+            Just (_ :-> tm, ps') | tm < cutoff -> gcPSQ ps'
+            Just _                             -> Just ps