diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/DHT/Session.hs | 25 |
1 files changed, 16 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs index 3adbb840..b3688a37 100644 --- a/src/Network/BitTorrent/DHT/Session.hs +++ b/src/Network/BitTorrent/DHT/Session.hs | |||
@@ -228,21 +228,26 @@ invalidateTokens curTime ts @ SessionTokens {..} | |||
228 | -- Session | 228 | -- Session |
229 | -----------------------------------------------------------------------} | 229 | -----------------------------------------------------------------------} |
230 | 230 | ||
231 | -- | A set of torrents this peer intends to share. | ||
231 | type AnnounceSet = Set (InfoHash, PortNumber) | 232 | type AnnounceSet = Set (InfoHash, PortNumber) |
232 | 233 | ||
234 | -- | Logger function. | ||
233 | type Logger = Loc -> LogSource -> LogLevel -> LogStr -> IO () | 235 | type Logger = Loc -> LogSource -> LogLevel -> LogStr -> IO () |
234 | 236 | ||
237 | -- | DHT session keep track state of /this/ node. | ||
235 | data Node ip = Node | 238 | data Node ip = Node |
236 | { options :: !Options | 239 | { options :: !Options -- ^ session configuration; |
237 | , thisNodeId :: !NodeId | 240 | , thisNodeId :: !NodeId -- ^ session identifier; |
238 | , manager :: !(Manager (DHT ip)) | 241 | , manager :: !(Manager (DHT ip)) -- ^ RPC manager; |
239 | , routingTable :: !(MVar (Table ip)) | 242 | , routingTable :: !(MVar (Table ip)) -- ^ search table; |
240 | , contactInfo :: !(TVar (PeerStore ip)) | 243 | , contactInfo :: !(TVar (PeerStore ip)) -- ^ published by other nodes; |
241 | , announceInfo :: !(TVar AnnounceSet ) | 244 | , announceInfo :: !(TVar AnnounceSet ) -- ^ to publish by this node; |
242 | , sessionTokens :: !(TVar SessionTokens) | 245 | , sessionTokens :: !(TVar SessionTokens) -- ^ query session IDs. |
243 | , loggerFun :: !Logger | 246 | , loggerFun :: !Logger |
244 | } | 247 | } |
245 | 248 | ||
249 | -- | DHT keep track current session and proper resource allocation for | ||
250 | -- safe multithreading. | ||
246 | newtype DHT ip a = DHT { unDHT :: ReaderT (Node ip) (ResourceT IO) a } | 251 | newtype DHT ip a = DHT { unDHT :: ReaderT (Node ip) (ResourceT IO) a } |
247 | deriving ( Functor, Applicative, Monad | 252 | deriving ( Functor, Applicative, Monad |
248 | , MonadIO, MonadBase IO | 253 | , MonadIO, MonadBase IO |
@@ -268,17 +273,19 @@ instance MonadLogger (DHT ip) where | |||
268 | logger <- asks loggerFun | 273 | logger <- asks loggerFun |
269 | liftIO $ logger loc src lvl (toLogStr msg) | 274 | liftIO $ logger loc src lvl (toLogStr msg) |
270 | 275 | ||
276 | -- | Run DHT session. Some resources like listener thread may live for | ||
277 | -- some short period of time right after this DHT session closed. | ||
271 | runDHT :: forall ip a. Address ip | 278 | runDHT :: forall ip a. Address ip |
272 | => [Handler (DHT ip)] -- ^ handlers to run on accepted queries; | 279 | => [Handler (DHT ip)] -- ^ handlers to run on accepted queries; |
273 | -> Options -- ^ various dht options; | 280 | -> Options -- ^ various dht options; |
274 | -> NodeAddr ip -- ^ node address to bind; | 281 | -> NodeAddr ip -- ^ node address to bind; |
275 | -> DHT ip a -- ^ DHT action to run; | 282 | -> DHT ip a -- ^ DHT action to run; |
276 | -> IO a -- ^ result. | 283 | -> IO a -- ^ result. |
277 | runDHT handlers opts naddr action = runResourceT $ do | 284 | runDHT hs opts naddr action = runResourceT $ do |
278 | runStderrLoggingT $ LoggingT $ \ logger -> do | 285 | runStderrLoggingT $ LoggingT $ \ logger -> do |
279 | let rpcOpts = KRPC.def { optQueryTimeout = seconds (optTimeout opts) } | 286 | let rpcOpts = KRPC.def { optQueryTimeout = seconds (optTimeout opts) } |
280 | let nodeAddr = toSockAddr naddr | 287 | let nodeAddr = toSockAddr naddr |
281 | (_, m) <- allocate (newManager rpcOpts nodeAddr handlers) closeManager | 288 | (_, m) <- allocate (newManager rpcOpts nodeAddr hs) closeManager |
282 | myId <- liftIO genNodeId | 289 | myId <- liftIO genNodeId |
283 | node <- liftIO $ Node opts myId m | 290 | node <- liftIO $ Node opts myId m |
284 | <$> newMVar (nullTable myId (optBucketCount opts)) | 291 | <$> newMVar (nullTable myId (optBucketCount opts)) |