diff options
-rw-r--r-- | src/Network/BitTorrent/Exchange/Session.hs | 17 |
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 | ||
299 | fillRequestQueue :: Wire Session () | 299 | -- | Trigger is the reaction of a handler at some event. |
300 | type Trigger = Wire Session () | ||
301 | |||
302 | fillRequestQueue :: Trigger | ||
300 | fillRequestQueue = do | 303 | fillRequestQueue = 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 | ||
309 | tryFillRequestQueue :: Wire Session () | 312 | tryFillRequestQueue :: Trigger |
310 | tryFillRequestQueue = do | 313 | tryFillRequestQueue = 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 | ||
315 | interesting :: Wire Session () | 318 | interesting :: Trigger |
316 | interesting = do | 319 | interesting = 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 | ||
383 | tryRequestMetadataBlock :: Wire Session () | 386 | tryRequestMetadataBlock :: Trigger |
384 | tryRequestMetadataBlock = do | 387 | tryRequestMetadataBlock = 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 | ||
390 | metadataCompleted :: InfoDict -> Wire Session () | 393 | metadataCompleted :: InfoDict -> Trigger |
391 | metadataCompleted dict = do | 394 | metadataCompleted 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 | |||
412 | handleMetadata (MetadataUnknown _ ) = do | 415 | handleMetadata (MetadataUnknown _ ) = do |
413 | logInfoN "Unknown metadata message" | 416 | logInfoN "Unknown metadata message" |
414 | 417 | ||
415 | waitForMetadata :: Wire Session () | 418 | waitForMetadata :: Trigger |
416 | waitForMetadata = do | 419 | waitForMetadata = 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 | ||
429 | acceptRehandshake :: ExtendedHandshake -> Wire s () | 432 | acceptRehandshake :: ExtendedHandshake -> Trigger |
430 | acceptRehandshake ehs = undefined | 433 | acceptRehandshake ehs = undefined |
431 | 434 | ||
432 | handleExtended :: Handler ExtendedMessage | 435 | handleExtended :: Handler ExtendedMessage |