diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Session.hs | 110 |
1 files changed, 14 insertions, 96 deletions
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs index c24e2b0b..d455ec65 100644 --- a/src/Network/BitTorrent/Exchange/Session.hs +++ b/src/Network/BitTorrent/Exchange/Session.hs | |||
@@ -20,109 +20,27 @@ import Network.BitTorrent.Exchange.Message | |||
20 | import Network.BitTorrent.Exchange.Status | 20 | import Network.BitTorrent.Exchange.Status |
21 | 21 | ||
22 | 22 | ||
23 | type Extension = () | ||
24 | |||
25 | data ExchangeError | 23 | data ExchangeError |
26 | = InvalidPieceIx PieceIx | 24 | = InvalidPieceIx PieceIx |
27 | | InvalidBlock BlockIx | 25 | | InvalidBlock BlockIx |
28 | | CorruptedPiece PieceIx | 26 | | CorruptedPiece PieceIx |
29 | 27 | ||
30 | -- | Peer session contain all data necessary for peer to peer | 28 | data Session = Session |
31 | -- communication. | 29 | { storage :: Storage |
32 | data ExchangeSession = ExchangeSession | 30 | , bitfield :: Bitfield |
33 | { -- | Used as unique identifier of the session. | 31 | , assembler :: Assembler |
34 | connectedPeerAddr :: !PeerAddr | 32 | , peerId :: PeerId |
35 | |||
36 | -- | Extensions such that both peer and client support. | ||
37 | , enabledExtensions :: [Extension] | ||
38 | |||
39 | -- | Broadcast messages waiting to be sent to peer. | ||
40 | , pendingMessages :: !(TChan Message) | ||
41 | |||
42 | -- | Dymanic P2P data. | ||
43 | , sessionState :: !(IORef SessionState) | ||
44 | } | 33 | } |
45 | 34 | ||
46 | instance Eq ExchangeSession where | 35 | type Exchange = StateT Session (ReaderT Connection IO) |
47 | (==) = (==) `on` connectedPeerAddr | ||
48 | {-# INLINE (==) #-} | ||
49 | |||
50 | instance Ord ExchangeSession where | ||
51 | compare = comparing connectedPeerAddr | ||
52 | {-# INLINE compare #-} | ||
53 | |||
54 | enqueueBroadcast :: ExchangeSession -> Message -> IO () | ||
55 | enqueueBroadcast = undefined | ||
56 | |||
57 | dequeueBroadcast :: ExchangeSession -> IO Message | ||
58 | dequeueBroadcast = undefined | ||
59 | |||
60 | {----------------------------------------------------------------------- | ||
61 | -- Session state | ||
62 | -----------------------------------------------------------------------} | ||
63 | |||
64 | data SessionState = SessionState | ||
65 | { _bitfield :: !Bitfield -- ^ Other peer Have bitfield. | ||
66 | , _status :: !SessionStatus -- ^ Status of both peers. | ||
67 | } deriving (Show, Eq) | ||
68 | |||
69 | $(makeLenses ''SessionState) | ||
70 | |||
71 | --initialSessionState :: PieceCount -> SessionState | ||
72 | --initialSessionState pc = SessionState (haveNone pc) def | ||
73 | |||
74 | --getSessionState :: PeerSession -> IO SessionState | ||
75 | --getSessionState PeerSession {..} = readIORef sessionState | ||
76 | |||
77 | {- | ||
78 | {----------------------------------------------------------------------- | ||
79 | -- Broadcasting: Have, Cancel, Bitfield, SuggestPiece | ||
80 | -----------------------------------------------------------------------} | ||
81 | {- | ||
82 | Here we should enqueue broadcast messages and keep in mind that: | ||
83 | * We should enqueue broadcast events as they are appear. | ||
84 | * We should yield broadcast messages as fast as we get them. | ||
85 | |||
86 | these 2 phases might differ in time significantly | ||
87 | |||
88 | **TODO**: do this; but only when it'll be clean which other broadcast | ||
89 | messages & events we should send. | ||
90 | |||
91 | 1. Update client have bitfield --\____ in one transaction; | ||
92 | 2. Update downloaded stats --/ | ||
93 | 3. Signal to the all other peer about this. | ||
94 | -} | ||
95 | |||
96 | available :: Bitfield -> SwarmSession -> STM () | ||
97 | available bf SwarmSession {..} = {-# SCC available #-} do | ||
98 | updateProgress >> broadcast | ||
99 | where | ||
100 | updateProgress = do | ||
101 | let piLen = ciPieceLength $ tInfo $ torrentMeta | ||
102 | let bytes = piLen * BF.haveCount bf | ||
103 | modifyTVar' (currentProgress clientSession) (downloadedProgress bytes) | ||
104 | |||
105 | broadcast = mapM_ (writeTChan broadcastMessages . Have) (BF.toList bf) | ||
106 | |||
107 | -- TODO compute size of messages: if it's faster to send Bitfield | ||
108 | -- instead many Have do that | ||
109 | 36 | ||
110 | -- Also if there is single Have message in queue then the | 37 | --runExchange :: Exchange () -> [PeerAddr] -> IO () |
111 | -- corresponding piece is likely still in memory or disc cache, | 38 | --runExchange exchange peers = do |
112 | -- when we can send SuggestPiece. | 39 | -- forM_ peers $ \ peer -> do |
40 | -- forkIO $ runReaderT (runStateT exchange session ) | ||
113 | 41 | ||
114 | readAvail :: TChan a -> STM [a] | 42 | awaitEvent :: Exchange Event |
115 | readAvail chan = do | 43 | awaitEvent = undefined |
116 | m <- tryReadTChan chan | ||
117 | case m of | ||
118 | Just a -> (:) <$> pure a <*> readAvail chan | ||
119 | Nothing -> return [] | ||
120 | 44 | ||
121 | -- | Get pending messages queue appeared in result of asynchronously | 45 | yieldEvent :: Exchange Event |
122 | -- changed client state. Resulting queue should be sent to a peer | 46 | yieldEvent = undefined |
123 | -- immediately. | ||
124 | -- | ||
125 | getPending :: PeerSession -> IO [Message] | ||
126 | getPending PeerSession {..} = {-# SCC getPending #-} do | ||
127 | atomically (readAvail pendingMessages) | ||
128 | -} \ No newline at end of file | ||