summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Protocol.hs
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-08-16 08:50:08 +0400
committerSam T <pxqr.sta@gmail.com>2013-08-16 08:50:08 +0400
commit6bb92a610c4874ea3fa37fb15cd55c48f219d6ed (patch)
treee9362f06242d11a55cade4d8705155c6d388a85e /src/Network/BitTorrent/Exchange/Protocol.hs
parent1c19636c20e918388ef7f16faa8c6fb617d917d8 (diff)
~ Remove torrent-content modules.
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Protocol.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs152
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
89import Network 79import Network
90import Network.Socket.ByteString 80import Network.Socket.ByteString
91 81
92import Data.Bitfield 82import Data.Torrent.Bitfield
93import Data.Torrent 83import Data.Torrent.Block
84import Data.Torrent.Metainfo
94import Network.BitTorrent.Extension 85import Network.BitTorrent.Extension
95import Network.BitTorrent.Peer 86import Network.BitTorrent.Peer
96 87
97 88
89getInt :: S.Get Int
90getInt = fromIntegral <$> S.getWord32be
91{-# INLINE getInt #-}
92
93putInt :: S.Putter Int
94putInt = S.putWord32be . fromIntegral
95{-# INLINE putInt #-}
96
97getIntB :: B.Get Int
98getIntB = fromIntegral <$> B.getWord32be
99{-# INLINE getIntB #-}
100
101putIntB :: Int -> B.Put
102putIntB = 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
202type BlockLIx = Int
203type PieceLIx = Int
204
205
206data 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
219getInt :: S.Get Int
220getInt = fromIntegral <$> S.getWord32be
221{-# INLINE getInt #-}
222
223putInt :: S.Putter Int
224putInt = S.putWord32be . fromIntegral
225{-# INLINE putInt #-}
226
227getIntB :: B.Get Int
228getIntB = fromIntegral <$> B.getWord32be
229{-# INLINE getIntB #-}
230
231putIntB :: Int -> B.Put
232putIntB = B.putWord32be . fromIntegral
233{-# INLINE putIntB #-}
234
235instance 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
245instance 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.
256ppBlockIx :: BlockIx -> Doc
257ppBlockIx BlockIx {..} =
258 "piece = " <> int ixPiece <> "," <+>
259 "offset = " <> int ixOffset <> "," <+>
260 "length = " <> int ixLength
261
262{-----------------------------------------------------------------------
263 Block
264-----------------------------------------------------------------------}
265
266data 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.
278ppBlock :: Block -> Doc
279ppBlock = ppBlockIx . blockIx
280
281blockSize :: Block -> Int
282blockSize blk = fromIntegral (Lazy.length (blkData blk))
283{-# INLINE blockSize #-}
284
285-- | Widely used semi-official block size.
286defaultBlockSize :: Int
287defaultBlockSize = 16 * 1024
288
289
290isPiece :: Int -> Block -> Bool
291isPiece pieceSize (Block i offset bs) =
292 offset == 0
293 && fromIntegral (Lazy.length bs) == pieceSize
294 && i >= 0
295{-# INLINE isPiece #-}
296
297pieceIx :: Int -> Int -> BlockIx
298pieceIx i = BlockIx i 0
299{-# INLINE pieceIx #-}
300
301blockIx :: Block -> BlockIx
302blockIx = BlockIx <$> blkPiece <*> blkOffset <*> blockSize
303
304blockRange :: (Num a, Integral a) => Int -> Block -> (a, a)
305blockRange 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
312ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
313ixRange 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