diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Sessions.hs | 43 | ||||
-rw-r--r-- | src/Network/BitTorrent/Sessions/Types.lhs | 8 |
2 files changed, 32 insertions, 19 deletions
diff --git a/src/Network/BitTorrent/Sessions.hs b/src/Network/BitTorrent/Sessions.hs index 2e51fde6..9a1d0c6a 100644 --- a/src/Network/BitTorrent/Sessions.hs +++ b/src/Network/BitTorrent/Sessions.hs | |||
@@ -48,7 +48,7 @@ module Network.BitTorrent.Sessions | |||
48 | , discover | 48 | , discover |
49 | ) where | 49 | ) where |
50 | 50 | ||
51 | import Prelude hiding (mapM_) | 51 | import Prelude hiding (mapM_, elem) |
52 | 52 | ||
53 | import Control.Applicative | 53 | import Control.Applicative |
54 | import Control.Concurrent | 54 | import Control.Concurrent |
@@ -61,6 +61,7 @@ import Control.Monad.Trans | |||
61 | import Data.IORef | 61 | import Data.IORef |
62 | import Data.Map as M | 62 | import Data.Map as M |
63 | import Data.HashMap.Strict as HM | 63 | import Data.HashMap.Strict as HM |
64 | import Data.Foldable as F | ||
64 | import Data.Set as S | 65 | import Data.Set as S |
65 | 66 | ||
66 | import Data.Serialize hiding (get) | 67 | import Data.Serialize hiding (get) |
@@ -141,14 +142,13 @@ startDHT ClientSession {..} nodePort = withRunning peerListener failure start | |||
141 | 142 | ||
142 | -- | Create a new client session. The data passed to this function are | 143 | -- | Create a new client session. The data passed to this function are |
143 | -- usually loaded from configuration file. | 144 | -- usually loaded from configuration file. |
144 | openClientSession :: SessionCount -- ^ Maximum count of active P2P Sessions. | 145 | openClientSession :: SessionCount -> [Extension] -> PortNumber -> PortNumber -> IO ClientSession |
145 | -> [Extension] -- ^ Extensions allowed to use. | 146 | openClientSession n exts listenerPort _ = do |
146 | -> IO ClientSession -- ^ Client with unique peer ID. | ||
147 | openClientSession n exts = do | ||
148 | mgr <- Ev.new | 147 | mgr <- Ev.new |
149 | -- TODO kill this thread when leave client | 148 | -- TODO kill this thread when leave client |
150 | _ <- forkIO $ loop mgr | 149 | _ <- forkIO $ loop mgr |
151 | ClientSession | 150 | |
151 | cs <- ClientSession | ||
152 | <$> genPeerId | 152 | <$> genPeerId |
153 | <*> pure exts | 153 | <*> pure exts |
154 | <*> newEmptyMVar | 154 | <*> newEmptyMVar |
@@ -160,13 +160,21 @@ openClientSession n exts = do | |||
160 | <*> newTVarIO (startProgress 0) | 160 | <*> newTVarIO (startProgress 0) |
161 | <*> newTVarIO HM.empty | 161 | <*> newTVarIO HM.empty |
162 | 162 | ||
163 | startListener cs listenerPort | ||
164 | return cs | ||
165 | |||
163 | closeClientSession :: ClientSession -> IO () | 166 | closeClientSession :: ClientSession -> IO () |
164 | closeClientSession ClientSession {..} = | 167 | closeClientSession ClientSession {..} = do |
165 | stopService nodeListener `finally` stopService peerListener | 168 | stopService nodeListener |
166 | -- TODO stop all swarm sessions | 169 | stopService peerListener |
170 | |||
171 | sws <- readTVarIO swarmSessions | ||
172 | forM_ sws closeSwarmSession | ||
167 | 173 | ||
168 | withClientSession :: SessionCount -> [Extension] -> (ClientSession -> IO ()) -> IO () | 174 | withClientSession :: SessionCount -> [Extension] |
169 | withClientSession c es = bracket (openClientSession c es) closeClientSession | 175 | -> PortNumber -> PortNumber |
176 | -> (ClientSession -> IO ()) -> IO () | ||
177 | withClientSession c es l d = bracket (openClientSession c es l d) closeClientSession | ||
170 | 178 | ||
171 | -- | Get current global progress of the client. This value is usually | 179 | -- | Get current global progress of the client. This value is usually |
172 | -- shown to a user. | 180 | -- shown to a user. |
@@ -222,6 +230,14 @@ discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do | |||
222 | initiatePeerSession swarm addr $ \conn -> | 230 | initiatePeerSession swarm addr $ \conn -> |
223 | runP2P conn action | 231 | runP2P conn action |
224 | 232 | ||
233 | registerSwarmSession :: SwarmSession -> IO () | ||
234 | registerSwarmSession = undefined | ||
235 | |||
236 | unregisterSwarmSession :: SwarmSession -> IO () | ||
237 | unregisterSwarmSession SwarmSession {..} = | ||
238 | atomically $ modifyTVar (swarmSessions clientSession) $ | ||
239 | M.delete $ tInfoHash torrentMeta | ||
240 | |||
225 | newSwarmSession :: Int -> Bitfield -> ClientSession -> Torrent | 241 | newSwarmSession :: Int -> Bitfield -> ClientSession -> Torrent |
226 | -> IO SwarmSession | 242 | -> IO SwarmSession |
227 | newSwarmSession n bf cs @ ClientSession {..} t @ Torrent {..} | 243 | newSwarmSession n bf cs @ ClientSession {..} t @ Torrent {..} |
@@ -246,11 +262,6 @@ closeSwarmSession se @ SwarmSession {..} = do | |||
246 | -- TODO the order is important! | 262 | -- TODO the order is important! |
247 | closeStorage storage | 263 | closeStorage storage |
248 | 264 | ||
249 | unregisterSwarmSession :: SwarmSession -> IO () | ||
250 | unregisterSwarmSession SwarmSession {..} = | ||
251 | atomically $ modifyTVar (swarmSessions clientSession) $ | ||
252 | M.delete $ tInfoHash torrentMeta | ||
253 | |||
254 | getSwarm :: ClientSession -> InfoHash -> IO SwarmSession | 265 | getSwarm :: ClientSession -> InfoHash -> IO SwarmSession |
255 | getSwarm cs @ ClientSession {..} ih = do | 266 | getSwarm cs @ ClientSession {..} ih = do |
256 | ss <- readTVarIO swarmSessions | 267 | ss <- readTVarIO swarmSessions |
diff --git a/src/Network/BitTorrent/Sessions/Types.lhs b/src/Network/BitTorrent/Sessions/Types.lhs index f94dbfa6..3f9c6db1 100644 --- a/src/Network/BitTorrent/Sessions/Types.lhs +++ b/src/Network/BitTorrent/Sessions/Types.lhs | |||
@@ -73,10 +73,12 @@ Thread layout | |||
73 | 73 | ||
74 | When client session created 2 new threads appear: | 74 | When client session created 2 new threads appear: |
75 | 75 | ||
76 | * DHT listener - replies to DHT requests; | ||
77 | |||
78 | * Peer listener - accept new P2P connection initiated by other | 76 | * Peer listener - accept new P2P connection initiated by other |
79 | peers. | 77 | peers; |
78 | |||
79 | * Tracker announcer - announce that the peer have this torrent. | ||
80 | |||
81 | * OPTIONAL: DHT listener - replies to DHT requests; | ||
80 | 82 | ||
81 | When swarn session created 3 new threads appear: | 83 | When swarn session created 3 new threads appear: |
82 | 84 | ||