summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent.hs43
-rw-r--r--src/Network/BitTorrent/Exchange.hs1
-rw-r--r--src/Network/BitTorrent/Internal.hs26
3 files changed, 48 insertions, 22 deletions
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index c37129cb..8f0f42ce 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -7,35 +7,50 @@
7-- 7--
8{-# LANGUAGE RecordWildCards #-} 8{-# LANGUAGE RecordWildCards #-}
9module Network.BitTorrent 9module Network.BitTorrent
10 ( module BT 10 (
11 , module Data.Torrent 11 module Data.Torrent
12 12
13 -- * Tracker 13 -- * Session
14 , ClientSession
15 , newClient
14 16
15 -- * P2P 17 , SwarmSession
16 , ClientSession, newClient 18 , newLeacher, newSeeder
17 , SwarmSession, newLeacher, newSeeder 19
18 , PeerSession 20 -- * Discovery
19 , discover 21 , discover
22
23 -- * Peer to Peer
24 , P2P, PeerSession
25 ( connectedPeerAddr, enabledExtensions
26 , peerBitfield, peerSessionStatus
27 )
28
29 , awaitEvent, signalEvent
20 ) where 30 ) where
21 31
32import Control.Monad
22import Data.IORef 33import Data.IORef
23 34
24import Data.Torrent 35import Data.Torrent
25import Network.BitTorrent.Internal 36import Network.BitTorrent.Internal
26import Network.BitTorrent.Extension as BT 37import Network.BitTorrent.Exchange
27import Network.BitTorrent.Peer as BT 38import Network.BitTorrent.Tracker
28import Network.BitTorrent.Exchange as BT 39
29import Network.BitTorrent.Tracker as BT 40
30 41
31-- discover should hide tracker and DHT communication under the hood 42-- discover should hide tracker and DHT communication under the hood
32-- thus we can obtain unified interface 43-- thus we can obtain unified interface
33 44
34discover :: SwarmSession -> (TSession -> IO a) -> IO a 45discover :: SwarmSession -> P2P () -> IO ()
35discover SwarmSession {..} action = do 46discover swarm @ SwarmSession {..} action = do
36 let conn = TConnection (tAnnounce torrentMeta) (tInfoHash torrentMeta) 47 let conn = TConnection (tAnnounce torrentMeta) (tInfoHash torrentMeta)
37 (clientPeerID clientSession) port 48 (clientPeerID clientSession) port
38 progress <- readIORef (currentProgress clientSession) 49 progress <- readIORef (currentProgress clientSession)
39 withTracker progress conn action 50 withTracker progress conn $ \tses -> do
51 forever $ do
52 addr <- getPeerAddr tses
53 withPeer swarm addr action
54
40 55
41port = 10000 56port = 10000
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index dd1f9d0b..2173cf8b 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -45,6 +45,7 @@ import Data.Torrent
45data Event = Available Bitfield 45data Event = Available Bitfield
46 | Want 46 | Want
47 | Block 47 | Block
48 deriving Show
48 49
49{----------------------------------------------------------------------- 50{-----------------------------------------------------------------------
50 Peer wire 51 Peer wire
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index e231fb2c..39e10ce2 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -85,11 +85,16 @@ instance Ord ClientSession where
85 compare = comparing clientPeerID 85 compare = comparing clientPeerID
86 86
87newClient :: [Extension] -> IO ClientSession 87newClient :: [Extension] -> IO ClientSession
88newClient exts = ClientSession <$> newPeerID 88newClient exts = do
89 <*> pure exts 89 mgr <- Ev.new
90 <*> newTVarIO S.empty 90 forkIO $ loop mgr
91 <*> Ev.new 91
92 <*> newIORef (startProgress 0) 92 ClientSession
93 <$> newPeerID
94 <*> pure exts
95 <*> newTVarIO S.empty
96 <*> pure mgr
97 <*> newIORef (startProgress 0)
93 98
94{----------------------------------------------------------------------- 99{-----------------------------------------------------------------------
95 Swarm session 100 Swarm session
@@ -207,7 +212,7 @@ maxIncomingTime :: Int
207maxIncomingTime = 120 * sec 212maxIncomingTime = 120 * sec
208 213
209maxOutcomingTime :: Int 214maxOutcomingTime :: Int
210maxOutcomingTime = 60 * sec 215maxOutcomingTime = 1 * sec
211 216
212-- | Should be called after we have received any message from a peer. 217-- | Should be called after we have received any message from a peer.
213updateIncoming :: PeerSession -> IO () 218updateIncoming :: PeerSession -> IO ()
@@ -221,8 +226,13 @@ updateOutcoming PeerSession {..} =
221 updateTimeout (eventManager (clientSession swarmSession)) 226 updateTimeout (eventManager (clientSession swarmSession))
222 outcomingTimeout maxOutcomingTime 227 outcomingTimeout maxOutcomingTime
223 228
224sendKA :: Socket -> IO () 229sendKA :: Socket -> SwarmSession -> IO ()
225sendKA sock = sendAll sock (encode BT.KeepAlive) 230sendKA sock SwarmSession {..} = do
231 print "I'm sending keep alive."
232 sendAll sock (encode BT.KeepAlive)
233 let mgr = eventManager clientSession
234 updateTimeout mgr
235 print "Done.."
226 236
227abortSession :: IO () 237abortSession :: IO ()
228abortSession = error "abortSession: not implemented" 238abortSession = error "abortSession: not implemented"