diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-07-14 01:08:51 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-07-14 01:08:51 +0400 |
commit | f4e4a77a3150b402e93a139a0db54e4dad02d03d (patch) | |
tree | 58b90a07dbd6351adaa09965ed3d28f060b36c58 /src/Network/BitTorrent/Discovery.hs | |
parent | 7ddf7cd76d6f545c4dfbb5c6741024c097375bf1 (diff) |
- Remove discovery module.
Diffstat (limited to 'src/Network/BitTorrent/Discovery.hs')
-rw-r--r-- | src/Network/BitTorrent/Discovery.hs | 59 |
1 files changed, 0 insertions, 59 deletions
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 #-} | ||
3 | module Network.BitTorrent.Discovery | ||
4 | (discover, startListener, startDHT | ||
5 | ) where | ||
6 | |||
7 | import Control.Monad | ||
8 | import Control.Concurrent | ||
9 | import Control.Exception | ||
10 | import Network.Socket | ||
11 | |||
12 | import Data.Torrent | ||
13 | import Network.BitTorrent.Peer | ||
14 | import Network.BitTorrent.Sessions | ||
15 | import Network.BitTorrent.Exchange | ||
16 | import Network.BitTorrent.Tracker | ||
17 | import 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 | |||
23 | discover :: SwarmSession -> P2P () -> IO () | ||
24 | discover 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 | |||
44 | startListener :: ClientSession -> PortNumber -> IO () | ||
45 | startListener 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 | |||
51 | startDHT :: ClientSession -> PortNumber -> IO () | ||
52 | startDHT 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" | ||