summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal1
-rw-r--r--src/Network/BitTorrent.hs3
-rw-r--r--src/Network/BitTorrent/Discovery.hs59
-rw-r--r--src/Network/BitTorrent/Sessions.hs108
4 files changed, 74 insertions, 97 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index c10ef6a2..c5b04e42 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -44,7 +44,6 @@ library
44 , Network.BitTorrent.Tracker 44 , Network.BitTorrent.Tracker
45 , Network.BitTorrent.Exchange 45 , Network.BitTorrent.Exchange
46 , Network.BitTorrent.DHT 46 , Network.BitTorrent.DHT
47 , Network.BitTorrent.Discovery
48 , System.Torrent.Storage 47 , System.Torrent.Storage
49 48
50 other-modules: Network.BitTorrent.Sessions.Types 49 other-modules: Network.BitTorrent.Sessions.Types
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index c68cceac..7c1e02e2 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -89,7 +89,6 @@ import Network.BitTorrent.Extension
89import Network.BitTorrent.Exchange 89import Network.BitTorrent.Exchange
90import Network.BitTorrent.Exchange.Protocol 90import Network.BitTorrent.Exchange.Protocol
91import Network.BitTorrent.Tracker 91import Network.BitTorrent.Tracker
92import Network.BitTorrent.Discovery
93 92
94import System.Torrent.Storage 93import System.Torrent.Storage
95 94
@@ -100,8 +99,6 @@ import System.Torrent.Storage
100withDefaultClient :: PortNumber -> PortNumber -> (ClientSession -> IO ()) -> IO () 99withDefaultClient :: PortNumber -> PortNumber -> (ClientSession -> IO ()) -> IO ()
101withDefaultClient dhtPort listPort action = do 100withDefaultClient dhtPort listPort action = do
102 withClientSession defaultThreadCount defaultExtensions $ \client -> do 101 withClientSession defaultThreadCount defaultExtensions $ \client -> do
103 startListener client listPort
104 startDHT client dhtPort
105 action client 102 action client
106 103
107{----------------------------------------------------------------------- 104{-----------------------------------------------------------------------
diff --git a/src/Network/BitTorrent/Discovery.hs b/src/Network/BitTorrent/Discovery.hs
deleted file mode 100644
index 8403461c..00000000
--- a/src/Network/BitTorrent/Discovery.hs
+++ /dev/null
@@ -1,59 +0,0 @@
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE OverloadedStrings #-}
3module Network.BitTorrent.Discovery
4 (discover, startListener, startDHT
5 ) where
6
7import Control.Monad
8import Control.Concurrent
9import Control.Exception
10import Network.Socket
11
12import Data.Torrent
13import Network.BitTorrent.Peer
14import Network.BitTorrent.Sessions
15import Network.BitTorrent.Exchange
16import Network.BitTorrent.Tracker
17import Network.BitTorrent.DHT
18
19
20-- discover should hide tracker and DHT communication under the hood
21-- thus we can obtain an unified interface
22
23discover :: SwarmSession -> P2P () -> IO ()
24discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do
25 port <- listenerPort clientSession
26
27 let conn = TConnection {
28 tconnAnnounce = tAnnounce torrentMeta
29 , tconnInfoHash = tInfoHash torrentMeta
30 , tconnPeerId = clientPeerId clientSession
31 , tconnPort = port
32 }
33
34 progress <- getCurrentProgress clientSession
35
36 withTracker progress conn $ \tses -> do
37 forever $ do
38 addr <- getPeerAddr tses
39 forkThrottle swarm $ do
40 initiatePeerSession swarm addr $ \conn ->
41 runP2P conn action
42
43
44startListener :: ClientSession -> PortNumber -> IO ()
45startListener cs @ ClientSession {..} port =
46 startService peerListener port $ listener cs $ \conn @ (sock, PeerSession{..}) -> do
47 print "accepted"
48 let storage = error "storage"
49 runP2P conn (exchange storage)
50
51startDHT :: ClientSession -> PortNumber -> IO ()
52startDHT ClientSession {..} nodePort = withRunning peerListener failure start
53 where
54 start ClientService {..} = do
55 ses <- newNodeSession servPort
56 startService nodeListener nodePort (dhtServer ses)
57
58 failure = throwIO $ userError msg
59 msg = "unable to start DHT server: peer listener is not running"
diff --git a/src/Network/BitTorrent/Sessions.hs b/src/Network/BitTorrent/Sessions.hs
index 31b30e43..da57ec3b 100644
--- a/src/Network/BitTorrent/Sessions.hs
+++ b/src/Network/BitTorrent/Sessions.hs
@@ -19,47 +19,44 @@ module Network.BitTorrent.Sessions
19 , clientPeerId, allowedExtensions 19 , clientPeerId, allowedExtensions
20 , nodeListener, peerListener 20 , nodeListener, peerListener
21 ) 21 )
22 , withClientSession 22 , withClientSession
23 , listenerPort, dhtPort 23 , listenerPort, dhtPort
24 24
25 , ThreadCount 25 , ThreadCount
26 , defaultThreadCount 26 , defaultThreadCount
27 27
28 , TorrentLoc(..) 28 , TorrentLoc(..)
29 , registerTorrent 29 , registerTorrent
30 , unregisterTorrent 30 , unregisterTorrent
31 31
32 , getCurrentProgress 32 , getCurrentProgress
33 , getSwarmCount 33 , getSwarmCount
34 , getPeerCount 34 , getPeerCount
35 35
36 -- * Swarm 36 -- * Swarm
37 , SwarmSession( SwarmSession, torrentMeta, clientSession ) 37 , SwarmSession( SwarmSession, torrentMeta, clientSession )
38 38
39 , SessionCount 39 , SessionCount
40 , getSessionCount 40 , getSessionCount
41 41
42 , newLeecher 42 , newLeecher
43 , newSeeder 43 , newSeeder
44 , getClientBitfield 44 , getClientBitfield
45 45
46 -- TODO hide this 46 -- * Peer
47 , waitVacancy 47 , PeerSession( PeerSession, connectedPeerAddr
48 , forkThrottle 48 , swarmSession, enabledExtensions
49 , sessionState
50 )
51 , SessionState
52 , initiatePeerSession
53 , acceptPeerSession
54 , listener
49 55
50 -- * Peer 56 -- * Timeouts
51 , PeerSession( PeerSession, connectedPeerAddr 57 , updateIncoming, updateOutcoming
52 , swarmSession, enabledExtensions 58 , discover
53 , sessionState 59 ) where
54 )
55 , SessionState
56 , initiatePeerSession
57 , acceptPeerSession
58 , listener
59
60 -- * Timeouts
61 , updateIncoming, updateOutcoming
62 ) where
63 60
64import Prelude hiding (mapM_) 61import Prelude hiding (mapM_)
65 62
@@ -90,10 +87,13 @@ import Data.Bitfield as BF
90import Data.Torrent 87import Data.Torrent
91import Network.BitTorrent.Extension 88import Network.BitTorrent.Extension
92import Network.BitTorrent.Peer 89import Network.BitTorrent.Peer
90import Network.BitTorrent.Sessions.Types
93import Network.BitTorrent.Exchange.Protocol as BT 91import Network.BitTorrent.Exchange.Protocol as BT
94import Network.BitTorrent.Tracker.Protocol as BT 92import Network.BitTorrent.Tracker.Protocol as BT
93import Network.BitTorrent.Tracker as BT
94import Network.BitTorrent.Exchange as BT
95import Network.BitTorrent.DHT as BT
95import System.Torrent.Storage 96import System.Torrent.Storage
96import Network.BitTorrent.Sessions.Types
97 97
98{----------------------------------------------------------------------- 98{-----------------------------------------------------------------------
99 Client Services 99 Client Services
@@ -134,6 +134,23 @@ torrentPresence ClientSession {..} ih = do
134 Client sessions 134 Client sessions
135-----------------------------------------------------------------------} 135-----------------------------------------------------------------------}
136 136
137startListener :: ClientSession -> PortNumber -> IO ()
138startListener cs @ ClientSession {..} port =
139 startService peerListener port $ listener cs $ \conn @ (sock, PeerSession{..}) -> do
140 print "accepted"
141 let storage = error "storage"
142 runP2P conn (exchange storage)
143
144startDHT :: ClientSession -> PortNumber -> IO ()
145startDHT ClientSession {..} nodePort = withRunning peerListener failure start
146 where
147 start ClientService {..} = do
148 ses <- newNodeSession servPort
149 startService nodeListener nodePort (dhtServer ses)
150
151 failure = throwIO $ userError msg
152 msg = "unable to start DHT server: peer listener is not running"
153
137-- | Create a new client session. The data passed to this function are 154-- | Create a new client session. The data passed to this function are
138-- usually loaded from configuration file. 155-- usually loaded from configuration file.
139openClientSession :: SessionCount -- ^ Maximum count of active P2P Sessions. 156openClientSession :: SessionCount -- ^ Maximum count of active P2P Sessions.
@@ -194,6 +211,29 @@ defSeederConns = defaultUnchokeSlots
194defLeacherConns :: SessionCount 211defLeacherConns :: SessionCount
195defLeacherConns = defaultNumWant 212defLeacherConns = defaultNumWant
196 213
214-- discovery should hide tracker and DHT communication under the hood
215-- thus we can obtain an unified interface
216
217discover :: SwarmSession -> P2P () -> IO ()
218discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do
219 port <- listenerPort clientSession
220
221 let conn = TConnection {
222 tconnAnnounce = tAnnounce torrentMeta
223 , tconnInfoHash = tInfoHash torrentMeta
224 , tconnPeerId = clientPeerId clientSession
225 , tconnPort = port
226 }
227
228 progress <- getCurrentProgress clientSession
229
230 withTracker progress conn $ \tses -> do
231 forever $ do
232 addr <- getPeerAddr tses
233 forkThrottle swarm $ do
234 initiatePeerSession swarm addr $ \conn ->
235 runP2P conn action
236
197newSwarmSession :: Int -> Bitfield -> ClientSession -> Torrent 237newSwarmSession :: Int -> Bitfield -> ClientSession -> Torrent
198 -> IO SwarmSession 238 -> IO SwarmSession
199newSwarmSession n bf cs @ ClientSession {..} t @ Torrent {..} 239newSwarmSession n bf cs @ ClientSession {..} t @ Torrent {..}