summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/PeerWire/Block.hs
blob: dea373217d3e85f5fefd2b61e71765ae5da5e052 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.BitTorrent.PeerWire.Block
       ( BlockIx(..)
       , Block(..), blockSize
       , PieceIx
       , BlockLIx, PieceLIx
       , defaultBlockSize
       , pieceIx, blockIx
       , blockRange, ixRange, isPiece
       , ppBlockIx, ppBlock

       , putInt, getInt
       ) where

import Control.Applicative
import           Data.ByteString (ByteString)
import qualified Data.ByteString as B
import Data.Int
import Data.Serialize
import Text.PrettyPrint


type BlockLIx = Int
type PieceLIx = Int
type PieceIx = Int

data BlockIx = BlockIx {
    -- | Zero-based piece index.
    ixPiece  :: {-# UNPACK #-} !PieceLIx

    -- | Zero-based byte offset within the piece.
  , ixOffset :: {-# UNPACK #-} !Int

    -- | Block size starting from offset.
  , ixLength :: {-# UNPACK #-} !Int
  } deriving (Show, Eq)

getInt :: Get Int
getInt = fromIntegral <$> getWord32be
{-# INLINE getInt #-}

putInt :: Putter Int
putInt = putWord32be . fromIntegral
{-# INLINE putInt #-}

instance Serialize BlockIx where
  {-# SPECIALIZE instance Serialize BlockIx #-}
  get = BlockIx <$> getInt <*> getInt <*> getInt
  {-# INLINE get #-}

  put ix = do putInt (ixPiece ix)
              putInt (ixOffset ix)
              putInt (ixLength ix)
  {-# INLINE put #-}

ppBlockIx :: BlockIx -> Doc
ppBlockIx BlockIx {..} =
  "piece  = " <> int ixPiece  <> "," <+>
  "offset = " <> int ixOffset <> "," <+>
  "length = " <> int ixLength

data Block = Block {
    -- | Zero-based piece index.
    blkPiece  :: PieceLIx

    -- | Zero-based byte offset within the piece.
  , blkOffset :: Int

    -- | Payload.
  , blkData   :: ByteString
  } deriving (Show, Eq)

ppBlock :: Block -> Doc
ppBlock = ppBlockIx . blockIx

blockSize :: Block -> Int
blockSize blk = B.length (blkData blk)

-- | Widely used semi-official block size.
defaultBlockSize :: Int
defaultBlockSize = 16 * 1024


isPiece :: Int -> Block -> Bool
isPiece pieceSize (Block i offset bs) =
  offset == 0 && B.length bs == pieceSize && i >= 0
{-# INLINE isPiece #-}

pieceIx :: Int -> Int -> BlockIx
pieceIx i = BlockIx i 0
{-# INLINE pieceIx #-}

blockIx :: Block -> BlockIx
blockIx = BlockIx <$> blkPiece <*> blkOffset <*> B.length . blkData

blockRange :: (Num a, Integral a) => Int -> Block -> (a, a)
blockRange pieceSize blk = (offset, offset + len)
  where
    offset = fromIntegral pieceSize * fromIntegral (blkPiece blk)
           + fromIntegral (blkOffset blk)
    len    = fromIntegral (B.length (blkData blk))
{-# INLINE blockRange #-}
{-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-}

ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
ixRange pieceSize ix = (offset, offset + len)
  where
    offset = fromIntegral  pieceSize * fromIntegral (ixPiece ix)
           + fromIntegral (ixOffset ix)
    len    = fromIntegral (ixLength ix)
{-# INLINE ixRange #-}
{-# SPECIALIZE ixRange :: Int -> BlockIx -> (Int64, Int64) #-}