summaryrefslogtreecommitdiff
path: root/src/Network/Torrent/PeerWire
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Torrent/PeerWire')
-rw-r--r--src/Network/Torrent/PeerWire/Block.hs56
-rw-r--r--src/Network/Torrent/PeerWire/Handshake.hs77
-rw-r--r--src/Network/Torrent/PeerWire/Message.hs91
3 files changed, 0 insertions, 224 deletions
diff --git a/src/Network/Torrent/PeerWire/Block.hs b/src/Network/Torrent/PeerWire/Block.hs
deleted file mode 100644
index 056f6b18..00000000
--- a/src/Network/Torrent/PeerWire/Block.hs
+++ /dev/null
@@ -1,56 +0,0 @@
1module Network.Torrent.PeerWire.Block
2 ( BlockIx(..), Block(..)
3 , defaultBlockSize
4 , blockRange, ixRange, pieceIx
5 , isPiece
6 ) where
7
8import Data.ByteString (ByteString)
9import qualified Data.ByteString as B
10import Data.Int
11
12
13data BlockIx = BlockIx {
14 ixPiece :: {-# UNPACK #-} !Int -- ^ Zero-based piece index.
15 , ixOffset :: {-# UNPACK #-} !Int -- ^ Zero-based byte offset within the piece.
16 , ixLength :: {-# UNPACK #-} !Int -- ^ Block size starting from offset.
17 } deriving (Show, Eq)
18
19data Block = Block {
20 blkPiece :: Int -- ^ Zero-based piece index.
21 , blkOffset :: Int -- ^ Zero-based byte offset within the piece.
22 , blkData :: ByteString -- ^ Payload.
23 } deriving (Show, Eq)
24
25
26-- | Widely used semi-official block size.
27defaultBlockSize :: Int
28defaultBlockSize = 16 * 1024
29
30
31isPiece :: Int -> Block -> Bool
32isPiece pieceSize (Block i offset bs) =
33 offset == 0 && B.length bs == pieceSize && i >= 0
34{-# INLINE isPiece #-}
35
36pieceIx :: Int -> Int -> BlockIx
37pieceIx i = BlockIx i 0
38{-# INLINE pieceIx #-}
39
40blockRange :: (Num a, Integral a) => Int -> Block -> (a, a)
41blockRange pieceSize blk = (offset, offset + len)
42 where
43 offset = fromIntegral pieceSize * fromIntegral (blkPiece blk)
44 + fromIntegral (blkOffset blk)
45 len = fromIntegral (B.length (blkData blk))
46{-# INLINE blockRange #-}
47{-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-}
48
49ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
50ixRange pieceSize ix = (offset, offset + len)
51 where
52 offset = fromIntegral pieceSize * fromIntegral (ixPiece ix)
53 + fromIntegral (ixOffset ix)
54 len = fromIntegral (ixLength ix)
55{-# INLINE ixRange #-}
56{-# SPECIALIZE ixRange :: Int -> BlockIx -> (Int64, Int64) #-}
diff --git a/src/Network/Torrent/PeerWire/Handshake.hs b/src/Network/Torrent/PeerWire/Handshake.hs
deleted file mode 100644
index 733d5785..00000000
--- a/src/Network/Torrent/PeerWire/Handshake.hs
+++ /dev/null
@@ -1,77 +0,0 @@
1-- |
2-- Copyright : (c) Sam T. 2013
3-- License : MIT
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8{-# LANGUAGE OverloadedStrings #-}
9module Network.Torrent.PeerWire.Handshake
10 ( Handshake
11 , handshakeMaxSize
12 , defaultBTProtocol, defaultReserved, defaultHandshake
13 , handshake
14 ) where
15
16import Control.Applicative
17import Data.Word
18import Data.ByteString (ByteString)
19import qualified Data.ByteString as B
20import Data.Serialize as S
21import Data.Torrent.InfoHash
22import Network
23import Network.Socket.ByteString
24import Network.Torrent.PeerID
25
26-- | In order to establish the connection between peers we should send 'Handshake'
27-- message. The 'Handshake' is a required message and must be the first message
28-- transmitted by the peer to the another peer.
29data Handshake = Handshake {
30 hsProtocol :: ByteString -- ^ Identifier of the protocol.
31 , hsReserved :: Word64 -- ^ Reserved bytes, rarely used.
32 , hsInfoHash :: InfoHash -- ^ Hash from the metainfo file.
33 -- This /should be/ same hash that is transmitted in tracker requests.
34 , hsPeerID :: PeerID -- ^ Peer id of the initiator.
35 -- This is /usually the same peer id that is transmitted in tracker requests.
36 } deriving (Show, Eq)
37
38instance Serialize Handshake where
39 put hs = do
40 putWord8 (fromIntegral (B.length (hsProtocol hs)))
41 putByteString (hsProtocol hs)
42 putWord64be (hsReserved hs)
43 put (hsInfoHash hs)
44 put (hsPeerID hs)
45
46 get = do
47 len <- getWord8
48 Handshake <$> getBytes (fromIntegral len)
49 <*> getWord64be
50 <*> get
51 <*> get
52
53-- | Maximum size of handshake message in bytes.
54handshakeMaxSize :: Int
55handshakeMaxSize = 1 + 256 + 8 + 20 + 20
56
57-- | Default protocol string "BitTorrent protocol" as is.
58defaultBTProtocol :: ByteString
59defaultBTProtocol = "BitTorrent protocol"
60
61-- | Default reserved word is 0.
62defaultReserved :: Word64
63defaultReserved = 0
64
65-- | Length of info hash and peer id is unchecked, so it /should/ be equal 20.
66defaultHandshake :: InfoHash -> PeerID -> Handshake
67defaultHandshake = Handshake defaultBTProtocol defaultReserved
68
69
70-- TODO check if hash the same
71-- | Handshaking with a peer specified by the second argument.
72--
73handshake :: Socket -> Handshake -> IO (Either String Handshake)
74handshake sock hs = do
75 sendAll sock (S.encode hs)
76 r <- recv sock handshakeMaxSize
77 return (S.decode r)
diff --git a/src/Network/Torrent/PeerWire/Message.hs b/src/Network/Torrent/PeerWire/Message.hs
deleted file mode 100644
index e04038ff..00000000
--- a/src/Network/Torrent/PeerWire/Message.hs
+++ /dev/null
@@ -1,91 +0,0 @@
1module Network.Torrent.PeerWire.Message
2 ( Message(..)
3 ) where
4
5import Control.Applicative
6import Data.ByteString (ByteString)
7import qualified Data.ByteString as B
8
9import Data.Serialize
10
11import Network.Torrent.PeerWire.Block
12
13
14-- TODO comment message constructors
15data Message = KeepAlive
16 | Choke
17 | Unchoke
18 | Interested
19 | NotInterested
20 | Have Int
21 | Bitfield ByteString
22 | Request BlockIx
23 | Piece Block
24 | Cancel BlockIx
25 | Port Int
26 deriving (Show, Eq)
27
28instance Serialize BlockIx where
29 {-# SPECIALIZE instance Serialize BlockIx #-}
30 get = BlockIx <$> getInt <*> getInt <*> getInt
31 {-# INLINE get #-}
32
33 put ix = do putInt (ixPiece ix)
34 putInt (ixOffset ix)
35 putInt (ixLength ix)
36 {-# INLINE put #-}
37
38instance Serialize Message where
39 get = do
40 len <- getInt
41 lookAhead $ ensure len
42 if len == 0 then return KeepAlive -- FIX check if BS is empty instead of reading len
43 else do
44 mid <- getWord8
45 case mid of
46 0 -> return Choke
47 1 -> return Unchoke
48 2 -> return Interested
49 3 -> return NotInterested
50 4 -> Have <$> getInt
51 5 -> Bitfield <$> getBytes (pred len)
52 6 -> Request <$> get
53 7 -> Piece <$> getBlock (len - 9)
54 8 -> Cancel <$> get
55 9 -> (Port . fromIntegral) <$> getWord16be
56 _ -> fail $ "unknown message ID: " ++ show mid
57
58 where
59 getBlock :: Int -> Get Block
60 getBlock len = Block <$> getInt <*> getInt <*> getBytes len
61 {-# INLINE getBlock #-}
62
63 put KeepAlive = putInt 0
64 put Choke = putInt 1 >> putWord8 0
65 put Unchoke = putInt 1 >> putWord8 1
66 put Interested = putInt 1 >> putWord8 2
67 put NotInterested = putInt 1 >> putWord8 3
68 put (Have i) = putInt 5 >> putWord8 4 >> putInt i
69 put (Bitfield b) = putInt l >> putWord8 5 >> putByteString b
70 where l = succ (B.length b)
71 {-# INLINE l #-}
72 put (Request blk) = putInt 13 >> putWord8 6 >> put blk
73 put (Piece blk) = putInt l >> putWord8 7 >> putBlock
74 where l = 9 + B.length (blkData blk)
75 {-# INLINE l #-}
76 putBlock = do putInt (blkPiece blk)
77 putInt (blkOffset blk)
78 putByteString (blkData blk)
79 {-# INLINE putBlock #-}
80
81 put (Cancel blk) = putInt 13 >> putWord8 8 >> put blk
82 put (Port p ) = putInt 3 >> putWord8 9 >> putWord16be (fromIntegral p)
83
84
85getInt :: Get Int
86getInt = fromIntegral <$> getWord32be
87{-# INLINE getInt #-}
88
89putInt :: Putter Int
90putInt = putWord32be . fromIntegral
91{-# INLINE putInt #-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-14 12:47:07 +0000