diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange.hs')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 47 |
1 files changed, 20 insertions, 27 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs index 0e2799b2..3235a626 100644 --- a/src/Network/BitTorrent/Exchange.hs +++ b/src/Network/BitTorrent/Exchange.hs | |||
@@ -22,19 +22,11 @@ module Network.BitTorrent.Exchange | |||
22 | ) where | 22 | ) where |
23 | 23 | ||
24 | import Control.Applicative | 24 | import Control.Applicative |
25 | import Control.Concurrent | ||
26 | import Control.Concurrent.STM | ||
27 | import Control.Exception | 25 | import Control.Exception |
28 | import Control.Lens | 26 | import Control.Lens |
29 | import Control.Monad.Reader | 27 | import Control.Monad.Reader |
30 | import Control.Monad.State | ||
31 | import Control.Monad.Trans.Resource | 28 | import Control.Monad.Trans.Resource |
32 | 29 | ||
33 | import Data.IORef | ||
34 | import Data.Function | ||
35 | import Data.Ord | ||
36 | import Data.Set as S | ||
37 | |||
38 | import Data.Conduit as C | 30 | import Data.Conduit as C |
39 | import Data.Conduit.Cereal | 31 | import Data.Conduit.Cereal |
40 | import Data.Conduit.Network | 32 | import Data.Conduit.Network |
@@ -49,7 +41,6 @@ import Network.BitTorrent.Extension | |||
49 | import Network.BitTorrent.Peer | 41 | import Network.BitTorrent.Peer |
50 | import Network.BitTorrent.Exchange.Protocol | 42 | import Network.BitTorrent.Exchange.Protocol |
51 | import Data.Bitfield as BF | 43 | import Data.Bitfield as BF |
52 | import Data.Torrent | ||
53 | 44 | ||
54 | 45 | ||
55 | data Event = Available Bitfield | 46 | data Event = Available Bitfield |
@@ -74,7 +65,7 @@ runConduit sock p2p = | |||
74 | awaitMessage :: P2P Message | 65 | awaitMessage :: P2P Message |
75 | awaitMessage = P2P (ReaderT go) | 66 | awaitMessage = P2P (ReaderT go) |
76 | where | 67 | where |
77 | go se = do | 68 | go _ = do |
78 | liftIO $ putStrLn "trying recv:" | 69 | liftIO $ putStrLn "trying recv:" |
79 | mmsg <- await | 70 | mmsg <- await |
80 | case mmsg of | 71 | case mmsg of |
@@ -169,10 +160,10 @@ awaitEvent = awaitMessage >>= go | |||
169 | status.peerStatus.interested .= False | 160 | status.peerStatus.interested .= False |
170 | awaitEvent | 161 | awaitEvent |
171 | 162 | ||
172 | go (Have ix) = do | 163 | go (Have idx) = do |
173 | new <- singletonBF ix | 164 | new <- singletonBF idx |
174 | bitfield %= BF.union new | 165 | bitfield %= BF.union new |
175 | revise | 166 | _ <- revise |
176 | 167 | ||
177 | offer <- peerOffer | 168 | offer <- peerOffer |
178 | if not (BF.null offer) | 169 | if not (BF.null offer) |
@@ -182,7 +173,7 @@ awaitEvent = awaitMessage >>= go | |||
182 | go (Bitfield bf) = do | 173 | go (Bitfield bf) = do |
183 | new <- adjustBF bf | 174 | new <- adjustBF bf |
184 | bitfield .= new | 175 | bitfield .= new |
185 | revise | 176 | _ <- revise |
186 | 177 | ||
187 | offer <- peerOffer | 178 | offer <- peerOffer |
188 | if not (BF.null offer) | 179 | if not (BF.null offer) |
@@ -205,38 +196,40 @@ awaitEvent = awaitMessage >>= go | |||
205 | then return (Fragment blk) | 196 | then return (Fragment blk) |
206 | else awaitEvent | 197 | else awaitEvent |
207 | 198 | ||
208 | {- | 199 | go (Cancel _) = do |
200 | error "cancel message not implemented" | ||
201 | |||
209 | go (Port _) = do | 202 | go (Port _) = do |
210 | requireExtension ExtDHT | 203 | requireExtension ExtDHT |
211 | undefined | 204 | error "port message not implemented" |
212 | 205 | ||
213 | go HaveAll = do | 206 | go HaveAll = do |
214 | requireExtension ExtFast | 207 | requireExtension ExtFast |
215 | bitfield <~ fullBF | 208 | bitfield <~ fullBF |
216 | revise | 209 | _ <- revise |
217 | awaitEvent | 210 | awaitEvent |
218 | 211 | ||
219 | go HaveNone = do | 212 | go HaveNone = do |
220 | requireExtension ExtFast | 213 | requireExtension ExtFast |
221 | bitfield <~ emptyBF | 214 | bitfield <~ emptyBF |
222 | revise | 215 | _ <- revise |
223 | awaitEvent | 216 | awaitEvent |
224 | 217 | ||
225 | go (SuggestPiece ix) = do | 218 | go (SuggestPiece idx) = do |
226 | requireExtension ExtFast | 219 | requireExtension ExtFast |
227 | bf <- use bitfield | 220 | bf <- use bitfield |
228 | if ix `BF.notMember` bf | 221 | if idx `BF.notMember` bf |
229 | then Available <$> singletonBF ix | 222 | then Available <$> singletonBF idx |
230 | else awaitEvent | 223 | else awaitEvent |
231 | 224 | ||
232 | go (RejectRequest ix) = do | 225 | go (RejectRequest _) = do |
233 | requireExtension ExtFast | 226 | requireExtension ExtFast |
234 | awaitMessage | 227 | awaitEvent |
235 | 228 | ||
236 | go (AllowedFast pix) = | 229 | go (AllowedFast _) = do |
237 | requireExtension ExtFast | 230 | requireExtension ExtFast |
238 | awaitMessage | 231 | awaitEvent |
239 | -} | 232 | |
240 | 233 | ||
241 | 234 | ||
242 | -- | | 235 | -- | |
@@ -251,7 +244,7 @@ awaitEvent = awaitMessage >>= go | |||
251 | -- @ | 244 | -- @ |
252 | -- | 245 | -- |
253 | yieldEvent :: Event -> P2P () | 246 | yieldEvent :: Event -> P2P () |
254 | yieldEvent (Available bf) = undefined | 247 | yieldEvent (Available _ ) = undefined |
255 | yieldEvent (Want bix) = do | 248 | yieldEvent (Want bix) = do |
256 | offer <- peerOffer | 249 | offer <- peerOffer |
257 | if ixPiece bix `BF.member` offer | 250 | if ixPiece bix `BF.member` offer |