diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Session.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Session.hs | 22 |
1 files changed, 20 insertions, 2 deletions
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index bc9fda91..c08021c7 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs | |||
@@ -54,14 +54,16 @@ module Network.BitTorrent.DHT.Session | |||
54 | -- ** Routing table | 54 | -- ** Routing table |
55 | , getTable | 55 | , getTable |
56 | , getClosest | 56 | , getClosest |
57 | , getSwarms | ||
58 | , allPeers | ||
59 | 57 | ||
60 | -- ** Peer storage | 58 | -- ** Peer storage |
61 | , insertPeer | 59 | , insertPeer |
62 | , getPeerList | 60 | , getPeerList |
63 | , insertTopic | 61 | , insertTopic |
64 | , deleteTopic | 62 | , deleteTopic |
63 | , getSwarms | ||
64 | , savePeerStore | ||
65 | , mergeSavedPeers | ||
66 | , allPeers | ||
65 | 67 | ||
66 | -- ** Messaging | 68 | -- ** Messaging |
67 | , queryParallel | 69 | , queryParallel |
@@ -84,6 +86,7 @@ import Data.Fixed | |||
84 | import Data.Hashable | 86 | import Data.Hashable |
85 | import Data.List as L | 87 | import Data.List as L |
86 | import Data.Maybe | 88 | import Data.Maybe |
89 | import Data.Monoid | ||
87 | import Data.Set as S | 90 | import Data.Set as S |
88 | import Data.Time | 91 | import Data.Time |
89 | import Network (PortNumber) | 92 | import Network (PortNumber) |
@@ -91,6 +94,7 @@ import System.Random (randomIO) | |||
91 | import Data.Time.Clock.POSIX | 94 | import Data.Time.Clock.POSIX |
92 | import Data.Text as Text | 95 | import Data.Text as Text |
93 | import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) | 96 | import Text.PrettyPrint.HughesPJClass hiding ((<>),($$)) |
97 | import Data.Serialize as S | ||
94 | 98 | ||
95 | 99 | ||
96 | import Data.Torrent as Torrent | 100 | import Data.Torrent as Torrent |
@@ -409,6 +413,20 @@ getSwarms = do | |||
409 | store <- asks contactInfo >>= liftIO . atomically . readTVar | 413 | store <- asks contactInfo >>= liftIO . atomically . readTVar |
410 | return $ P.knownSwarms store | 414 | return $ P.knownSwarms store |
411 | 415 | ||
416 | savePeerStore :: (Ord ip, Address ip) => DHT ip ByteString | ||
417 | savePeerStore = do | ||
418 | var <- asks contactInfo | ||
419 | peers <- liftIO $ atomically $ readTVar var | ||
420 | return $ S.encode peers | ||
421 | |||
422 | mergeSavedPeers :: (Ord ip, Address ip) => ByteString -> DHT ip () | ||
423 | mergeSavedPeers bs = do | ||
424 | var <- asks contactInfo | ||
425 | case S.decode bs of | ||
426 | Right newbies -> liftIO $ atomically $ modifyTVar' var (<> newbies) | ||
427 | Left _ -> return () | ||
428 | |||
429 | |||
412 | allPeers :: Ord ip => InfoHash -> DHT ip [ PeerAddr ip ] | 430 | allPeers :: Ord ip => InfoHash -> DHT ip [ PeerAddr ip ] |
413 | allPeers ih = do | 431 | allPeers ih = do |
414 | store <- asks contactInfo >>= liftIO . atomically . readTVar | 432 | store <- asks contactInfo >>= liftIO . atomically . readTVar |