diff options
Diffstat (limited to 'src/Network')
-rw-r--r-- | src/Network/BitTorrent/Sessions/Types.lhs | 120 |
1 files changed, 0 insertions, 120 deletions
diff --git a/src/Network/BitTorrent/Sessions/Types.lhs b/src/Network/BitTorrent/Sessions/Types.lhs index 1a945613..dea47405 100644 --- a/src/Network/BitTorrent/Sessions/Types.lhs +++ b/src/Network/BitTorrent/Sessions/Types.lhs | |||
@@ -314,123 +314,3 @@ INVARIANT: max_sessions_count - sizeof connectedPeers = value vacantPeers | |||
314 | > getClientBitfield :: SwarmSession -> IO Bitfield | 314 | > getClientBitfield :: SwarmSession -> IO Bitfield |
315 | > getClientBitfield SwarmSession {..} = atomically $ getCompleteBitfield storage | 315 | > getClientBitfield SwarmSession {..} = atomically $ getCompleteBitfield storage |
316 | 316 | ||
317 | Peer sessions | ||
318 | ------------------------------------------------------------------------ | ||
319 | |||
320 | > -- | Peer session contain all data necessary for peer to peer | ||
321 | > -- communication. | ||
322 | > data PeerSession = PeerSession { | ||
323 | > -- | Used as unique 'PeerSession' identifier within one | ||
324 | > -- 'SwarmSession'. | ||
325 | > connectedPeerAddr :: !PeerAddr | ||
326 | |||
327 | > -- | The swarm to which both end points belong to. | ||
328 | > , swarmSession :: !SwarmSession | ||
329 | |||
330 | > -- | Extensions such that both peer and client support. | ||
331 | > , enabledExtensions :: [Extension] | ||
332 | |||
333 | > -- | Broadcast messages waiting to be sent to peer. | ||
334 | > , pendingMessages :: !(TChan Message) | ||
335 | |||
336 | > -- | Dymanic P2P data. | ||
337 | > , sessionState :: !(IORef SessionState) | ||
338 | > } | ||
339 | |||
340 | > instance Eq PeerSession where | ||
341 | > (==) = (==) `on` connectedPeerAddr | ||
342 | |||
343 | > instance Ord PeerSession where | ||
344 | > compare = comparing connectedPeerAddr | ||
345 | |||
346 | > findPieceCount :: PeerSession -> PieceCount | ||
347 | > findPieceCount = pieceCount . tInfo . torrentMeta . swarmSession | ||
348 | |||
349 | Peer session state | ||
350 | ------------------------------------------------------------------------ | ||
351 | |||
352 | > data SessionState = SessionState { | ||
353 | > _bitfield :: !Bitfield -- ^ Other peer Have bitfield. | ||
354 | > , _status :: !SessionStatus -- ^ Status of both peers. | ||
355 | > } deriving (Show, Eq) | ||
356 | |||
357 | > $(makeLenses ''SessionState) | ||
358 | |||
359 | > initialSessionState :: PieceCount -> SessionState | ||
360 | > initialSessionState pc = SessionState (haveNone pc) def | ||
361 | |||
362 | > getSessionState :: PeerSession -> IO SessionState | ||
363 | > getSessionState PeerSession {..} = readIORef sessionState | ||
364 | |||
365 | Peer session exceptions | ||
366 | ------------------------------------------------------------------------ | ||
367 | |||
368 | > -- | Exceptions used to interrupt the current P2P session. This | ||
369 | > -- exceptions will NOT affect other P2P sessions, DHT, peer <-> | ||
370 | > -- tracker, or any other session. | ||
371 | > -- | ||
372 | > data SessionException = PeerDisconnected | ||
373 | > | ProtocolError Doc | ||
374 | > | UnknownTorrent InfoHash | ||
375 | > deriving (Show, Typeable) | ||
376 | |||
377 | > instance Exception SessionException | ||
378 | |||
379 | |||
380 | > -- | Do nothing with exception, used with 'handle' or 'try'. | ||
381 | > isSessionException :: Monad m => SessionException -> m () | ||
382 | > isSessionException _ = return () | ||
383 | |||
384 | > -- | The same as 'isSessionException' but output to stdout the catched | ||
385 | > -- exception, for debugging purposes only. | ||
386 | > putSessionException :: SessionException -> IO () | ||
387 | > putSessionException = print | ||
388 | |||
389 | Broadcasting: Have, Cancel, Bitfield, SuggestPiece | ||
390 | ------------------------------------------------------------------------ | ||
391 | |||
392 | Here we should enqueue broadcast messages and keep in mind that: | ||
393 | * We should enqueue broadcast events as they are appear. | ||
394 | * We should yield broadcast messages as fast as we get them. | ||
395 | |||
396 | these 2 phases might differ in time significantly | ||
397 | |||
398 | **TODO**: do this; but only when it'll be clean which other broadcast | ||
399 | messages & events we should send. | ||
400 | |||
401 | 1. Update client have bitfield --\____ in one transaction; | ||
402 | 2. Update downloaded stats --/ | ||
403 | 3. Signal to the all other peer about this. | ||
404 | |||
405 | > available :: Bitfield -> SwarmSession -> STM () | ||
406 | > available bf SwarmSession {..} = {-# SCC available #-} do | ||
407 | > updateProgress >> broadcast | ||
408 | > where | ||
409 | > updateProgress = do | ||
410 | > let piLen = ciPieceLength $ tInfo $ torrentMeta | ||
411 | > let bytes = piLen * BF.haveCount bf | ||
412 | > modifyTVar' (currentProgress clientSession) (downloadedProgress bytes) | ||
413 | > | ||
414 | > broadcast = mapM_ (writeTChan broadcastMessages . Have) (BF.toList bf) | ||
415 | |||
416 | -- TODO compute size of messages: if it's faster to send Bitfield | ||
417 | -- instead many Have do that | ||
418 | |||
419 | -- Also if there is single Have message in queue then the | ||
420 | -- corresponding piece is likely still in memory or disc cache, | ||
421 | -- when we can send SuggestPiece. | ||
422 | |||
423 | -- | Get pending messages queue appeared in result of asynchronously | ||
424 | -- changed client state. Resulting queue should be sent to a peer | ||
425 | -- immediately. | ||
426 | |||
427 | > getPending :: PeerSession -> IO [Message] | ||
428 | > getPending PeerSession {..} = {-# SCC getPending #-} do | ||
429 | > atomically (readAvail pendingMessages) | ||
430 | |||
431 | > readAvail :: TChan a -> STM [a] | ||
432 | > readAvail chan = do | ||
433 | > m <- tryReadTChan chan | ||
434 | > case m of | ||
435 | > Just a -> (:) <$> pure a <*> readAvail chan | ||
436 | > Nothing -> return [] | ||