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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
{-# LANGUAGE TemplateHaskell #-}
module Data.Torrent.Block
( -- * Block attribytes
BlockLIx
, PieceLIx
-- * Block index
, BlockIx(..)
, ppBlockIx
-- * Block data
, Block(..)
, ppBlock
, blockSize
, pieceIx
, blockIx
, blockRange
, ixRange
, 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.Binary as B
import Data.Binary.Get as B
import Data.Binary.Put as B
import Data.Serialize as S
import Text.PrettyPrint
{-----------------------------------------------------------------------
Block Index
-----------------------------------------------------------------------}
type BlockLIx = Int
type PieceLIx = 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)
$(deriveJSON (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 #-}
getIntB :: B.Get Int
getIntB = fromIntegral <$> B.getWord32be
{-# INLINE getIntB #-}
putIntB :: Int -> B.Put
putIntB = B.putWord32be . fromIntegral
{-# INLINE putIntB #-}
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 Binary BlockIx where
{-# SPECIALIZE instance Binary BlockIx #-}
get = BlockIx <$> getIntB <*> getIntB <*> getIntB
{-# INLINE get #-}
put BlockIx {..} = do
putIntB ixPiece
putIntB ixOffset
putIntB ixLength
-- | Format block index in human readable form.
ppBlockIx :: BlockIx -> Doc
ppBlockIx BlockIx {..} =
"piece = " <> int ixPiece <> "," <+>
"offset = " <> int ixOffset <> "," <+>
"length = " <> int ixLength
{-----------------------------------------------------------------------
Block
-----------------------------------------------------------------------}
data Block payload = Block {
-- | Zero-based piece index.
blkPiece :: {-# UNPACK #-} !PieceLIx
-- | Zero-based byte offset within the piece.
, blkOffset :: {-# UNPACK #-} !Int
-- | Payload bytes.
, blkData :: !payload
} deriving (Show, Eq)
-- | Format block in human readable form. Payload is ommitted.
ppBlock :: Block Lazy.ByteString -> Doc
ppBlock = ppBlockIx . blockIx
{-# INLINE ppBlock #-}
blockSize :: Block Lazy.ByteString -> Int
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 #-}
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))
{-# 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 #-}
|
