QueueManager.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Conjure.Logic.BlockSelector
-- Copyright   :  (c) Lemmih 2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-- The queue manager runs in a thread for each connected peer. It's job it to
-- keep block queue full with the right blocks for every peer.
-----------------------------------------------------------------------------
module Conjure.Logic.QueueManager
    ( queueManager
    ) where

import Conjure.Types
import Conjure.Utils
import Conjure.Logic.BlockManagement
import Conjure.STM.PeerCtrl
import Conjure.Debug

import Control.Concurrent.STM
import Control.Monad                   (forever, when)

import qualified Data.Map as Map

queueManager :: ActiveTorrent -> ConnectedPeer -> IO ()
queueManager at peer
    = forever $ atomically $
      do stmTransactionName "QueueManager"
         rc <- getRemoteChoke peer
         si <- getLocalInterest peer
         when (rc || not si) retry
         limit <- readTVar (cpQueueLength peer)
         blocks <- readTVar pendingBlocks
         when (Map.size blocks >= limit) retry
         mbBlock <- requestNewBlock at peer
         case mbBlock of
           Nothing -> do stmDebug "Out of blocks."
                         retry
           Just block@(piece,offset,_)
               -> let newBlocks = Map.insert (pIndex piece,offset) block blocks
                  in do --stmDebug $ "I want this block: " ++ show (pIndex piece, offset)
                        writeTVar pendingBlocks newBlocks
                        sendRequest peer block
    where pendingBlocks = cpPendingBlocks peer