From 13c8d6c7f3e26c384e77c7eaab217acd1253bb3b Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Fri, 1 Nov 2013 12:28:06 +0400 Subject: Document Block module --- src/Data/Torrent/Block.hs | 99 +++++++++++++++++++++++++++-------------------- src/Data/Torrent/Piece.hs | 70 +++++++++++++++------------------ 2 files changed, 88 insertions(+), 81 deletions(-) (limited to 'src/Data') diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs index 17907a39..affbfa78 100644 --- a/src/Data/Torrent/Block.hs +++ b/src/Data/Torrent/Block.hs @@ -5,39 +5,39 @@ -- Stability : experimental -- Portability : portable -- --- TODO +-- Blocks are used to transfer pieces. -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-} module Data.Torrent.Block - ( -- * Block attributes - BlockLIx - , PieceLIx + ( -- * Piece attributes + PieceIx + , PieceSize + + -- * Block attributes + , BlockOffset + , BlockCount , BlockSize , defaultTransferSize -- * Block index , BlockIx(..) , ppBlockIx + , blockIxRange -- * Block data , Block(..) , ppBlock - , blockSize - , pieceIx , blockIx + , blockSize , blockRange - , ixRange - , isPiece ) where import Control.Applicative -import Data.Aeson (ToJSON, FromJSON) import Data.Aeson.TH import qualified Data.ByteString.Lazy as Lazy import Data.Char -import Data.Default import Data.List as L import Data.Binary as B @@ -48,15 +48,38 @@ import Data.Serialize as S import Text.PrettyPrint +{----------------------------------------------------------------------- +-- Piece attributes +-----------------------------------------------------------------------} + +-- | Zero-based index of piece in torrent content. +type PieceIx = Int + +-- | Size of piece in bytes. Should be a power of 2. +type PieceSize = Int + {----------------------------------------------------------------------- -- Block attributes -----------------------------------------------------------------------} -type BlockSize = Int -type BlockLIx = Int -type PieceLIx = Int +-- | Offset of a block in a piece in bytes. Should be multiple of +-- the choosen block size. +type BlockOffset = Int + +-- | Size of a block in bytes. Should be power of 2. +-- +-- Normally block size is equal to 'defaultTransferSize'. +-- +type BlockSize = Int + +-- | Number of block in a piece of a torrent. Used to distinguish +-- block count from piece count. +type BlockCount = Int --- | Widely used semi-official block size. +-- | Widely used semi-official block size. Some clients can ignore if +-- block size of BlockIx in Request message is not equal to this +-- value. +-- defaultTransferSize :: BlockSize defaultTransferSize = 16 * 1024 @@ -64,12 +87,13 @@ defaultTransferSize = 16 * 1024 Block Index -----------------------------------------------------------------------} +-- | BlockIx correspond. data BlockIx = BlockIx { -- | Zero-based piece index. - ixPiece :: {-# UNPACK #-} !PieceLIx + ixPiece :: {-# UNPACK #-} !PieceIx -- | Zero-based byte offset within the piece. - , ixOffset :: {-# UNPACK #-} !Int + , ixOffset :: {-# UNPACK #-} !BlockOffset -- | Block size starting from offset. , ixLength :: {-# UNPACK #-} !BlockSize @@ -125,16 +149,25 @@ ppBlockIx BlockIx {..} = "offset = " <> int ixOffset <> "," <+> "length = " <> int ixLength +-- | Get location of payload bytes in the torrent content. +blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a) +blockIxRange pieceSize BlockIx {..} = (offset, offset + len) + where + offset = fromIntegral pieceSize * fromIntegral ixPiece + + fromIntegral ixOffset + len = fromIntegral ixLength +{-# INLINE blockIxRange #-} + {----------------------------------------------------------------------- Block -----------------------------------------------------------------------} data Block payload = Block { -- | Zero-based piece index. - blkPiece :: {-# UNPACK #-} !PieceLIx + blkPiece :: {-# UNPACK #-} !PieceIx -- | Zero-based byte offset within the piece. - , blkOffset :: {-# UNPACK #-} !Int + , blkOffset :: {-# UNPACK #-} !BlockOffset -- | Payload bytes. , blkData :: !payload @@ -145,36 +178,16 @@ ppBlock :: Block Lazy.ByteString -> Doc ppBlock = ppBlockIx . blockIx {-# INLINE ppBlock #-} +-- | Get size of block /payload/ in bytes. blockSize :: Block Lazy.ByteString -> BlockSize blockSize blk = fromIntegral (Lazy.length (blkData blk)) {-# INLINE blockSize #-} -isPiece :: Int -> Block Lazy.ByteString -> Bool -isPiece pieceSize (Block i offset bs) = - offset == 0 - && fromIntegral (Lazy.length bs) == pieceSize - && i >= 0 -{-# INLINE isPiece #-} - -pieceIx :: Int -> Int -> BlockIx -pieceIx i = BlockIx i 0 -{-# INLINE pieceIx #-} - +-- | Get block index of a block. blockIx :: Block Lazy.ByteString -> BlockIx blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize -blockRange :: (Num a, Integral a) => Int -> Block Lazy.ByteString -> (a, a) -blockRange pieceSize blk = (offset, offset + len) - where - offset = fromIntegral pieceSize * fromIntegral (blkPiece blk) - + fromIntegral (blkOffset blk) - len = fromIntegral (Lazy.length (blkData blk)) +-- | Get location of payload bytes in the torrent content. +blockRange :: (Num a, Integral a) => PieceSize -> Block Lazy.ByteString -> (a, a) +blockRange pieceSize = blockIxRange pieceSize . blockIx {-# INLINE blockRange #-} - -ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a) -ixRange pieceSize i = (offset, offset + len) - where - offset = fromIntegral pieceSize * fromIntegral (ixPiece i) - + fromIntegral (ixOffset i) - len = fromIntegral (ixLength i) -{-# INLINE ixRange #-} diff --git a/src/Data/Torrent/Piece.hs b/src/Data/Torrent/Piece.hs index 27bc4879..572b136f 100644 --- a/src/Data/Torrent/Piece.hs +++ b/src/Data/Torrent/Piece.hs @@ -5,7 +5,7 @@ -- Stability : experimental -- Portability : portable -- --- Torrent content validation. +-- Pieces are used to validate torrent content. -- {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} @@ -14,12 +14,16 @@ module Data.Torrent.Piece ( -- * Piece attributes PieceIx , PieceCount - , PieceSize (..) + , PieceSize , defaultPieceSize + , maxPieceSize + , minPieceSize -- * Piece data , Piece (..) , ppPiece + , pieceSize + , isPiece -- * Piece control , PieceInfo (..) @@ -48,7 +52,6 @@ import Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Base64 as Base64 import Data.Char -import Data.Default import Data.Int import Data.List as L import Data.Text.Encoding as T @@ -61,25 +64,18 @@ import Data.Torrent.Block class Lint a where lint :: a -> Either String a -type PieceIx = Int -- TODO remove +-- | Number of pieces in torrent or a part of torrent. +type PieceCount = Int -newtype PieceCount = PieceCount { unPieceCount :: Int } - --- | TODO -instance Default PieceCount where - def = PieceCount 1000 - {-# INLINE def #-} - -newtype PieceIndex = PieceIndex Int - --- | An int used to denote piece size. -newtype PieceSize = PieceSize Int - deriving (Show, Read, Typeable - , Eq, Ord, Enum - , Num, Real, Integral - , BEncode, ToJSON, FromJSON - ) +-- | Optimal number of pieces in torrent. +optimalPieceCount :: PieceCount +optimalPieceCount = 1000 +{-# INLINE optimalPieceCount #-} +-- | NOTE: Have max and min size constrained to wide used +-- semi-standard values. This bounds should be used to make decision +-- about piece size for new torrents. +-- maxPieceSize :: Int maxPieceSize = 4 * 1024 * 1024 {-# INLINE maxPieceSize #-} @@ -88,18 +84,6 @@ minPieceSize :: Int minPieceSize = defaultTransferSize * 4 {-# INLINE minPieceSize #-} --- | NOTE: Have max and min size constrained to wide used --- semi-standard values. This bounds should be used to make decision --- about piece size for new torrents. --- -instance Bounded PieceSize where - maxBound = PieceSize maxPieceSize - {-# INLINE maxBound #-} - - minBound = PieceSize minPieceSize - {-# INLINE minBound #-} - - toPow2 :: Int -> Int toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x) @@ -107,13 +91,14 @@ toPow2 x = bit $ fromIntegral (leadingZeros (0 :: Int) - leadingZeros x) defaultPieceSize :: Int64 -> Int defaultPieceSize x = max minPieceSize $ min maxPieceSize $ toPow2 pc where - pc = fromIntegral (x `div` fromIntegral (unPieceCount def)) + pc = fromIntegral (x `div` fromIntegral optimalPieceCount) -- TODO check if pieceLength is power of 2 -- | Piece payload should be strict or lazy bytestring. data Piece a = Piece - { -- | Zero-based piece index in torrent. TODO how pieces are indexed? + { -- | Zero-based piece index in torrent. pieceIndex :: {-# UNPACK #-} !PieceIx + -- | Payload. , pieceData :: !a } deriving (Show, Read, Eq, Typeable) @@ -127,6 +112,16 @@ ppPiece :: Piece a -> Doc ppPiece Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex) +-- | Get size of piece in bytes. +pieceSize :: Piece BL.ByteString -> PieceSize +pieceSize Piece {..} = fromIntegral (BL.length pieceData) + +-- | Test if a block can be safely turned into a piece. +isPiece :: PieceSize -> Block BL.ByteString -> Bool +isPiece pieceSize blk @ (Block i offset _) = + offset == 0 && blockSize blk == pieceSize && i >= 0 +{-# INLINE isPiece #-} + newtype HashArray = HashArray { unHashArray :: ByteString } deriving (Show, Read, Eq, BEncode) @@ -181,7 +176,7 @@ instance BEncode PieceInfo where -- | Format piece info in human readable form. Hashes are omitted. ppPieceInfo :: PieceInfo -> Doc -ppPieceInfo PieceInfo { piPieceLength = PieceSize len } = +ppPieceInfo PieceInfo { piPieceLength = len } = "PieceInfo" <+> braces ("length" <+> "=" <+> int len) hashsize :: Int @@ -199,11 +194,10 @@ pieceHash PieceInfo {..} i = slice (hashsize * i) hashsize (unHashArray piPieceH -- | Find count of pieces in the torrent. If torrent size is not a -- multiple of piece size then the count is rounded up. pieceCount :: PieceInfo -> PieceCount -pieceCount PieceInfo {..} - = PieceCount (BS.length (unHashArray piPieceHashes) `quot` hashsize) +pieceCount PieceInfo {..} = BS.length (unHashArray piPieceHashes) `quot` hashsize isLastPiece :: PieceInfo -> PieceIx -> Bool -isLastPiece ci i = unPieceCount (pieceCount ci) == succ i +isLastPiece ci i = pieceCount ci == succ i class Validation a where validate :: PieceInfo -> Piece a -> Bool -- cgit v1.2.3