diff options
Diffstat (limited to 'src/Network/BitTorrent/DHT/Session.hs')
-rw-r--r-- | src/Network/BitTorrent/DHT/Session.hs | 43 |
1 files changed, 31 insertions, 12 deletions
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index 5a8d64ef..44a5f0e9 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs | |||
@@ -29,8 +29,10 @@ module Network.BitTorrent.DHT.Session | |||
29 | -- * Session | 29 | -- * Session |
30 | , Node | 30 | , Node |
31 | , options | 31 | , options |
32 | , thisNodeId | 32 | , tentativeNodeId |
33 | , routingTable | 33 | , myNodeIdAccordingTo |
34 | , routingInfo | ||
35 | , routableAddress | ||
34 | 36 | ||
35 | -- ** Initialization | 37 | -- ** Initialization |
36 | , LogFun | 38 | , LogFun |
@@ -239,14 +241,14 @@ data Node ip = Node | |||
239 | 241 | ||
240 | -- | Pseudo-unique self-assigned session identifier. This value is | 242 | -- | Pseudo-unique self-assigned session identifier. This value is |
241 | -- constant during DHT session and (optionally) between sessions. | 243 | -- constant during DHT session and (optionally) between sessions. |
242 | , thisNodeId :: !NodeId | 244 | , tentativeNodeId :: !NodeId |
243 | 245 | ||
244 | , resources :: !InternalState | 246 | , resources :: !InternalState |
245 | , manager :: !(Manager (DHT ip)) -- ^ RPC manager; | 247 | , manager :: !(Manager (DHT ip )) -- ^ RPC manager; |
246 | , routingTable :: !(TVar (Table ip)) -- ^ search table; | 248 | , routingInfo :: !(TVar (Maybe (R.Info ip))) -- ^ search table; |
247 | , contactInfo :: !(TVar (PeerStore ip)) -- ^ published by other nodes; | 249 | , contactInfo :: !(TVar (PeerStore ip )) -- ^ published by other nodes; |
248 | , announceInfo :: !(TVar AnnounceSet ) -- ^ to publish by this node; | 250 | , announceInfo :: !(TVar AnnounceSet ) -- ^ to publish by this node; |
249 | , sessionTokens :: !(TVar SessionTokens) -- ^ query session IDs. | 251 | , sessionTokens :: !(TVar SessionTokens ) -- ^ query session IDs. |
250 | , loggerFun :: !LogFun | 252 | , loggerFun :: !LogFun |
251 | } | 253 | } |
252 | 254 | ||
@@ -323,7 +325,7 @@ newNode hs opts naddr logger mbid = do | |||
323 | liftIO $ do | 325 | liftIO $ do |
324 | myId <- maybe genNodeId return mbid | 326 | myId <- maybe genNodeId return mbid |
325 | node <- Node opts myId s m | 327 | node <- Node opts myId s m |
326 | <$> atomically (newTVar (nullTable myId (optBucketCount opts))) | 328 | <$> atomically (newTVar Nothing) |
327 | <*> newTVarIO def | 329 | <*> newTVarIO def |
328 | <*> newTVarIO S.empty | 330 | <*> newTVarIO S.empty |
329 | <*> (newTVarIO =<< nullSessionTokens) | 331 | <*> (newTVarIO =<< nullSessionTokens) |
@@ -372,16 +374,33 @@ checkToken addr questionableToken = do | |||
372 | toks <- asks sessionTokens >>= liftIO . readTVarIO | 374 | toks <- asks sessionTokens >>= liftIO . readTVarIO |
373 | return $ T.member addr questionableToken (tokenMap toks) | 375 | return $ T.member addr questionableToken (tokenMap toks) |
374 | 376 | ||
377 | |||
375 | {----------------------------------------------------------------------- | 378 | {----------------------------------------------------------------------- |
376 | -- Routing table | 379 | -- Routing table |
377 | -----------------------------------------------------------------------} | 380 | -----------------------------------------------------------------------} |
378 | 381 | ||
382 | -- | This nodes externally routable address reported by remote peers. | ||
383 | routableAddress :: DHT ip (Maybe ip) | ||
384 | routableAddress = do | ||
385 | info <- asks routingInfo >>= liftIO . atomically . readTVar | ||
386 | return $ myAddress <$> info | ||
387 | |||
388 | -- | The current NodeId that the given remote node should know us by. | ||
389 | myNodeIdAccordingTo :: NodeAddr ip -> DHT ip NodeId | ||
390 | myNodeIdAccordingTo _ = do | ||
391 | info <- asks routingInfo >>= liftIO . atomically . readTVar | ||
392 | fallback <- asks tentativeNodeId | ||
393 | return $ maybe fallback myNodeId info | ||
394 | |||
379 | -- | Get current routing table. Normally you don't need to use this | 395 | -- | Get current routing table. Normally you don't need to use this |
380 | -- function, but it can be usefull for debugging and profiling purposes. | 396 | -- function, but it can be usefull for debugging and profiling purposes. |
381 | getTable :: DHT ip (Table ip) | 397 | getTable :: Eq ip => DHT ip (Table ip) |
382 | getTable = do | 398 | getTable = do |
383 | var <- asks routingTable | 399 | Node { tentativeNodeId = myId |
384 | liftIO (atomically $ readTVar var) | 400 | , routingInfo = var |
401 | , options = opts } <- ask | ||
402 | let nil = nullTable myId (optBucketCount opts) | ||
403 | liftIO (maybe nil R.myBuckets <$> atomically (readTVar var)) | ||
385 | 404 | ||
386 | -- | Find a set of closest nodes from routing table of this node. (in | 405 | -- | Find a set of closest nodes from routing table of this node. (in |
387 | -- no particular order) | 406 | -- no particular order) |