summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Torrent.hs9
-rw-r--r--src/Data/Torrent/InfoHash.hs41
-rw-r--r--src/Network/Torrent/PeerWire/Handshake.hs12
-rw-r--r--src/Network/Torrent/Tracker.hs9
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.
4module Data.Torrent 4module 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)
13import qualified Data.ByteString as B 14import qualified Data.ByteString as B
14import qualified Data.ByteString.Char8 as BC (pack, unpack) 15import qualified Data.ByteString.Char8 as BC (pack, unpack)
15import Data.Text (Text) 16import Data.Text (Text)
16import Crypto.Hash.SHA1
17import Data.BEncode 17import Data.BEncode
18import Data.Torrent.InfoHash
18import Network.URI 19import Network.URI
19 20
20type Time = Text 21type 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.
24data Torrent = Torrent { 25data 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
150fromFile :: FilePath -> IO (Result Torrent) 151fromFile :: FilePath -> IO (Result Torrent)
151fromFile path = (fromBEncode <=< decode) <$> B.readFile path 152fromFile 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 @@
1module Data.Torrent.InfoHash
2 ( InfoHash (getInfoHash)
3
4 -- ^ Construction
5 , hash, hashlazy
6
7 -- ^ Extra
8 , ppHex
9 ) where
10
11import Control.Applicative
12import Data.Foldable
13import Data.ByteString (ByteString)
14import qualified Data.ByteString as B
15import qualified Data.ByteString.Char8 as BC
16import qualified Data.ByteString.Builder as B
17import qualified Data.ByteString.Builder.Prim as B
18import qualified Data.ByteString.Lazy as Lazy
19import Data.Serialize
20import qualified Crypto.Hash.SHA1 as C
21
22-- | Exactly 20 bytes long SHA1 hash.
23newtype InfoHash = InfoHash { getInfoHash :: ByteString }
24 deriving (Eq, Ord)
25
26instance Show InfoHash where
27 show = BC.unpack . ppHex
28
29instance Serialize InfoHash where
30 put = putByteString . getInfoHash
31 get = InfoHash <$> getBytes 20
32
33hash :: ByteString -> InfoHash
34hash = InfoHash . C.hash
35
36hashlazy :: Lazy.ByteString -> InfoHash
37hashlazy = InfoHash . C.hashlazy
38
39ppHex :: InfoHash -> ByteString
40ppHex = 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
9import Data.ByteString (ByteString) 9import Data.ByteString (ByteString)
10import qualified Data.ByteString as B 10import qualified Data.ByteString as B
11import Data.Serialize 11import Data.Serialize
12 12import Data.Torrent.InfoHash
13import Network.Torrent.PeerID 13import 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
18data Handshake = Handshake { 18data 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
48defaultReserved = 0 48defaultReserved = 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.
51defaultHandshake :: ByteString -- ^ Info hash string. 51defaultHandshake :: InfoHash -> PeerID -> Handshake
52 -> PeerID
53 -> Handshake
54defaultHandshake hash pid = Handshake defaultProtocol defaultReserved hash pid \ No newline at end of file 52defaultHandshake 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
22import Data.Text as T 22import Data.Text as T
23import Data.Serialize.Get hiding (Result) 23import Data.Serialize.Get hiding (Result)
24import Data.URLEncoded as URL 24import Data.URLEncoded as URL
25import Data.Torrent
25 26
26import Network 27import Network
27import Network.Socket 28import Network.Socket
@@ -31,8 +32,6 @@ import Network.Torrent.PeerID
31 32
32import Numeric 33import Numeric
33 34
34type Hash = ByteString
35
36data Peer = Peer { 35data 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
47data TRequest = TRequest { -- TODO peer here -- TODO detach announce 46data 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
156encodeRequest :: TRequest -> URI 155encodeRequest :: TRequest -> URI
157encodeRequest req = URL.urlEncode req `addToURI` reqAnnounce req 156encodeRequest 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
176defaultPorts :: [PortNumber] 175defaultPorts :: [PortNumber]
177defaultPorts = [6881..6889] 176defaultPorts = [6881..6889]
178 177
179defaultRequest :: URI -> Hash -> PeerID -> TRequest 178defaultRequest :: URI -> InfoHash -> PeerID -> TRequest
180defaultRequest announce hash pid = 179defaultRequest announce hash pid =
181 TRequest { 180 TRequest {
182 reqAnnounce = announce 181 reqAnnounce = announce