diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Session.hs | 36 |
1 files changed, 18 insertions, 18 deletions
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs index 12092473..be8d3835 100644 --- a/src/Network/BitTorrent/Exchange/Session.hs +++ b/src/Network/BitTorrent/Exchange/Session.hs | |||
@@ -299,6 +299,13 @@ sendBroadcast msg = do | |||
299 | -- | Trigger is the reaction of a handler at some event. | 299 | -- | Trigger is the reaction of a handler at some event. |
300 | type Trigger = Wire Session () | 300 | type Trigger = Wire Session () |
301 | 301 | ||
302 | interesting :: Trigger | ||
303 | interesting = do | ||
304 | addr <- asks connRemoteAddr | ||
305 | sendMessage (Interested True) | ||
306 | sendMessage (Choking False) | ||
307 | tryFillRequestQueue | ||
308 | |||
302 | fillRequestQueue :: Trigger | 309 | fillRequestQueue :: Trigger |
303 | fillRequestQueue = do | 310 | fillRequestQueue = do |
304 | maxN <- lift getMaxQueueLength | 311 | maxN <- lift getMaxQueueLength |
@@ -315,13 +322,6 @@ tryFillRequestQueue = do | |||
315 | when allowed $ do | 322 | when allowed $ do |
316 | fillRequestQueue | 323 | fillRequestQueue |
317 | 324 | ||
318 | interesting :: Trigger | ||
319 | interesting = do | ||
320 | addr <- asks connRemoteAddr | ||
321 | sendMessage (Interested True) | ||
322 | sendMessage (Choking False) | ||
323 | tryFillRequestQueue | ||
324 | |||
325 | {----------------------------------------------------------------------- | 325 | {----------------------------------------------------------------------- |
326 | -- Incoming message handling | 326 | -- Incoming message handling |
327 | -----------------------------------------------------------------------} | 327 | -----------------------------------------------------------------------} |
@@ -383,6 +383,16 @@ handleTransfer (Cancel bix) = filterQueue (not . (transferResponse bix)) | |||
383 | -----------------------------------------------------------------------} | 383 | -----------------------------------------------------------------------} |
384 | -- TODO introduce new metadata exchange specific exceptions | 384 | -- TODO introduce new metadata exchange specific exceptions |
385 | 385 | ||
386 | waitForMetadata :: Trigger | ||
387 | waitForMetadata = do | ||
388 | Session {..} <- asks connSession | ||
389 | needFetch <- liftIO (isEmptyMVar infodict) | ||
390 | when needFetch $ do | ||
391 | canFetch <- allowed ExtMetadata <$> use connExtCaps | ||
392 | if canFetch | ||
393 | then tryRequestMetadataBlock | ||
394 | else liftIO (waitMVar infodict) | ||
395 | |||
386 | tryRequestMetadataBlock :: Trigger | 396 | tryRequestMetadataBlock :: Trigger |
387 | tryRequestMetadataBlock = do | 397 | tryRequestMetadataBlock = do |
388 | mpix <- lift $ withMetadataUpdates Metadata.scheduleBlock | 398 | mpix <- lift $ withMetadataUpdates Metadata.scheduleBlock |
@@ -415,18 +425,8 @@ handleMetadata (MetadataReject pix) = do | |||
415 | handleMetadata (MetadataUnknown _ ) = do | 425 | handleMetadata (MetadataUnknown _ ) = do |
416 | logInfoN "Unknown metadata message" | 426 | logInfoN "Unknown metadata message" |
417 | 427 | ||
418 | waitForMetadata :: Trigger | ||
419 | waitForMetadata = do | ||
420 | Session {..} <- asks connSession | ||
421 | needFetch <- liftIO (isEmptyMVar infodict) | ||
422 | when needFetch $ do | ||
423 | canFetch <- allowed ExtMetadata <$> use connExtCaps | ||
424 | if canFetch | ||
425 | then tryRequestMetadataBlock | ||
426 | else liftIO (waitMVar infodict) | ||
427 | |||
428 | {----------------------------------------------------------------------- | 428 | {----------------------------------------------------------------------- |
429 | -- Event loop | 429 | -- Main entry point |
430 | -----------------------------------------------------------------------} | 430 | -----------------------------------------------------------------------} |
431 | 431 | ||
432 | acceptRehandshake :: ExtendedHandshake -> Trigger | 432 | acceptRehandshake :: ExtendedHandshake -> Trigger |