summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Exchange/Session.hs17
1 files changed, 10 insertions, 7 deletions
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index 5be7513a..12092473 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -296,7 +296,10 @@ sendBroadcast msg = do
296-- Triggers 296-- Triggers
297-----------------------------------------------------------------------} 297-----------------------------------------------------------------------}
298 298
299fillRequestQueue :: Wire Session () 299-- | Trigger is the reaction of a handler at some event.
300type Trigger = Wire Session ()
301
302fillRequestQueue :: Trigger
300fillRequestQueue = do 303fillRequestQueue = do
301 maxN <- lift getMaxQueueLength 304 maxN <- lift getMaxQueueLength
302 rbf <- use connBitfield 305 rbf <- use connBitfield
@@ -306,13 +309,13 @@ fillRequestQueue = do
306 scheduleBlocks addr rbf (maxN - n) 309 scheduleBlocks addr rbf (maxN - n)
307 mapM_ (sendMessage . Request) blks 310 mapM_ (sendMessage . Request) blks
308 311
309tryFillRequestQueue :: Wire Session () 312tryFillRequestQueue :: Trigger
310tryFillRequestQueue = do 313tryFillRequestQueue = do
311 allowed <- canDownload <$> use connStatus 314 allowed <- canDownload <$> use connStatus
312 when allowed $ do 315 when allowed $ do
313 fillRequestQueue 316 fillRequestQueue
314 317
315interesting :: Wire Session () 318interesting :: Trigger
316interesting = do 319interesting = do
317 addr <- asks connRemoteAddr 320 addr <- asks connRemoteAddr
318 sendMessage (Interested True) 321 sendMessage (Interested True)
@@ -380,14 +383,14 @@ handleTransfer (Cancel bix) = filterQueue (not . (transferResponse bix))
380-----------------------------------------------------------------------} 383-----------------------------------------------------------------------}
381-- TODO introduce new metadata exchange specific exceptions 384-- TODO introduce new metadata exchange specific exceptions
382 385
383tryRequestMetadataBlock :: Wire Session () 386tryRequestMetadataBlock :: Trigger
384tryRequestMetadataBlock = do 387tryRequestMetadataBlock = do
385 mpix <- lift $ withMetadataUpdates Metadata.scheduleBlock 388 mpix <- lift $ withMetadataUpdates Metadata.scheduleBlock
386 case mpix of 389 case mpix of
387 Nothing -> undefined 390 Nothing -> undefined
388 Just pix -> sendMessage (MetadataRequest pix) 391 Just pix -> sendMessage (MetadataRequest pix)
389 392
390metadataCompleted :: InfoDict -> Wire Session () 393metadataCompleted :: InfoDict -> Trigger
391metadataCompleted dict = do 394metadataCompleted dict = do
392 Session {..} <- asks connSession 395 Session {..} <- asks connSession
393 liftIO $ putMVar infodict (cache dict) 396 liftIO $ putMVar infodict (cache dict)
@@ -412,7 +415,7 @@ handleMetadata (MetadataReject pix) = do
412handleMetadata (MetadataUnknown _ ) = do 415handleMetadata (MetadataUnknown _ ) = do
413 logInfoN "Unknown metadata message" 416 logInfoN "Unknown metadata message"
414 417
415waitForMetadata :: Wire Session () 418waitForMetadata :: Trigger
416waitForMetadata = do 419waitForMetadata = do
417 Session {..} <- asks connSession 420 Session {..} <- asks connSession
418 needFetch <- liftIO (isEmptyMVar infodict) 421 needFetch <- liftIO (isEmptyMVar infodict)
@@ -426,7 +429,7 @@ waitForMetadata = do
426-- Event loop 429-- Event loop
427-----------------------------------------------------------------------} 430-----------------------------------------------------------------------}
428 431
429acceptRehandshake :: ExtendedHandshake -> Wire s () 432acceptRehandshake :: ExtendedHandshake -> Trigger
430acceptRehandshake ehs = undefined 433acceptRehandshake ehs = undefined
431 434
432handleExtended :: Handler ExtendedMessage 435handleExtended :: Handler ExtendedMessage