summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Network/BitTorrent/DHT/Session.hs25
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.
231type AnnounceSet = Set (InfoHash, PortNumber) 232type AnnounceSet = Set (InfoHash, PortNumber)
232 233
234-- | Logger function.
233type Logger = Loc -> LogSource -> LogLevel -> LogStr -> IO () 235type Logger = Loc -> LogSource -> LogLevel -> LogStr -> IO ()
234 236
237-- | DHT session keep track state of /this/ node.
235data Node ip = Node 238data 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.
246newtype DHT ip a = DHT { unDHT :: ReaderT (Node ip) (ResourceT IO) a } 251newtype 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.
271runDHT :: forall ip a. Address ip 278runDHT :: 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.
277runDHT handlers opts naddr action = runResourceT $ do 284runDHT 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))