diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-08-16 08:50:08 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-08-16 08:50:08 +0400 |
commit | 6bb92a610c4874ea3fa37fb15cd55c48f219d6ed (patch) | |
tree | e9362f06242d11a55cade4d8705155c6d388a85e /src/Network/BitTorrent/Exchange/Protocol.hs | |
parent | 1c19636c20e918388ef7f16faa8c6fb617d917d8 (diff) |
~ Remove torrent-content modules.
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Protocol.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 152 |
1 files changed, 18 insertions, 134 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs index 00b6795b..3b2472da 100644 --- a/src/Network/BitTorrent/Exchange/Protocol.hs +++ b/src/Network/BitTorrent/Exchange/Protocol.hs | |||
@@ -37,16 +37,6 @@ module Network.BitTorrent.Exchange.Protocol | |||
37 | , defaultHandshake, defaultBTProtocol, defaultReserved | 37 | , defaultHandshake, defaultBTProtocol, defaultReserved |
38 | , handshakeMaxSize | 38 | , handshakeMaxSize |
39 | 39 | ||
40 | -- * Block | ||
41 | , PieceIx, BlockLIx, PieceLIx | ||
42 | , BlockIx(..), ppBlockIx | ||
43 | , Block(..), ppBlock ,blockSize | ||
44 | , pieceIx, blockIx | ||
45 | , blockRange, ixRange, isPiece | ||
46 | |||
47 | -- ** Defaults | ||
48 | , defaultBlockSize | ||
49 | |||
50 | -- * Regular messages | 40 | -- * Regular messages |
51 | , Message(..) | 41 | , Message(..) |
52 | , ppMessage | 42 | , ppMessage |
@@ -89,12 +79,28 @@ import Text.PrettyPrint | |||
89 | import Network | 79 | import Network |
90 | import Network.Socket.ByteString | 80 | import Network.Socket.ByteString |
91 | 81 | ||
92 | import Data.Bitfield | 82 | import Data.Torrent.Bitfield |
93 | import Data.Torrent | 83 | import Data.Torrent.Block |
84 | import Data.Torrent.Metainfo | ||
94 | import Network.BitTorrent.Extension | 85 | import Network.BitTorrent.Extension |
95 | import Network.BitTorrent.Peer | 86 | import Network.BitTorrent.Peer |
96 | 87 | ||
97 | 88 | ||
89 | getInt :: S.Get Int | ||
90 | getInt = fromIntegral <$> S.getWord32be | ||
91 | {-# INLINE getInt #-} | ||
92 | |||
93 | putInt :: S.Putter Int | ||
94 | putInt = S.putWord32be . fromIntegral | ||
95 | {-# INLINE putInt #-} | ||
96 | |||
97 | getIntB :: B.Get Int | ||
98 | getIntB = fromIntegral <$> B.getWord32be | ||
99 | {-# INLINE getIntB #-} | ||
100 | |||
101 | putIntB :: Int -> B.Put | ||
102 | putIntB = B.putWord32be . fromIntegral | ||
103 | {-# INLINE putIntB #-} | ||
98 | 104 | ||
99 | {----------------------------------------------------------------------- | 105 | {----------------------------------------------------------------------- |
100 | Handshake | 106 | Handshake |
@@ -196,128 +202,6 @@ handshake sock hs = do | |||
196 | return hs' | 202 | return hs' |
197 | 203 | ||
198 | {----------------------------------------------------------------------- | 204 | {----------------------------------------------------------------------- |
199 | Block Index | ||
200 | -----------------------------------------------------------------------} | ||
201 | |||
202 | type BlockLIx = Int | ||
203 | type PieceLIx = Int | ||
204 | |||
205 | |||
206 | data BlockIx = BlockIx { | ||
207 | -- | Zero-based piece index. | ||
208 | ixPiece :: {-# UNPACK #-} !PieceLIx | ||
209 | |||
210 | -- | Zero-based byte offset within the piece. | ||
211 | , ixOffset :: {-# UNPACK #-} !Int | ||
212 | |||
213 | -- | Block size starting from offset. | ||
214 | , ixLength :: {-# UNPACK #-} !Int | ||
215 | } deriving (Show, Eq) | ||
216 | |||
217 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''BlockIx) | ||
218 | |||
219 | getInt :: S.Get Int | ||
220 | getInt = fromIntegral <$> S.getWord32be | ||
221 | {-# INLINE getInt #-} | ||
222 | |||
223 | putInt :: S.Putter Int | ||
224 | putInt = S.putWord32be . fromIntegral | ||
225 | {-# INLINE putInt #-} | ||
226 | |||
227 | getIntB :: B.Get Int | ||
228 | getIntB = fromIntegral <$> B.getWord32be | ||
229 | {-# INLINE getIntB #-} | ||
230 | |||
231 | putIntB :: Int -> B.Put | ||
232 | putIntB = B.putWord32be . fromIntegral | ||
233 | {-# INLINE putIntB #-} | ||
234 | |||
235 | instance Serialize BlockIx where | ||
236 | {-# SPECIALIZE instance Serialize BlockIx #-} | ||
237 | get = BlockIx <$> getInt <*> getInt <*> getInt | ||
238 | {-# INLINE get #-} | ||
239 | |||
240 | put i = do putInt (ixPiece i) | ||
241 | putInt (ixOffset i) | ||
242 | putInt (ixLength i) | ||
243 | {-# INLINE put #-} | ||
244 | |||
245 | instance Binary BlockIx where | ||
246 | {-# SPECIALIZE instance Binary BlockIx #-} | ||
247 | get = BlockIx <$> getIntB <*> getIntB <*> getIntB | ||
248 | {-# INLINE get #-} | ||
249 | |||
250 | put BlockIx {..} = do | ||
251 | putIntB ixPiece | ||
252 | putIntB ixOffset | ||
253 | putIntB ixLength | ||
254 | |||
255 | -- | Format block index in human readable form. | ||
256 | ppBlockIx :: BlockIx -> Doc | ||
257 | ppBlockIx BlockIx {..} = | ||
258 | "piece = " <> int ixPiece <> "," <+> | ||
259 | "offset = " <> int ixOffset <> "," <+> | ||
260 | "length = " <> int ixLength | ||
261 | |||
262 | {----------------------------------------------------------------------- | ||
263 | Block | ||
264 | -----------------------------------------------------------------------} | ||
265 | |||
266 | data Block = Block { | ||
267 | -- | Zero-based piece index. | ||
268 | blkPiece :: {-# UNPACK #-} !PieceLIx | ||
269 | |||
270 | -- | Zero-based byte offset within the piece. | ||
271 | , blkOffset :: {-# UNPACK #-} !Int | ||
272 | |||
273 | -- | Payload. | ||
274 | , blkData :: !Lazy.ByteString | ||
275 | } deriving (Show, Eq) | ||
276 | |||
277 | -- | Format block in human readable form. Payload is ommitted. | ||
278 | ppBlock :: Block -> Doc | ||
279 | ppBlock = ppBlockIx . blockIx | ||
280 | |||
281 | blockSize :: Block -> Int | ||
282 | blockSize blk = fromIntegral (Lazy.length (blkData blk)) | ||
283 | {-# INLINE blockSize #-} | ||
284 | |||
285 | -- | Widely used semi-official block size. | ||
286 | defaultBlockSize :: Int | ||
287 | defaultBlockSize = 16 * 1024 | ||
288 | |||
289 | |||
290 | isPiece :: Int -> Block -> Bool | ||
291 | isPiece pieceSize (Block i offset bs) = | ||
292 | offset == 0 | ||
293 | && fromIntegral (Lazy.length bs) == pieceSize | ||
294 | && i >= 0 | ||
295 | {-# INLINE isPiece #-} | ||
296 | |||
297 | pieceIx :: Int -> Int -> BlockIx | ||
298 | pieceIx i = BlockIx i 0 | ||
299 | {-# INLINE pieceIx #-} | ||
300 | |||
301 | blockIx :: Block -> BlockIx | ||
302 | blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize | ||
303 | |||
304 | blockRange :: (Num a, Integral a) => Int -> Block -> (a, a) | ||
305 | blockRange pieceSize blk = (offset, offset + len) | ||
306 | where | ||
307 | offset = fromIntegral pieceSize * fromIntegral (blkPiece blk) | ||
308 | + fromIntegral (blkOffset blk) | ||
309 | len = fromIntegral (Lazy.length (blkData blk)) | ||
310 | {-# INLINE blockRange #-} | ||
311 | |||
312 | ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a) | ||
313 | ixRange pieceSize i = (offset, offset + len) | ||
314 | where | ||
315 | offset = fromIntegral pieceSize * fromIntegral (ixPiece i) | ||
316 | + fromIntegral (ixOffset i) | ||
317 | len = fromIntegral (ixLength i) | ||
318 | {-# INLINE ixRange #-} | ||
319 | |||
320 | {----------------------------------------------------------------------- | ||
321 | Regular messages | 205 | Regular messages |
322 | -----------------------------------------------------------------------} | 206 | -----------------------------------------------------------------------} |
323 | 207 | ||