From 74df228e2d8cbe27049f65a70253a59e67c7acc0 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Thu, 5 Dec 2013 04:10:45 +0400 Subject: Move Block module to exchange subsystem --- src/Data/Torrent/Block.hs | 163 ----------------------------- src/Data/Torrent/Layout.hs | 4 +- src/Network/BitTorrent/Exchange/Block.hs | 163 +++++++++++++++++++++++++++++ src/Network/BitTorrent/Exchange/Message.hs | 2 +- 4 files changed, 165 insertions(+), 167 deletions(-) delete mode 100644 src/Data/Torrent/Block.hs create mode 100644 src/Network/BitTorrent/Exchange/Block.hs (limited to 'src') diff --git a/src/Data/Torrent/Block.hs b/src/Data/Torrent/Block.hs deleted file mode 100644 index 88f7f352..00000000 --- a/src/Data/Torrent/Block.hs +++ /dev/null @@ -1,163 +0,0 @@ --- | --- Copyright : (c) Sam Truzjan 2013 --- License : BSD3 --- Maintainer : pxqr.sta@gmail.com --- Stability : experimental --- Portability : portable --- --- Blocks are used to transfer pieces. --- -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveDataTypeable #-} -{-# LANGUAGE GeneralizedNewtypeDeriving #-} -module Data.Torrent.Block - ( -- * Block attributes - BlockOffset - , BlockCount - , BlockSize - , defaultTransferSize - - -- * Block index - , BlockIx(..) - , blockIxRange - - -- * Block data - , Block(..) - , blockIx - , blockSize - , blockRange - , isPiece - ) where - -import Control.Applicative -import Data.Aeson.TH -import qualified Data.ByteString.Lazy as Lazy -import Data.Char -import Data.List as L -import Data.Serialize as S -import Data.Typeable -import Text.PrettyPrint -import Text.PrettyPrint.Class - -import Data.Torrent.Piece - -{----------------------------------------------------------------------- --- Block attributes ------------------------------------------------------------------------} - --- | 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. Some clients can ignore if --- block size of BlockIx in Request message is not equal to this --- value. --- -defaultTransferSize :: BlockSize -defaultTransferSize = 16 * 1024 - -{----------------------------------------------------------------------- - Block Index ------------------------------------------------------------------------} - --- | BlockIx correspond. -data BlockIx = BlockIx { - -- | Zero-based piece index. - ixPiece :: {-# UNPACK #-} !PieceIx - - -- | Zero-based byte offset within the piece. - , ixOffset :: {-# UNPACK #-} !BlockOffset - - -- | Block size starting from offset. - , ixLength :: {-# UNPACK #-} !BlockSize - } deriving (Show, Eq, Typeable) - -$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''BlockIx) - -getInt :: S.Get Int -getInt = fromIntegral <$> S.getWord32be -{-# INLINE getInt #-} - -putInt :: S.Putter Int -putInt = S.putWord32be . fromIntegral -{-# INLINE putInt #-} - -instance Serialize BlockIx where - {-# SPECIALIZE instance Serialize BlockIx #-} - get = BlockIx <$> getInt - <*> getInt - <*> getInt - {-# INLINE get #-} - - put BlockIx {..} = do - putInt ixPiece - putInt ixOffset - putInt ixLength - {-# INLINE put #-} - -instance Pretty BlockIx where - pretty BlockIx {..} = - "piece = " <> int ixPiece <> "," <+> - "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 #-} !PieceIx - - -- | Zero-based byte offset within the piece. - , blkOffset :: {-# UNPACK #-} !BlockOffset - - -- | Payload bytes. - , blkData :: !payload - } deriving (Show, Eq, Functor, Typeable) - --- | Payload is ommitted. -instance Pretty (Block Lazy.ByteString) where - pretty = pretty . blockIx - {-# INLINE pretty #-} - --- | Get size of block /payload/ in bytes. -blockSize :: Block Lazy.ByteString -> BlockSize -blockSize blk = fromIntegral (Lazy.length (blkData blk)) -{-# INLINE blockSize #-} - --- | Get block index of a block. -blockIx :: Block Lazy.ByteString -> BlockIx -blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize - --- | 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 #-} - --- | Test if a block can be safely turned into a piece. -isPiece :: PieceSize -> Block Lazy.ByteString -> Bool -isPiece pieceLen blk @ (Block i offset _) = - offset == 0 && blockSize blk == pieceLen && i >= 0 -{-# INLINE isPiece #-} diff --git a/src/Data/Torrent/Layout.hs b/src/Data/Torrent/Layout.hs index 7ed8679d..a32d74fa 100644 --- a/src/Data/Torrent/Layout.hs +++ b/src/Data/Torrent/Layout.hs @@ -81,8 +81,6 @@ import Text.PrettyPrint.Class import System.FilePath import System.Posix.Types -import Data.Torrent.Block - {----------------------------------------------------------------------- -- File attribytes @@ -274,7 +272,7 @@ fileCount MultiFile {..} = L.length liFiles -- | Find number of blocks of the specified size. If torrent size is -- not a multiple of block size then the count is rounded up. -blockCount :: BlockSize -> LayoutInfo -> Int +blockCount :: Int -> LayoutInfo -> Int blockCount blkSize ci = contentLength ci `sizeInBase` blkSize {----------------------------------------------------------------------- diff --git a/src/Network/BitTorrent/Exchange/Block.hs b/src/Network/BitTorrent/Exchange/Block.hs new file mode 100644 index 00000000..e99dd49d --- /dev/null +++ b/src/Network/BitTorrent/Exchange/Block.hs @@ -0,0 +1,163 @@ +-- | +-- Copyright : (c) Sam Truzjan 2013 +-- License : BSD3 +-- Maintainer : pxqr.sta@gmail.com +-- Stability : experimental +-- Portability : portable +-- +-- Blocks are used to transfer pieces. +-- +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +module Network.BitTorrent.Exchange.Block + ( -- * Block attributes + BlockOffset + , BlockCount + , BlockSize + , defaultTransferSize + + -- * Block index + , BlockIx(..) + , blockIxRange + + -- * Block data + , Block(..) + , blockIx + , blockSize + , blockRange + , isPiece + ) where + +import Control.Applicative +import Data.Aeson.TH +import qualified Data.ByteString.Lazy as Lazy +import Data.Char +import Data.List as L +import Data.Serialize as S +import Data.Typeable +import Text.PrettyPrint +import Text.PrettyPrint.Class + +import Data.Torrent.Piece + +{----------------------------------------------------------------------- +-- Block attributes +-----------------------------------------------------------------------} + +-- | 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. Some clients can ignore if +-- block size of BlockIx in Request message is not equal to this +-- value. +-- +defaultTransferSize :: BlockSize +defaultTransferSize = 16 * 1024 + +{----------------------------------------------------------------------- + Block Index +-----------------------------------------------------------------------} + +-- | BlockIx correspond. +data BlockIx = BlockIx { + -- | Zero-based piece index. + ixPiece :: {-# UNPACK #-} !PieceIx + + -- | Zero-based byte offset within the piece. + , ixOffset :: {-# UNPACK #-} !BlockOffset + + -- | Block size starting from offset. + , ixLength :: {-# UNPACK #-} !BlockSize + } deriving (Show, Eq, Typeable) + +$(deriveJSON defaultOptions { fieldLabelModifier = (L.map toLower . L.dropWhile isLower) } ''BlockIx) + +getInt :: S.Get Int +getInt = fromIntegral <$> S.getWord32be +{-# INLINE getInt #-} + +putInt :: S.Putter Int +putInt = S.putWord32be . fromIntegral +{-# INLINE putInt #-} + +instance Serialize BlockIx where + {-# SPECIALIZE instance Serialize BlockIx #-} + get = BlockIx <$> getInt + <*> getInt + <*> getInt + {-# INLINE get #-} + + put BlockIx {..} = do + putInt ixPiece + putInt ixOffset + putInt ixLength + {-# INLINE put #-} + +instance Pretty BlockIx where + pretty BlockIx {..} = + "piece = " <> int ixPiece <> "," <+> + "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 #-} !PieceIx + + -- | Zero-based byte offset within the piece. + , blkOffset :: {-# UNPACK #-} !BlockOffset + + -- | Payload bytes. + , blkData :: !payload + } deriving (Show, Eq, Functor, Typeable) + +-- | Payload is ommitted. +instance Pretty (Block Lazy.ByteString) where + pretty = pretty . blockIx + {-# INLINE pretty #-} + +-- | Get size of block /payload/ in bytes. +blockSize :: Block Lazy.ByteString -> BlockSize +blockSize blk = fromIntegral (Lazy.length (blkData blk)) +{-# INLINE blockSize #-} + +-- | Get block index of a block. +blockIx :: Block Lazy.ByteString -> BlockIx +blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize + +-- | 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 #-} + +-- | Test if a block can be safely turned into a piece. +isPiece :: PieceSize -> Block Lazy.ByteString -> Bool +isPiece pieceLen blk @ (Block i offset _) = + offset == 0 && blockSize blk == pieceLen && i >= 0 +{-# INLINE isPiece #-} diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs index 2f85d729..8a88b761 100644 --- a/src/Network/BitTorrent/Exchange/Message.hs +++ b/src/Network/BitTorrent/Exchange/Message.hs @@ -90,10 +90,10 @@ import Text.PrettyPrint as PP import Text.PrettyPrint.Class import Data.Torrent.Bitfield -import Data.Torrent.Block import Data.Torrent.InfoHash import Network.BitTorrent.Core.PeerId import Network.BitTorrent.Core.PeerAddr () +import Network.BitTorrent.Exchange.Block {----------------------------------------------------------------------- -- Extensions -- cgit v1.2.3