Types.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Conjure.Types
-- Copyright   :  (c) Lemmih 2005-2006
-- License     :  BSD-like
--
-- Maintainer  :  lemmih@gmail.com
-- Stability   :  experimental
-- Portability :  non-portable (requires STM)
--
-----------------------------------------------------------------------------
module Conjure.Types
    ( module Conjure.Types
    , PeerId (..)
    ) where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Data.Array.Diff
import Network.URI
import Data.IntMap (IntMap)
import Data.Map (Map)
import Data.Set (Set)
import System.IO
import Data.ByteString (ByteString)
import Conjure.Protocol.PWP.Types

type Piecemap = DiffArray Int Bool

type Usecount = DiffUArray Int Int

data Torrent
    = Torrent
    { tAnnounce     :: URI
    , tAnnounceList :: [URI]
    , tComment      :: String
    , tCreatedBy    :: Maybe String
--    , tCreationData :: ? -- FIXME
    , tInfo         :: TorrentInfo
    , tInfoHash     :: ByteString
    } deriving Show

data TorrentInfo
    = SingleFile
    { tLength      :: Int
    , tName        :: String
    , tPieceLength :: Int
    , tPieces      :: ByteString }
    | MultiFile
    { tFiles       :: [TorrentFile]
    , tName        :: String
    , tPieceLength :: Int
    , tPieces      :: ByteString
    } deriving Show

data TorrentFile
    = TorrentFile
    { fileLength :: Int
    , filePath   :: FilePath
    } deriving Show

data Backend
    = Backend
    { close       :: IO ()
--    , sendPiece   :: Int -> Handle -> IO ()
    , readPiece   :: Int -> IO ByteString
    , readPiece'  :: Int -> IO (Maybe ByteString)
    , writeBlock  :: Int -> Int -> ByteString -> IO ()
    , readBlock   :: Int -> Int -> Int -> IO ByteString
    , commitPiece :: Int -> IO ()
    }

data PeerCtrl
    = NewInput Message     -- Received a new message.
    | Disconnect
    | SockError Exception  -- Error occurred while waiting for input.
--      deriving Show

data OutputCtrl
    = SendMessage Message
    | SendPiece !Int !Int !Int -- idx, offset, len
    | ClearPiece !Int !Int !Int -- idx, offset, len
    | ClearPieces

{-
data UploadStatus
    = Inactive
    | Regular
    | Seeding ClockTime
    | Optimistic ClockTime
-}

data ConnectedPeer
    = ConnectedPeer
    { cpThreads         :: TVar (Set ThreadId)
    , cpMsgChan         :: TChan PeerCtrl
    , cpOutChan         :: TChan OutputCtrl
    , cpPeerId          :: PeerId
    , cpTorrent         :: Torrent
    , cpPiecemap        :: TVar Piecemap
    , cpLocalChoke      :: TVar Bool
    , cpRemoteChoke     :: TVar Bool
    , cpLocalInterest   :: TVar Bool
    , cpRemoteInterest  :: TVar Bool
    , cpUploadTimings   :: TVar Timing
    , cpDownloadTimings :: TVar Timing
    , cpPendingBlocks   :: TVar (Map (Int,Int) Block)
    , cpQueueLength     :: TVar Int
      -- ^ How many pending blocks we want. FIXME: Should this be global?
--    , cpUploadStatus    :: TVar UploadStatus
    }

instance Eq ConnectedPeer where
    cp1 == cp2 = cpPeerId cp1 == cpPeerId cp2

instance Ord ConnectedPeer where
    cp1 `compare` cp2 = cpPeerId cp1 `compare` cpPeerId cp2

data Timing
    = Timing { lastTiming :: Integer       -- Last recorded measurement in millieseconds.
             , timings :: [(Integer, Int)] -- time of measurement in millieseconds, bytes transferred.
             } 

data ActiveTorrent
    = ActiveTorrent
    { atTorrent    :: Torrent
    , atClient     :: ThreadId
    , atBackend    :: Backend
    , atPeerId     :: PeerId               -- Local peerid for this torrent.
                                           -- We keep a distinct peerid for each torrent.
    , atUsecount   :: TVar Usecount
    , atPiecemap   :: TVar Piecemap
    , atPieces     :: TVar (IntMap Piece)
    , atPeers      :: TVar [ConnectedPeer] -- Use a Set or Sequence?
    , atDownloaded :: TVar Integer
    , atUploaded   :: TVar Integer
    , atLeft       :: TVar Integer
    }

-- FIXME: Use a Set?
data BlockStatus
    = Active [ConnectedPeer]
    | Downloaded

instance Show BlockStatus where
    show (Active lst) = "(Active " ++ show (length lst) ++ ")"
    show Downloaded = "Downloaded"

data Piece
    = Piece
    { pIndex  :: Int
    , pStatus :: TVar [BlockStatus]
    }

instance Eq Piece where
    p1 == p2 = pIndex p1 == pIndex p2

instance Show Piece where
    showsPrec n p = showString "Piece " . showsPrec n (pIndex p)

type Block = (Piece,Int,Int) -- (Piece, offset, length)