summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Internal.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Internal.hs')
-rw-r--r--src/Network/BitTorrent/Internal.hs29
1 files changed, 17 insertions, 12 deletions
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index f762bf34..2fadd9ce 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -58,6 +58,7 @@ module Network.BitTorrent.Internal
58import Control.Applicative 58import Control.Applicative
59import Control.Concurrent 59import Control.Concurrent
60import Control.Concurrent.STM 60import Control.Concurrent.STM
61import Control.Concurrent.MSem as MSem
61import Control.Lens 62import Control.Lens
62import Control.Monad.State 63import Control.Monad.State
63import Control.Monad.Reader 64import Control.Monad.Reader
@@ -106,6 +107,8 @@ startProgress = Progress 0 0
106 Client session 107 Client session
107-----------------------------------------------------------------------} 108-----------------------------------------------------------------------}
108 109
110type ThreadCount = Int
111
109-- | In one application we could have many clients with difference 112-- | In one application we could have many clients with difference
110-- ID's and different enabled extensions. 113-- ID's and different enabled extensions.
111data ClientSession = ClientSession { 114data ClientSession = ClientSession {
@@ -119,10 +122,10 @@ data ClientSession = ClientSession {
119 , allowedExtensions :: [Extension] 122 , allowedExtensions :: [Extension]
120 123
121 -- | Semaphor used to bound number of active P2P sessions. 124 -- | Semaphor used to bound number of active P2P sessions.
122 , activeThreads :: QSem 125 , activeThreads :: MSem ThreadCount
123 126
124 -- | Max number of active connections. 127 -- | Max number of active connections.
125 , maxActive :: Int 128 , maxActive :: ThreadCount
126 129
127 , swarmSessions :: TVar (Set SwarmSession) 130 , swarmSessions :: TVar (Set SwarmSession)
128 131
@@ -139,7 +142,7 @@ instance Ord ClientSession where
139getCurrentProgress :: MonadIO m => ClientSession -> m Progress 142getCurrentProgress :: MonadIO m => ClientSession -> m Progress
140getCurrentProgress = liftIO . readTVarIO . currentProgress 143getCurrentProgress = liftIO . readTVarIO . currentProgress
141 144
142newClient :: Int -- ^ Maximum count of active P2P Sessions. 145newClient :: ThreadCount -- ^ Maximum count of active P2P Sessions.
143 -> [Extension] -- ^ Extensions allowed to use. 146 -> [Extension] -- ^ Extensions allowed to use.
144 -> IO ClientSession 147 -> IO ClientSession
145 148
@@ -151,7 +154,7 @@ newClient n exts = do
151 ClientSession 154 ClientSession
152 <$> newPeerID 155 <$> newPeerID
153 <*> pure exts 156 <*> pure exts
154 <*> newQSem n 157 <*> MSem.new n
155 <*> pure n 158 <*> pure n
156 <*> newTVarIO S.empty 159 <*> newTVarIO S.empty
157 <*> pure mgr 160 <*> pure mgr
@@ -161,6 +164,8 @@ newClient n exts = do
161 Swarm session 164 Swarm session
162-----------------------------------------------------------------------} 165-----------------------------------------------------------------------}
163 166
167type SessionCount = Int
168
164-- | Extensions are set globally by 169-- | Extensions are set globally by
165-- Swarm session are un 170-- Swarm session are un
166data SwarmSession = SwarmSession { 171data SwarmSession = SwarmSession {
@@ -169,7 +174,7 @@ data SwarmSession = SwarmSession {
169 174
170 -- | Represent count of peers we _currently_ can connect to in the 175 -- | Represent count of peers we _currently_ can connect to in the
171 -- swarm. Used to bound number of concurrent threads. 176 -- swarm. Used to bound number of concurrent threads.
172 , vacantPeers :: QSem 177 , vacantPeers :: MSem SessionCount
173 178
174 -- | Modify this carefully updating global progress. 179 -- | Modify this carefully updating global progress.
175 , clientBitfield :: TVar Bitfield 180 , clientBitfield :: TVar Bitfield
@@ -187,7 +192,7 @@ newSwarmSession :: Int -> Bitfield -> ClientSession -> Torrent
187newSwarmSession n bf cs @ ClientSession {..} t @ Torrent {..} 192newSwarmSession n bf cs @ ClientSession {..} t @ Torrent {..}
188 = SwarmSession <$> pure t 193 = SwarmSession <$> pure t
189 <*> pure cs 194 <*> pure cs
190 <*> newQSem n 195 <*> MSem.new n
191 <*> newTVarIO bf 196 <*> newTVarIO bf
192 <*> newTVarIO S.empty 197 <*> newTVarIO S.empty
193 198
@@ -199,10 +204,10 @@ newLeacher :: ClientSession -> Torrent -> IO SwarmSession
199newLeacher cs t @ Torrent {..} 204newLeacher cs t @ Torrent {..}
200 = newSwarmSession defLeacherConns (haveNone (pieceCount tInfo)) cs t 205 = newSwarmSession defLeacherConns (haveNone (pieceCount tInfo)) cs t
201 206
202defSeederConns :: Int 207defSeederConns :: SessionCount
203defSeederConns = defaultUnchokeSlots 208defSeederConns = defaultUnchokeSlots
204 209
205defLeacherConns :: Int 210defLeacherConns :: SessionCount
206defLeacherConns = defaultNumWant 211defLeacherConns = defaultNumWant
207 212
208--isLeacher :: SwarmSession -> IO Bool 213--isLeacher :: SwarmSession -> IO Bool
@@ -219,13 +224,13 @@ haveDone ix =
219 224
220enterSwarm :: SwarmSession -> IO () 225enterSwarm :: SwarmSession -> IO ()
221enterSwarm SwarmSession {..} = do 226enterSwarm SwarmSession {..} = do
222 waitQSem (activeThreads clientSession) 227 MSem.wait (activeThreads clientSession)
223 waitQSem vacantPeers 228 MSem.wait vacantPeers
224 229
225leaveSwarm :: SwarmSession -> IO () 230leaveSwarm :: SwarmSession -> IO ()
226leaveSwarm SwarmSession {..} = do 231leaveSwarm SwarmSession {..} = do
227 signalQSem vacantPeers 232 MSem.signal vacantPeers
228 signalQSem (activeThreads clientSession) 233 MSem.signal (activeThreads clientSession)
229 234
230waitVacancy :: SwarmSession -> IO () -> IO () 235waitVacancy :: SwarmSession -> IO () -> IO ()
231waitVacancy se = 236waitVacancy se =