diff options
-rw-r--r-- | src/Network/BitTorrent.hs | 15 | ||||
-rw-r--r-- | src/Network/BitTorrent/Internal.hs | 32 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 16 |
3 files changed, 39 insertions, 24 deletions
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs index 5fbc5ff6..61185d08 100644 --- a/src/Network/BitTorrent.hs +++ b/src/Network/BitTorrent.hs | |||
@@ -5,6 +5,7 @@ | |||
5 | -- Stability : experimental | 5 | -- Stability : experimental |
6 | -- Portability : portable | 6 | -- Portability : portable |
7 | -- | 7 | -- |
8 | {-# LANGUAGE RecordWildCards #-} | ||
8 | module Network.BitTorrent | 9 | module Network.BitTorrent |
9 | ( module BT | 10 | ( module BT |
10 | , module Data.Torrent | 11 | , module Data.Torrent |
@@ -15,8 +16,11 @@ module Network.BitTorrent | |||
15 | , ClientSession, newClient | 16 | , ClientSession, newClient |
16 | , SwarmSession, newLeacher, newSeeder | 17 | , SwarmSession, newLeacher, newSeeder |
17 | , PeerSession | 18 | , PeerSession |
19 | , discover | ||
18 | ) where | 20 | ) where |
19 | 21 | ||
22 | import Data.IORef | ||
23 | |||
20 | import Data.Torrent | 24 | import Data.Torrent |
21 | import Network.BitTorrent.Internal | 25 | import Network.BitTorrent.Internal |
22 | import Network.BitTorrent.Extension as BT | 26 | import Network.BitTorrent.Extension as BT |
@@ -24,5 +28,12 @@ import Network.BitTorrent.Peer as BT | |||
24 | import Network.BitTorrent.Exchange as BT | 28 | import Network.BitTorrent.Exchange as BT |
25 | import Network.BitTorrent.Tracker as BT | 29 | import Network.BitTorrent.Tracker as BT |
26 | 30 | ||
27 | --discover :: SwarmSession -> ([PeerAddr] -> IO a) -> IO a | 31 | |
28 | --discover = withTracker | 32 | discover :: SwarmSession -> (TSession -> IO a) -> IO a |
33 | discover SwarmSession {..} action = do | ||
34 | let conn = TConnection (tAnnounce torrentMeta) (tInfoHash torrentMeta) | ||
35 | (clientPeerID clientSession) port | ||
36 | progress <- readIORef (currentProgress clientSession) | ||
37 | withTracker progress conn action | ||
38 | |||
39 | port = 10000 | ||
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs index d34c6236..e231fb2c 100644 --- a/src/Network/BitTorrent/Internal.hs +++ b/src/Network/BitTorrent/Internal.hs | |||
@@ -12,7 +12,8 @@ | |||
12 | -- | 12 | -- |
13 | {-# LANGUAGE RecordWildCards #-} | 13 | {-# LANGUAGE RecordWildCards #-} |
14 | module Network.BitTorrent.Internal | 14 | module Network.BitTorrent.Internal |
15 | ( ClientSession(..), newClient | 15 | ( Progress(..), startProgress |
16 | , ClientSession(..), newClient | ||
16 | , SwarmSession(..), newLeacher, newSeeder | 17 | , SwarmSession(..), newLeacher, newSeeder |
17 | , PeerSession(..), withPeerSession | 18 | , PeerSession(..), withPeerSession |
18 | 19 | ||
@@ -49,6 +50,21 @@ import Network.BitTorrent.Exchange.Protocol as BT | |||
49 | 50 | ||
50 | 51 | ||
51 | 52 | ||
53 | -- | 'Progress' contains upload/download/left stats about | ||
54 | -- current client state. | ||
55 | -- | ||
56 | -- This data is considered as dynamic within one session. | ||
57 | -- | ||
58 | data Progress = Progress { | ||
59 | prUploaded :: Integer -- ^ Total amount of bytes uploaded. | ||
60 | , prDownloaded :: Integer -- ^ Total amount of bytes downloaded. | ||
61 | , prLeft :: Integer -- ^ Total amount of bytes left. | ||
62 | } deriving Show | ||
63 | |||
64 | startProgress :: Integer -> Progress | ||
65 | startProgress = Progress 0 0 | ||
66 | |||
67 | |||
52 | {----------------------------------------------------------------------- | 68 | {----------------------------------------------------------------------- |
53 | Client session | 69 | Client session |
54 | -----------------------------------------------------------------------} | 70 | -----------------------------------------------------------------------} |
@@ -59,6 +75,7 @@ data ClientSession = ClientSession { | |||
59 | , allowedExtensions :: [Extension] -- ^ | 75 | , allowedExtensions :: [Extension] -- ^ |
60 | , swarmSessions :: TVar (Set SwarmSession) | 76 | , swarmSessions :: TVar (Set SwarmSession) |
61 | , eventManager :: EventManager | 77 | , eventManager :: EventManager |
78 | , currentProgress :: IORef Progress | ||
62 | } | 79 | } |
63 | 80 | ||
64 | instance Eq ClientSession where | 81 | instance Eq ClientSession where |
@@ -72,6 +89,7 @@ newClient exts = ClientSession <$> newPeerID | |||
72 | <*> pure exts | 89 | <*> pure exts |
73 | <*> newTVarIO S.empty | 90 | <*> newTVarIO S.empty |
74 | <*> Ev.new | 91 | <*> Ev.new |
92 | <*> newIORef (startProgress 0) | ||
75 | 93 | ||
76 | {----------------------------------------------------------------------- | 94 | {----------------------------------------------------------------------- |
77 | Swarm session | 95 | Swarm session |
@@ -80,21 +98,21 @@ newClient exts = ClientSession <$> newPeerID | |||
80 | -- | Extensions are set globally by | 98 | -- | Extensions are set globally by |
81 | -- Swarm session are un | 99 | -- Swarm session are un |
82 | data SwarmSession = SwarmSession { | 100 | data SwarmSession = SwarmSession { |
83 | torrentInfoHash :: InfoHash | 101 | torrentMeta :: Torrent |
84 | , clientSession :: ClientSession | 102 | , clientSession :: ClientSession |
85 | , clientBitfield :: IORef Bitfield | 103 | , clientBitfield :: IORef Bitfield |
86 | , connectedPeers :: TVar (Set PeerSession) | 104 | , connectedPeers :: TVar (Set PeerSession) |
87 | } | 105 | } |
88 | 106 | ||
89 | instance Eq SwarmSession where | 107 | instance Eq SwarmSession where |
90 | (==) = (==) `on` torrentInfoHash | 108 | (==) = (==) `on` (tInfoHash . torrentMeta) |
91 | 109 | ||
92 | instance Ord SwarmSession where | 110 | instance Ord SwarmSession where |
93 | compare = comparing torrentInfoHash | 111 | compare = comparing (tInfoHash . torrentMeta) |
94 | 112 | ||
95 | newSwarmSession :: Bitfield -> ClientSession -> Torrent -> IO SwarmSession | 113 | newSwarmSession :: Bitfield -> ClientSession -> Torrent -> IO SwarmSession |
96 | newSwarmSession bf cs @ ClientSession {..} Torrent {..} | 114 | newSwarmSession bf cs @ ClientSession {..} t @ Torrent {..} |
97 | = SwarmSession <$> pure tInfoHash | 115 | = SwarmSession <$> pure t |
98 | <*> pure cs | 116 | <*> pure cs |
99 | <*> newIORef bf | 117 | <*> newIORef bf |
100 | <*> newTVarIO S.empty | 118 | <*> newTVarIO S.empty |
@@ -160,7 +178,7 @@ withPeerSession ss @ SwarmSession {..} addr | |||
160 | openSession = do | 178 | openSession = do |
161 | let caps = encodeExts $ allowedExtensions $ clientSession | 179 | let caps = encodeExts $ allowedExtensions $ clientSession |
162 | let pid = clientPeerID $ clientSession | 180 | let pid = clientPeerID $ clientSession |
163 | let chs = Handshake defaultBTProtocol caps torrentInfoHash pid | 181 | let chs = Handshake defaultBTProtocol caps (tInfoHash torrentMeta) pid |
164 | 182 | ||
165 | sock <- connectToPeer addr | 183 | sock <- connectToPeer addr |
166 | phs <- handshake sock chs `onException` close sock | 184 | phs <- handshake sock chs `onException` close sock |
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs index aaa08f3c..9acfc53d 100644 --- a/src/Network/BitTorrent/Tracker.hs +++ b/src/Network/BitTorrent/Tracker.hs | |||
@@ -37,6 +37,7 @@ import Data.Torrent | |||
37 | import Network | 37 | import Network |
38 | import Network.URI | 38 | import Network.URI |
39 | 39 | ||
40 | import Network.BitTorrent.Internal | ||
40 | import Network.BitTorrent.Peer | 41 | import Network.BitTorrent.Peer |
41 | import Network.BitTorrent.Tracker.Protocol | 42 | import Network.BitTorrent.Tracker.Protocol |
42 | import Network.BitTorrent.Tracker.Scrape | 43 | import Network.BitTorrent.Tracker.Scrape |
@@ -58,21 +59,6 @@ tconnection :: Torrent -> PeerID -> PortNumber -> TConnection | |||
58 | tconnection t = TConnection (tAnnounce t) (tInfoHash t) | 59 | tconnection t = TConnection (tAnnounce t) (tInfoHash t) |
59 | 60 | ||
60 | 61 | ||
61 | -- | 'Progress' contains upload/download/left stats about | ||
62 | -- current client state. | ||
63 | -- | ||
64 | -- This data is considered as dynamic within one session. | ||
65 | -- | ||
66 | data Progress = Progress { | ||
67 | prUploaded :: Integer -- ^ Total amount of bytes uploaded. | ||
68 | , prDownloaded :: Integer -- ^ Total amount of bytes downloaded. | ||
69 | , prLeft :: Integer -- ^ Total amount of bytes left. | ||
70 | } deriving Show | ||
71 | |||
72 | startProgress :: Integer -> Progress | ||
73 | startProgress = Progress 0 0 | ||
74 | |||
75 | |||
76 | -- | used to avoid boilerplate; do NOT export me | 62 | -- | used to avoid boilerplate; do NOT export me |
77 | genericReq :: TConnection -> Progress -> TRequest | 63 | genericReq :: TConnection -> Progress -> TRequest |
78 | genericReq ses pr = TRequest { | 64 | genericReq ses pr = TRequest { |