HaskellTorrent-0.1: src/Process/Status.hs

-- | The status code runs a Status Process. This process keeps track
--   of a number of interval valies for a given torrent file and it
--   periodically updates the tracker process with the relevant
--   information about data uploaded, downloaded and how much is
--   left. The tracker is then responsible for using this data
--   correctly to tell the tracker what to do
module Process.Status (
    -- * Types
      StatusMsg(..)
    , TrackerMsg(..)
    -- * Channels
    , StatusChan
    -- * State
    , ST(uploaded, downloaded, state, left)
    -- * Interface
    , start
    )
where

import Control.Concurrent
import Control.Concurrent.CML

import Control.Monad.State

import Prelude hiding (log)
import Process
import Supervisor
import Torrent

data StatusMsg = TrackerStat { trackIncomplete :: Maybe Integer
                             , trackComplete   :: Maybe Integer }
               | CompletedPiece Integer
               | PeerStat { peerUploaded :: Integer
                          , peerDownloaded :: Integer }
               | TorrentCompleted

type StatusChan = Channel StatusMsg

-- | TrackerChannel is the channel of the tracker
data TrackerMsg = Stop | TrackerTick Integer | Start | Complete

data CF  = CF { statusCh :: Channel StatusMsg
              , trackerCh1 :: Channel TrackerMsg
              , trackerCh :: Channel ST }

instance Logging CF where
    logName _ = "Process.Status"

data ST = ST { uploaded :: Integer,
               downloaded :: Integer,
               left :: Integer,
               incomplete :: Maybe Integer,
               complete :: Maybe Integer,
               state :: TorrentState }
    deriving Show

-- | Start a new Status process with an initial torrent state and a
--   channel on which to transmit status updates to the tracker.
start :: Integer -> TorrentState -> Channel ST
      -> Channel StatusMsg -> Channel TrackerMsg -> SupervisorChan -> IO ThreadId
start l tState trackerC statusC trackerC1 supC = do
    spawnP (CF statusC trackerC1 trackerC) (ST 0 0 l Nothing Nothing tState)
        (catchP (foreverP pgm) (defaultStopHandler supC))
  where
    pgm = syncP =<< chooseP [sendEvent, recvEvent]
    sendEvent = get >>= sendPC trackerCh
    recvEvent = do evt <- recvPC statusCh
                   wrapP evt (\m ->
                    case m of
                        TrackerStat ic c ->
                           modify (\s -> s { incomplete = ic, complete = c })
                        CompletedPiece bytes -> do
                            debugP "StatusProcess updated left"
                            modify (\s -> s { left = (left s) - bytes })
                        PeerStat up down -> do
                           modify (\s -> s { uploaded = (uploaded s) + up,
                                             downloaded = (downloaded s) + down })
                           u <- gets uploaded
                           d <- gets downloaded
                           debugP $ "StatusProcess up/down count: " ++ show u ++ ", " ++ show d
                        TorrentCompleted -> do
                           debugP "TorrentCompletion at StatusP"
                           l <- gets left
                           when (l /= 0) (fail "Warning: Left is not 0 upon Torrent Completion")
                           syncP =<< sendPC trackerCh1 Complete
                           modify (\s -> s { state = Seeding }))