summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Exchange/Session.hs36
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.
300type Trigger = Wire Session () 300type Trigger = Wire Session ()
301 301
302interesting :: Trigger
303interesting = do
304 addr <- asks connRemoteAddr
305 sendMessage (Interested True)
306 sendMessage (Choking False)
307 tryFillRequestQueue
308
302fillRequestQueue :: Trigger 309fillRequestQueue :: Trigger
303fillRequestQueue = do 310fillRequestQueue = 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
318interesting :: Trigger
319interesting = 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
386waitForMetadata :: Trigger
387waitForMetadata = 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
386tryRequestMetadataBlock :: Trigger 396tryRequestMetadataBlock :: Trigger
387tryRequestMetadataBlock = do 397tryRequestMetadataBlock = do
388 mpix <- lift $ withMetadataUpdates Metadata.scheduleBlock 398 mpix <- lift $ withMetadataUpdates Metadata.scheduleBlock
@@ -415,18 +425,8 @@ handleMetadata (MetadataReject pix) = do
415handleMetadata (MetadataUnknown _ ) = do 425handleMetadata (MetadataUnknown _ ) = do
416 logInfoN "Unknown metadata message" 426 logInfoN "Unknown metadata message"
417 427
418waitForMetadata :: Trigger
419waitForMetadata = 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
432acceptRehandshake :: ExtendedHandshake -> Trigger 432acceptRehandshake :: ExtendedHandshake -> Trigger