summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent.hs15
-rw-r--r--src/Network/BitTorrent/Internal.hs32
-rw-r--r--src/Network/BitTorrent/Tracker.hs16
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 #-}
8module Network.BitTorrent 9module 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
22import Data.IORef
23
20import Data.Torrent 24import Data.Torrent
21import Network.BitTorrent.Internal 25import Network.BitTorrent.Internal
22import Network.BitTorrent.Extension as BT 26import Network.BitTorrent.Extension as BT
@@ -24,5 +28,12 @@ import Network.BitTorrent.Peer as BT
24import Network.BitTorrent.Exchange as BT 28import Network.BitTorrent.Exchange as BT
25import Network.BitTorrent.Tracker as BT 29import Network.BitTorrent.Tracker as BT
26 30
27--discover :: SwarmSession -> ([PeerAddr] -> IO a) -> IO a 31
28--discover = withTracker 32discover :: SwarmSession -> (TSession -> IO a) -> IO a
33discover 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
39port = 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 #-}
14module Network.BitTorrent.Internal 14module 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--
58data 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
64startProgress :: Integer -> Progress
65startProgress = 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
64instance Eq ClientSession where 81instance 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
82data SwarmSession = SwarmSession { 100data 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
89instance Eq SwarmSession where 107instance Eq SwarmSession where
90 (==) = (==) `on` torrentInfoHash 108 (==) = (==) `on` (tInfoHash . torrentMeta)
91 109
92instance Ord SwarmSession where 110instance Ord SwarmSession where
93 compare = comparing torrentInfoHash 111 compare = comparing (tInfoHash . torrentMeta)
94 112
95newSwarmSession :: Bitfield -> ClientSession -> Torrent -> IO SwarmSession 113newSwarmSession :: Bitfield -> ClientSession -> Torrent -> IO SwarmSession
96newSwarmSession bf cs @ ClientSession {..} Torrent {..} 114newSwarmSession 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
37import Network 37import Network
38import Network.URI 38import Network.URI
39 39
40import Network.BitTorrent.Internal
40import Network.BitTorrent.Peer 41import Network.BitTorrent.Peer
41import Network.BitTorrent.Tracker.Protocol 42import Network.BitTorrent.Tracker.Protocol
42import Network.BitTorrent.Tracker.Scrape 43import Network.BitTorrent.Tracker.Scrape
@@ -58,21 +59,6 @@ tconnection :: Torrent -> PeerID -> PortNumber -> TConnection
58tconnection t = TConnection (tAnnounce t) (tInfoHash t) 59tconnection 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--
66data 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
72startProgress :: Integer -> Progress
73startProgress = Progress 0 0
74
75
76-- | used to avoid boilerplate; do NOT export me 62-- | used to avoid boilerplate; do NOT export me
77genericReq :: TConnection -> Progress -> TRequest 63genericReq :: TConnection -> Progress -> TRequest
78genericReq ses pr = TRequest { 64genericReq ses pr = TRequest {