diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/DHT.hs | 15 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Query.hs | 8 | ||||
-rw-r--r-- | src/Network/BitTorrent/DHT/Routing.hs | 8 |
3 files changed, 27 insertions, 4 deletions
diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs index bb9be560..dbedf801 100644 --- a/src/Network/BitTorrent/DHT.hs +++ b/src/Network/BitTorrent/DHT.hs | |||
@@ -60,6 +60,7 @@ import Control.Exception | |||
60 | import Data.ByteString as BS | 60 | import Data.ByteString as BS |
61 | import Data.Conduit as C | 61 | import Data.Conduit as C |
62 | import Data.Conduit.List as C | 62 | import Data.Conduit.List as C |
63 | import Data.Serialize | ||
63 | import Network.Socket | 64 | import Network.Socket |
64 | 65 | ||
65 | import Data.Torrent | 66 | import Data.Torrent |
@@ -182,15 +183,21 @@ isBootstrapped = T.full <$> getTable | |||
182 | -- | 183 | -- |
183 | -- This is blocking operation, use | 184 | -- This is blocking operation, use |
184 | -- 'Control.Concurrent.Async.Lifted.async' if needed. | 185 | -- 'Control.Concurrent.Async.Lifted.async' if needed. |
185 | restore :: ByteString -> IO (Node ip) | 186 | restore :: Address ip => ByteString -> DHT ip () |
186 | restore = error "DHT.restore: not implemented" | 187 | restore bs = do |
188 | tblvar <- asks routingTable | ||
189 | case decode bs of | ||
190 | Right tbl -> restoreTable tbl | ||
191 | Left _ -> return () | ||
187 | 192 | ||
188 | -- | Serialize current DHT session to byte string. | 193 | -- | Serialize current DHT session to byte string. |
189 | -- | 194 | -- |
190 | -- This is blocking operation, use | 195 | -- This is blocking operation, use |
191 | -- 'Control.Concurrent.Async.Lifted.async' if needed. | 196 | -- 'Control.Concurrent.Async.Lifted.async' if needed. |
192 | snapshot :: DHT ip ByteString | 197 | snapshot :: Address ip => DHT ip ByteString |
193 | snapshot = error "DHT.snapshot: not implemented" | 198 | snapshot = do |
199 | tbl <- getTable | ||
200 | return $ encode tbl | ||
194 | 201 | ||
195 | {----------------------------------------------------------------------- | 202 | {----------------------------------------------------------------------- |
196 | -- Operations | 203 | -- Operations |
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs index c5fcccb4..7f20ad6d 100644 --- a/src/Network/BitTorrent/DHT/Query.hs +++ b/src/Network/BitTorrent/DHT/Query.hs | |||
@@ -41,6 +41,7 @@ module Network.BitTorrent.DHT.Query | |||
41 | , publish | 41 | , publish |
42 | 42 | ||
43 | -- ** Routing table | 43 | -- ** Routing table |
44 | , restoreTable | ||
44 | , insertNode | 45 | , insertNode |
45 | , refreshNodes | 46 | , refreshNodes |
46 | 47 | ||
@@ -266,3 +267,10 @@ queryNode addr q = do | |||
266 | q <@> addr = snd <$> queryNode addr q | 267 | q <@> addr = snd <$> queryNode addr q |
267 | {-# INLINE (<@>) #-} | 268 | {-# INLINE (<@>) #-} |
268 | 269 | ||
270 | restoreTable :: Address ip => Table ip -> DHT ip () | ||
271 | restoreTable tbl = do | ||
272 | tblvar <- asks routingTable | ||
273 | tbl0 <- liftIO $ takeMVar tblvar | ||
274 | mb <- routing $ merge tbl tbl0 | ||
275 | maybe (return ()) (liftIO . putMVar tblvar) mb | ||
276 | |||
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs index fee52380..68edef56 100644 --- a/src/Network/BitTorrent/DHT/Routing.hs +++ b/src/Network/BitTorrent/DHT/Routing.hs | |||
@@ -46,6 +46,7 @@ module Network.BitTorrent.DHT.Routing | |||
46 | -- * Construction | 46 | -- * Construction |
47 | , Network.BitTorrent.DHT.Routing.nullTable | 47 | , Network.BitTorrent.DHT.Routing.nullTable |
48 | , Network.BitTorrent.DHT.Routing.insert | 48 | , Network.BitTorrent.DHT.Routing.insert |
49 | , Network.BitTorrent.DHT.Routing.merge | ||
49 | 50 | ||
50 | -- * Conversion | 51 | -- * Conversion |
51 | , Network.BitTorrent.DHT.Routing.TableEntry | 52 | , Network.BitTorrent.DHT.Routing.TableEntry |
@@ -457,3 +458,10 @@ toBucketList (One b t) = b : toBucketList t | |||
457 | 458 | ||
458 | toList :: Eq ip => Table ip -> [[TableEntry ip]] | 459 | toList :: Eq ip => Table ip -> [[TableEntry ip]] |
459 | toList = L.map (L.map tableEntry . PSQ.toList) . toBucketList | 460 | toList = L.map (L.map tableEntry . PSQ.toList) . toBucketList |
461 | |||
462 | merge :: Eq ip => Table ip -> Table ip -> Routing ip (Table ip) | ||
463 | merge a b = do | ||
464 | let ns = concatMap PSQ.toList $ toBucketList a | ||
465 | -- TODO: merge timestamps as well and let refresh take care of ping. | ||
466 | as <- filterM (needPing . nodeAddr . PSQ.key) ns | ||
467 | foldM (flip $ Network.BitTorrent.DHT.Routing.insert) b $ map PSQ.key as | ||