summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Protocol.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Protocol.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs20
1 files changed, 9 insertions, 11 deletions
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index c4128032..6dce2b4a 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -28,6 +28,7 @@
28{-# LANGUAGE OverloadedStrings #-} 28{-# LANGUAGE OverloadedStrings #-}
29{-# LANGUAGE RecordWildCards #-} 29{-# LANGUAGE RecordWildCards #-}
30{-# LANGUAGE TemplateHaskell #-} 30{-# LANGUAGE TemplateHaskell #-}
31{-# OPTIONS -fno-warn-orphans #-}
31module Network.BitTorrent.Exchange.Protocol 32module Network.BitTorrent.Exchange.Protocol
32 ( -- * Initial handshake 33 ( -- * Initial handshake
33 Handshake(..), ppHandshake 34 Handshake(..), ppHandshake
@@ -76,7 +77,6 @@ import qualified Data.ByteString.Char8 as BC
76import qualified Data.ByteString.Lazy as Lazy 77import qualified Data.ByteString.Lazy as Lazy
77import Data.Char 78import Data.Char
78import Data.Default 79import Data.Default
79import Data.Int
80import Data.List as L 80import Data.List as L
81import Data.Word 81import Data.Word
82 82
@@ -309,7 +309,6 @@ blockRange pieceSize blk = (offset, offset + len)
309 + fromIntegral (blkOffset blk) 309 + fromIntegral (blkOffset blk)
310 len = fromIntegral (Lazy.length (blkData blk)) 310 len = fromIntegral (Lazy.length (blkData blk))
311{-# INLINE blockRange #-} 311{-# INLINE blockRange #-}
312{-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-}
313 312
314ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a) 313ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
315ixRange pieceSize i = (offset, offset + len) 314ixRange pieceSize i = (offset, offset + len)
@@ -318,8 +317,6 @@ ixRange pieceSize i = (offset, offset + len)
318 + fromIntegral (ixOffset i) 317 + fromIntegral (ixOffset i)
319 len = fromIntegral (ixLength i) 318 len = fromIntegral (ixLength i)
320{-# INLINE ixRange #-} 319{-# INLINE ixRange #-}
321{-# SPECIALIZE ixRange :: Int -> BlockIx -> (Int64, Int64) #-}
322
323 320
324{----------------------------------------------------------------------- 321{-----------------------------------------------------------------------
325 Regular messages 322 Regular messages
@@ -386,6 +383,11 @@ data Message = KeepAlive
386 | AllowedFast !PieceIx 383 | AllowedFast !PieceIx
387 deriving (Show, Eq) 384 deriving (Show, Eq)
388 385
386instance Serialize PortNumber where
387 get = fromIntegral <$> S.getWord16be
388 {-# INLINE get #-}
389 put = S.putWord16be . fromIntegral
390 {-# INLINE put #-}
389 391
390instance Serialize Message where 392instance Serialize Message where
391 get = do 393 get = do
@@ -404,7 +406,7 @@ instance Serialize Message where
404 0x06 -> Request <$> S.get 406 0x06 -> Request <$> S.get
405 0x07 -> Piece <$> getBlock (len - 9) 407 0x07 -> Piece <$> getBlock (len - 9)
406 0x08 -> Cancel <$> S.get 408 0x08 -> Cancel <$> S.get
407 0x09 -> (Port . fromIntegral) <$> S.getWord16be 409 0x09 -> Port <$> S.get
408 0x0E -> return HaveAll 410 0x0E -> return HaveAll
409 0x0F -> return HaveNone 411 0x0F -> return HaveNone
410 0x0D -> SuggestPiece <$> getInt 412 0x0D -> SuggestPiece <$> getInt
@@ -441,7 +443,7 @@ instance Serialize Message where
441 {-# INLINE putBlock #-} 443 {-# INLINE putBlock #-}
442 444
443 put (Cancel blk) = putInt 13 >> S.putWord8 0x08 >> S.put blk 445 put (Cancel blk) = putInt 13 >> S.putWord8 0x08 >> S.put blk
444 put (Port p ) = putInt 3 >> S.putWord8 0x09 >> S.putWord16be (fromIntegral p) 446 put (Port p ) = putInt 3 >> S.putWord8 0x09 >> S.put p
445 put HaveAll = putInt 1 >> S.putWord8 0x0E 447 put HaveAll = putInt 1 >> S.putWord8 0x0E
446 put HaveNone = putInt 1 >> S.putWord8 0x0F 448 put HaveNone = putInt 1 >> S.putWord8 0x0F
447 put (SuggestPiece pix) = putInt 5 >> S.putWord8 0x0D >> putInt pix 449 put (SuggestPiece pix) = putInt 5 >> S.putWord8 0x0D >> putInt pix
@@ -471,11 +473,7 @@ instance Binary Message where
471 0x0D -> SuggestPiece <$> getIntB 473 0x0D -> SuggestPiece <$> getIntB
472 0x10 -> RejectRequest <$> B.get 474 0x10 -> RejectRequest <$> B.get
473 0x11 -> AllowedFast <$> getIntB 475 0x11 -> AllowedFast <$> getIntB
474 _ -> do 476 _ -> fail $ "unknown message ID: " ++ show mid
475 rm <- B.remaining >>= B.getBytes . fromIntegral
476 fail $ "unknown message ID: " ++ show mid ++ "\n"
477 ++ "remaining available bytes: " ++ show rm
478
479 where 477 where
480 getBlock :: Int -> B.Get Block 478 getBlock :: Int -> B.Get Block
481 getBlock len = Block <$> getIntB <*> getIntB 479 getBlock len = Block <$> getIntB <*> getIntB