diff options
-rw-r--r-- | src/Network/BitTorrent/Sessions.hs | 44 | ||||
-rw-r--r-- | src/Network/BitTorrent/Sessions/Types.lhs | 24 |
2 files changed, 1 insertions, 67 deletions
diff --git a/src/Network/BitTorrent/Sessions.hs b/src/Network/BitTorrent/Sessions.hs index 9a1d0c6a..7fcde20b 100644 --- a/src/Network/BitTorrent/Sessions.hs +++ b/src/Network/BitTorrent/Sessions.hs | |||
@@ -43,8 +43,6 @@ module Network.BitTorrent.Sessions | |||
43 | , newSeeder | 43 | , newSeeder |
44 | , getClientBitfield | 44 | , getClientBitfield |
45 | 45 | ||
46 | -- * Timeouts | ||
47 | , updateIncoming, updateOutcoming | ||
48 | , discover | 46 | , discover |
49 | ) where | 47 | ) where |
50 | 48 | ||
@@ -70,8 +68,6 @@ import Network hiding (accept) | |||
70 | import Network.Socket | 68 | import Network.Socket |
71 | import Network.Socket.ByteString | 69 | import Network.Socket.ByteString |
72 | 70 | ||
73 | import GHC.Event as Ev | ||
74 | |||
75 | import Data.Bitfield as BF | 71 | import Data.Bitfield as BF |
76 | import Data.Torrent | 72 | import Data.Torrent |
77 | import Network.BitTorrent.Extension | 73 | import Network.BitTorrent.Extension |
@@ -144,10 +140,6 @@ startDHT ClientSession {..} nodePort = withRunning peerListener failure start | |||
144 | -- usually loaded from configuration file. | 140 | -- usually loaded from configuration file. |
145 | openClientSession :: SessionCount -> [Extension] -> PortNumber -> PortNumber -> IO ClientSession | 141 | openClientSession :: SessionCount -> [Extension] -> PortNumber -> PortNumber -> IO ClientSession |
146 | openClientSession n exts listenerPort _ = do | 142 | openClientSession n exts listenerPort _ = do |
147 | mgr <- Ev.new | ||
148 | -- TODO kill this thread when leave client | ||
149 | _ <- forkIO $ loop mgr | ||
150 | |||
151 | cs <- ClientSession | 143 | cs <- ClientSession |
152 | <$> genPeerId | 144 | <$> genPeerId |
153 | <*> pure exts | 145 | <*> pure exts |
@@ -156,7 +148,6 @@ openClientSession n exts listenerPort _ = do | |||
156 | <*> MSem.new n | 148 | <*> MSem.new n |
157 | <*> pure n | 149 | <*> pure n |
158 | <*> newTVarIO M.empty | 150 | <*> newTVarIO M.empty |
159 | <*> pure mgr | ||
160 | <*> newTVarIO (startProgress 0) | 151 | <*> newTVarIO (startProgress 0) |
161 | <*> newTVarIO HM.empty | 152 | <*> newTVarIO HM.empty |
162 | 153 | ||
@@ -373,9 +364,7 @@ openSession ss @ SwarmSession {..} addr Handshake {..} = do | |||
373 | let clientCaps = encodeExts $ allowedExtensions $ clientSession | 364 | let clientCaps = encodeExts $ allowedExtensions $ clientSession |
374 | let enabled = decodeExts (enabledCaps clientCaps hsReserved) | 365 | let enabled = decodeExts (enabledCaps clientCaps hsReserved) |
375 | ps <- PeerSession addr ss enabled | 366 | ps <- PeerSession addr ss enabled |
376 | <$> registerTimeout (eventManager clientSession) maxIncomingTime (return ()) | 367 | <$> atomically (dupTChan broadcastMessages) |
377 | <*> registerTimeout (eventManager clientSession) maxOutcomingTime (return ()) | ||
378 | <*> atomically (dupTChan broadcastMessages) | ||
379 | <*> (newIORef . initialSessionState . totalCount =<< readTVarIO clientBitfield) | 368 | <*> (newIORef . initialSessionState . totalCount =<< readTVarIO clientBitfield) |
380 | -- TODO we could implement more interesting throtling scheme | 369 | -- TODO we could implement more interesting throtling scheme |
381 | -- using connected peer information | 370 | -- using connected peer information |
@@ -460,34 +449,3 @@ listener cs action serverPort = bracket openListener close loop | |||
460 | bindSocket sock (SockAddrInet serverPort 0) | 449 | bindSocket sock (SockAddrInet serverPort 0) |
461 | listen sock 1 | 450 | listen sock 1 |
462 | return sock | 451 | return sock |
463 | |||
464 | |||
465 | {----------------------------------------------------------------------- | ||
466 | Keepalives | ||
467 | ------------------------------------------------------------------------ | ||
468 | TODO move to exchange | ||
469 | -----------------------------------------------------------------------} | ||
470 | |||
471 | sec :: Int | ||
472 | sec = 1000 * 1000 | ||
473 | |||
474 | maxIncomingTime :: Int | ||
475 | maxIncomingTime = 120 * sec | ||
476 | |||
477 | maxOutcomingTime :: Int | ||
478 | maxOutcomingTime = 1 * sec | ||
479 | |||
480 | -- | Should be called after we have received any message from a peer. | ||
481 | updateIncoming :: PeerSession -> IO () | ||
482 | updateIncoming PeerSession {..} = do | ||
483 | updateTimeout (eventManager (clientSession swarmSession)) | ||
484 | incomingTimeout maxIncomingTime | ||
485 | |||
486 | -- | Should be called before we have send any message to a peer. | ||
487 | updateOutcoming :: PeerSession -> IO () | ||
488 | updateOutcoming PeerSession {..} = | ||
489 | updateTimeout (eventManager (clientSession swarmSession)) | ||
490 | outcomingTimeout maxOutcomingTime | ||
491 | |||
492 | sendKA :: Socket -> IO () | ||
493 | sendKA sock = return () | ||
diff --git a/src/Network/BitTorrent/Sessions/Types.lhs b/src/Network/BitTorrent/Sessions/Types.lhs index 3f9c6db1..855e9a08 100644 --- a/src/Network/BitTorrent/Sessions/Types.lhs +++ b/src/Network/BitTorrent/Sessions/Types.lhs | |||
@@ -58,8 +58,6 @@ | |||
58 | 58 | ||
59 | > import Network | 59 | > import Network |
60 | 60 | ||
61 | > import GHC.Event as Ev | ||
62 | |||
63 | > import Data.Bitfield as BF | 61 | > import Data.Bitfield as BF |
64 | > import Data.Torrent | 62 | > import Data.Torrent |
65 | > import Network.BitTorrent.Extension | 63 | > import Network.BitTorrent.Extension |
@@ -272,8 +270,6 @@ and different enabled extensions at the same time. | |||
272 | > -- | Used to traverse the swarm session. | 270 | > -- | Used to traverse the swarm session. |
273 | > , swarmSessions :: !(TVar (Map InfoHash SwarmSession)) | 271 | > , swarmSessions :: !(TVar (Map InfoHash SwarmSession)) |
274 | 272 | ||
275 | > , eventManager :: !EventManager | ||
276 | |||
277 | > -- | Used to keep track global client progress. | 273 | > -- | Used to keep track global client progress. |
278 | > , currentProgress :: !(TVar Progress) | 274 | > , currentProgress :: !(TVar Progress) |
279 | 275 | ||
@@ -394,26 +390,6 @@ Peer sessions | |||
394 | > -- | Extensions such that both peer and client support. | 390 | > -- | Extensions such that both peer and client support. |
395 | > , enabledExtensions :: [Extension] | 391 | > , enabledExtensions :: [Extension] |
396 | 392 | ||
397 | To dissconnect from died peers appropriately we should check if a peer | ||
398 | do not sent the KA message within given interval. If yes, we should | ||
399 | throw an exception in 'TimeoutCallback' and close session between | ||
400 | peers. | ||
401 | |||
402 | We should update timeout if we /receive/ any message within timeout | ||
403 | interval to keep connection up. | ||
404 | |||
405 | > , incomingTimeout :: !TimeoutKey | ||
406 | |||
407 | To send KA message appropriately we should know when was last time we | ||
408 | sent a message to a peer. To do that we keep registered timeout in | ||
409 | event manager and if we do not sent any message to the peer within | ||
410 | given interval then we send KA message in 'TimeoutCallback'. | ||
411 | |||
412 | We should update timeout if we /send/ any message within timeout to | ||
413 | avoid reduntant KA messages. | ||
414 | |||
415 | > , outcomingTimeout :: !TimeoutKey | ||
416 | > | ||
417 | > -- | Broadcast messages waiting to be sent to peer. | 393 | > -- | Broadcast messages waiting to be sent to peer. |
418 | > , pendingMessages :: !(TChan Message) | 394 | > , pendingMessages :: !(TChan Message) |
419 | 395 | ||