summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Sessions.hs44
-rw-r--r--src/Network/BitTorrent/Sessions/Types.lhs24
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)
70import Network.Socket 68import Network.Socket
71import Network.Socket.ByteString 69import Network.Socket.ByteString
72 70
73import GHC.Event as Ev
74
75import Data.Bitfield as BF 71import Data.Bitfield as BF
76import Data.Torrent 72import Data.Torrent
77import Network.BitTorrent.Extension 73import 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.
145openClientSession :: SessionCount -> [Extension] -> PortNumber -> PortNumber -> IO ClientSession 141openClientSession :: SessionCount -> [Extension] -> PortNumber -> PortNumber -> IO ClientSession
146openClientSession n exts listenerPort _ = do 142openClientSession 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------------------------------------------------------------------------
468TODO move to exchange
469-----------------------------------------------------------------------}
470
471sec :: Int
472sec = 1000 * 1000
473
474maxIncomingTime :: Int
475maxIncomingTime = 120 * sec
476
477maxOutcomingTime :: Int
478maxOutcomingTime = 1 * sec
479
480-- | Should be called after we have received any message from a peer.
481updateIncoming :: PeerSession -> IO ()
482updateIncoming PeerSession {..} = do
483 updateTimeout (eventManager (clientSession swarmSession))
484 incomingTimeout maxIncomingTime
485
486-- | Should be called before we have send any message to a peer.
487updateOutcoming :: PeerSession -> IO ()
488updateOutcoming PeerSession {..} =
489 updateTimeout (eventManager (clientSession swarmSession))
490 outcomingTimeout maxOutcomingTime
491
492sendKA :: Socket -> IO ()
493sendKA 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
397To dissconnect from died peers appropriately we should check if a peer
398do not sent the KA message within given interval. If yes, we should
399throw an exception in 'TimeoutCallback' and close session between
400peers.
401
402We should update timeout if we /receive/ any message within timeout
403interval to keep connection up.
404
405> , incomingTimeout :: !TimeoutKey
406
407To send KA message appropriately we should know when was last time we
408sent a message to a peer. To do that we keep registered timeout in
409event manager and if we do not sent any message to the peer within
410given interval then we send KA message in 'TimeoutCallback'.
411
412We should update timeout if we /send/ any message within timeout to
413avoid 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