diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Data/Torrent.hs | 9 | ||||
-rw-r--r-- | src/Data/Torrent/InfoHash.hs | 41 | ||||
-rw-r--r-- | src/Network/Torrent/PeerWire/Handshake.hs | 12 | ||||
-rw-r--r-- | src/Network/Torrent/Tracker.hs | 9 |
4 files changed, 55 insertions, 16 deletions
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs index 128c1c7c..57831acf 100644 --- a/src/Data/Torrent.hs +++ b/src/Data/Torrent.hs | |||
@@ -2,7 +2,8 @@ | |||
2 | {-# LANGUAGE OverloadedStrings #-} | 2 | {-# LANGUAGE OverloadedStrings #-} |
3 | -- | This module provides torrent metainfo serialization. | 3 | -- | This module provides torrent metainfo serialization. |
4 | module Data.Torrent | 4 | module Data.Torrent |
5 | ( Torrent(..), TorrentInfo(..), TorrentFile(..) | 5 | ( module Data.Torrent.InfoHash |
6 | , Torrent(..), TorrentInfo(..), TorrentFile(..) | ||
6 | , fromFile | 7 | , fromFile |
7 | ) where | 8 | ) where |
8 | 9 | ||
@@ -13,8 +14,8 @@ import Data.ByteString (ByteString) | |||
13 | import qualified Data.ByteString as B | 14 | import qualified Data.ByteString as B |
14 | import qualified Data.ByteString.Char8 as BC (pack, unpack) | 15 | import qualified Data.ByteString.Char8 as BC (pack, unpack) |
15 | import Data.Text (Text) | 16 | import Data.Text (Text) |
16 | import Crypto.Hash.SHA1 | ||
17 | import Data.BEncode | 17 | import Data.BEncode |
18 | import Data.Torrent.InfoHash | ||
18 | import Network.URI | 19 | import Network.URI |
19 | 20 | ||
20 | type Time = Text | 21 | type Time = Text |
@@ -22,7 +23,7 @@ type Time = Text | |||
22 | -- TODO comment fields | 23 | -- TODO comment fields |
23 | -- TODO more convenient form of torrent info. | 24 | -- TODO more convenient form of torrent info. |
24 | data Torrent = Torrent { | 25 | data Torrent = Torrent { |
25 | tInfoHash :: ByteString | 26 | tInfoHash :: InfoHash |
26 | , tAnnounce :: URI | 27 | , tAnnounce :: URI |
27 | , tAnnounceList :: Maybe [[URI]] | 28 | , tAnnounceList :: Maybe [[URI]] |
28 | , tComment :: Maybe Text | 29 | , tComment :: Maybe Text |
@@ -148,4 +149,4 @@ instance BEncodable TorrentFile where | |||
148 | 149 | ||
149 | 150 | ||
150 | fromFile :: FilePath -> IO (Result Torrent) | 151 | fromFile :: FilePath -> IO (Result Torrent) |
151 | fromFile path = (fromBEncode <=< decode) <$> B.readFile path | 152 | fromFile filepath = (fromBEncode <=< decode) <$> B.readFile filepath |
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs new file mode 100644 index 00000000..448e9a5a --- /dev/null +++ b/src/Data/Torrent/InfoHash.hs | |||
@@ -0,0 +1,41 @@ | |||
1 | module Data.Torrent.InfoHash | ||
2 | ( InfoHash (getInfoHash) | ||
3 | |||
4 | -- ^ Construction | ||
5 | , hash, hashlazy | ||
6 | |||
7 | -- ^ Extra | ||
8 | , ppHex | ||
9 | ) where | ||
10 | |||
11 | import Control.Applicative | ||
12 | import Data.Foldable | ||
13 | import Data.ByteString (ByteString) | ||
14 | import qualified Data.ByteString as B | ||
15 | import qualified Data.ByteString.Char8 as BC | ||
16 | import qualified Data.ByteString.Builder as B | ||
17 | import qualified Data.ByteString.Builder.Prim as B | ||
18 | import qualified Data.ByteString.Lazy as Lazy | ||
19 | import Data.Serialize | ||
20 | import qualified Crypto.Hash.SHA1 as C | ||
21 | |||
22 | -- | Exactly 20 bytes long SHA1 hash. | ||
23 | newtype InfoHash = InfoHash { getInfoHash :: ByteString } | ||
24 | deriving (Eq, Ord) | ||
25 | |||
26 | instance Show InfoHash where | ||
27 | show = BC.unpack . ppHex | ||
28 | |||
29 | instance Serialize InfoHash where | ||
30 | put = putByteString . getInfoHash | ||
31 | get = InfoHash <$> getBytes 20 | ||
32 | |||
33 | hash :: ByteString -> InfoHash | ||
34 | hash = InfoHash . C.hash | ||
35 | |||
36 | hashlazy :: Lazy.ByteString -> InfoHash | ||
37 | hashlazy = InfoHash . C.hashlazy | ||
38 | |||
39 | ppHex :: InfoHash -> ByteString | ||
40 | ppHex = Lazy.toStrict . B.toLazyByteString . | ||
41 | foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash | ||
diff --git a/src/Network/Torrent/PeerWire/Handshake.hs b/src/Network/Torrent/PeerWire/Handshake.hs index 7bdb7fef..ab255c14 100644 --- a/src/Network/Torrent/PeerWire/Handshake.hs +++ b/src/Network/Torrent/PeerWire/Handshake.hs | |||
@@ -9,7 +9,7 @@ import Data.Word | |||
9 | import Data.ByteString (ByteString) | 9 | import Data.ByteString (ByteString) |
10 | import qualified Data.ByteString as B | 10 | import qualified Data.ByteString as B |
11 | import Data.Serialize | 11 | import Data.Serialize |
12 | 12 | import Data.Torrent.InfoHash | |
13 | import Network.Torrent.PeerID | 13 | import Network.Torrent.PeerID |
14 | 14 | ||
15 | -- | In order to establish the connection between peers we should send 'Handshake' | 15 | -- | In order to establish the connection between peers we should send 'Handshake' |
@@ -18,7 +18,7 @@ import Network.Torrent.PeerID | |||
18 | data Handshake = Handshake { | 18 | data Handshake = Handshake { |
19 | hsProtocol :: ByteString -- ^ Identifier of the protocol. | 19 | hsProtocol :: ByteString -- ^ Identifier of the protocol. |
20 | , hsReserved :: Word64 -- ^ Reserved bytes, rarely used. | 20 | , hsReserved :: Word64 -- ^ Reserved bytes, rarely used. |
21 | , hsInfoHash :: ByteString -- ^ Hash from the metainfo file. | 21 | , hsInfoHash :: InfoHash -- ^ Hash from the metainfo file. |
22 | -- This /should be/ same hash that is transmitted in tracker requests. | 22 | -- This /should be/ same hash that is transmitted in tracker requests. |
23 | , hsPeerID :: PeerID -- ^ Peer id of the initiator. | 23 | , hsPeerID :: PeerID -- ^ Peer id of the initiator. |
24 | -- This is /usually the same peer id that is transmitted in tracker requests. | 24 | -- This is /usually the same peer id that is transmitted in tracker requests. |
@@ -29,14 +29,14 @@ instance Serialize Handshake where | |||
29 | putWord8 (fromIntegral (B.length (hsProtocol hs))) | 29 | putWord8 (fromIntegral (B.length (hsProtocol hs))) |
30 | putByteString (hsProtocol hs) | 30 | putByteString (hsProtocol hs) |
31 | putWord64be (hsReserved hs) | 31 | putWord64be (hsReserved hs) |
32 | putByteString (hsInfoHash hs) | 32 | put (hsInfoHash hs) |
33 | put (hsPeerID hs) | 33 | put (hsPeerID hs) |
34 | 34 | ||
35 | get = do | 35 | get = do |
36 | len <- getWord8 | 36 | len <- getWord8 |
37 | Handshake <$> getBytes (fromIntegral len) | 37 | Handshake <$> getBytes (fromIntegral len) |
38 | <*> getWord64be | 38 | <*> getWord64be |
39 | <*> getBytes 20 | 39 | <*> get |
40 | <*> get | 40 | <*> get |
41 | 41 | ||
42 | -- | Default protocol string "BitTorrent protocol" as is. | 42 | -- | Default protocol string "BitTorrent protocol" as is. |
@@ -48,7 +48,5 @@ defaultReserved :: Word64 | |||
48 | defaultReserved = 0 | 48 | defaultReserved = 0 |
49 | 49 | ||
50 | -- | Length of info hash and peer id is unchecked, so it /should/ be equal 20. | 50 | -- | Length of info hash and peer id is unchecked, so it /should/ be equal 20. |
51 | defaultHandshake :: ByteString -- ^ Info hash string. | 51 | defaultHandshake :: InfoHash -> PeerID -> Handshake |
52 | -> PeerID | ||
53 | -> Handshake | ||
54 | defaultHandshake hash pid = Handshake defaultProtocol defaultReserved hash pid \ No newline at end of file | 52 | defaultHandshake hash pid = Handshake defaultProtocol defaultReserved hash pid \ No newline at end of file |
diff --git a/src/Network/Torrent/Tracker.hs b/src/Network/Torrent/Tracker.hs index 72fbcb44..796db66a 100644 --- a/src/Network/Torrent/Tracker.hs +++ b/src/Network/Torrent/Tracker.hs | |||
@@ -22,6 +22,7 @@ import Data.ByteString.Char8 as BC | |||
22 | import Data.Text as T | 22 | import Data.Text as T |
23 | import Data.Serialize.Get hiding (Result) | 23 | import Data.Serialize.Get hiding (Result) |
24 | import Data.URLEncoded as URL | 24 | import Data.URLEncoded as URL |
25 | import Data.Torrent | ||
25 | 26 | ||
26 | import Network | 27 | import Network |
27 | import Network.Socket | 28 | import Network.Socket |
@@ -31,8 +32,6 @@ import Network.Torrent.PeerID | |||
31 | 32 | ||
32 | import Numeric | 33 | import Numeric |
33 | 34 | ||
34 | type Hash = ByteString | ||
35 | |||
36 | data Peer = Peer { | 35 | data Peer = Peer { |
37 | peerID :: Maybe PeerID | 36 | peerID :: Maybe PeerID |
38 | , peerIP :: HostAddress | 37 | , peerIP :: HostAddress |
@@ -46,7 +45,7 @@ data Event = Started -- ^ For first request. | |||
46 | 45 | ||
47 | data TRequest = TRequest { -- TODO peer here -- TODO detach announce | 46 | data TRequest = TRequest { -- TODO peer here -- TODO detach announce |
48 | reqAnnounce :: URI -- ^ Announce url of the torrent. | 47 | reqAnnounce :: URI -- ^ Announce url of the torrent. |
49 | , reqInfoHash :: Hash -- ^ Hash of info part of the torrent. | 48 | , reqInfoHash :: InfoHash -- ^ Hash of info part of the torrent. |
50 | , reqPeerID :: PeerID -- ^ Id of the peer doing request. () | 49 | , reqPeerID :: PeerID -- ^ Id of the peer doing request. () |
51 | , reqPort :: PortNumber -- ^ Port to listen to for connection from other peers. | 50 | , reqPort :: PortNumber -- ^ Port to listen to for connection from other peers. |
52 | , reqUploaded :: Int -- ^ # of bytes that the peer has uploaded in the swarm. | 51 | , reqUploaded :: Int -- ^ # of bytes that the peer has uploaded in the swarm. |
@@ -155,7 +154,7 @@ instance URLEncode TRequest where | |||
155 | 154 | ||
156 | encodeRequest :: TRequest -> URI | 155 | encodeRequest :: TRequest -> URI |
157 | encodeRequest req = URL.urlEncode req `addToURI` reqAnnounce req | 156 | encodeRequest req = URL.urlEncode req `addToURI` reqAnnounce req |
158 | `addHash` BC.unpack (reqInfoHash req) | 157 | `addHash` BC.unpack (getInfoHash (reqInfoHash req)) |
159 | where | 158 | where |
160 | addHash :: URI -> String -> URI | 159 | addHash :: URI -> String -> URI |
161 | addHash uri s = uri { uriQuery = uriQuery uri ++ "&info_hash=" ++ rfc1738Encode s } | 160 | addHash uri s = uri { uriQuery = uriQuery uri ++ "&info_hash=" ++ rfc1738Encode s } |
@@ -176,7 +175,7 @@ encodeRequest req = URL.urlEncode req `addToURI` reqAnnounce req | |||
176 | defaultPorts :: [PortNumber] | 175 | defaultPorts :: [PortNumber] |
177 | defaultPorts = [6881..6889] | 176 | defaultPorts = [6881..6889] |
178 | 177 | ||
179 | defaultRequest :: URI -> Hash -> PeerID -> TRequest | 178 | defaultRequest :: URI -> InfoHash -> PeerID -> TRequest |
180 | defaultRequest announce hash pid = | 179 | defaultRequest announce hash pid = |
181 | TRequest { | 180 | TRequest { |
182 | reqAnnounce = announce | 181 | reqAnnounce = announce |