diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 9 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker/Protocol.hs | 30 |
2 files changed, 16 insertions, 23 deletions
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs index b737a3df..25d2c358 100644 --- a/src/Network/BitTorrent/Tracker.hs +++ b/src/Network/BitTorrent/Tracker.hs | |||
@@ -90,8 +90,7 @@ tconnection t = TConnection (tAnnounce t) (tInfoHash t) | |||
90 | -- | used to avoid boilerplate; do NOT export me | 90 | -- | used to avoid boilerplate; do NOT export me |
91 | genericReq :: TConnection -> Progress -> TRequest | 91 | genericReq :: TConnection -> Progress -> TRequest |
92 | genericReq ses pr = TRequest { | 92 | genericReq ses pr = TRequest { |
93 | reqAnnounce = tconnAnnounce ses | 93 | reqInfoHash = tconnInfoHash ses |
94 | , reqInfoHash = tconnInfoHash ses | ||
95 | , reqPeerId = tconnPeerId ses | 94 | , reqPeerId = tconnPeerId ses |
96 | , reqPort = tconnPort ses | 95 | , reqPort = tconnPort ses |
97 | 96 | ||
@@ -221,7 +220,7 @@ withTracker :: Progress -> TConnection -> (TSession -> IO a) -> IO a | |||
221 | withTracker initProgress conn action = bracket start end (action . fst) | 220 | withTracker initProgress conn action = bracket start end (action . fst) |
222 | where | 221 | where |
223 | start = do | 222 | start = do |
224 | resp <- askTracker (startedReq conn initProgress) | 223 | resp <- askTracker (tconnAnnounce conn) (startedReq conn initProgress) |
225 | se <- newSession defaultChanSize initProgress | 224 | se <- newSession defaultChanSize initProgress |
226 | (respInterval resp) (respPeers resp) | 225 | (respInterval resp) (respPeers resp) |
227 | 226 | ||
@@ -232,7 +231,7 @@ withTracker initProgress conn action = bracket start end (action . fst) | |||
232 | waitInterval se | 231 | waitInterval se |
233 | pr <- getProgress se | 232 | pr <- getProgress se |
234 | resp <- tryJust isIOException $ do | 233 | resp <- tryJust isIOException $ do |
235 | askTracker (regularReq defaultNumWant conn pr) | 234 | askTracker (tconnAnnounce conn) (regularReq defaultNumWant conn pr) |
236 | case resp of | 235 | case resp of |
237 | Right (OK {..}) -> do | 236 | Right (OK {..}) -> do |
238 | writeIORef seInterval respInterval | 237 | writeIORef seInterval respInterval |
@@ -252,7 +251,7 @@ withTracker initProgress conn action = bracket start end (action . fst) | |||
252 | end (se, tid) = do | 251 | end (se, tid) = do |
253 | killThread tid | 252 | killThread tid |
254 | pr <- getProgress se | 253 | pr <- getProgress se |
255 | leaveTracker $ stoppedReq conn pr | 254 | leaveTracker (tconnAnnounce conn) (stoppedReq conn pr) |
256 | 255 | ||
257 | {----------------------------------------------------------------------- | 256 | {----------------------------------------------------------------------- |
258 | Scrape | 257 | Scrape |
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs index d61a269c..e844f8b8 100644 --- a/src/Network/BitTorrent/Tracker/Protocol.hs +++ b/src/Network/BitTorrent/Tracker/Protocol.hs | |||
@@ -73,11 +73,8 @@ data Event = Started | |||
73 | -- the torrent. The most important, requests are used by the tracker | 73 | -- the torrent. The most important, requests are used by the tracker |
74 | -- to keep track lists of active peer for a particular torrent. | 74 | -- to keep track lists of active peer for a particular torrent. |
75 | -- | 75 | -- |
76 | data TRequest = TRequest { -- TODO peer here -- TODO detach announce | 76 | data TRequest = TRequest { -- TODO peer here |
77 | reqAnnounce :: !URI | 77 | reqInfoHash :: !InfoHash |
78 | -- ^ Announce url of the torrent usually obtained from 'Torrent'. | ||
79 | |||
80 | , reqInfoHash :: !InfoHash | ||
81 | -- ^ Hash of info part of the torrent usually obtained from | 78 | -- ^ Hash of info part of the torrent usually obtained from |
82 | -- 'Torrent'. | 79 | -- 'Torrent'. |
83 | 80 | ||
@@ -162,7 +159,6 @@ instance BEncodable TResponse where | |||
162 | <*> d >--? "complete" | 159 | <*> d >--? "complete" |
163 | <*> d >--? "incomplete" | 160 | <*> d >--? "incomplete" |
164 | <*> getPeers (M.lookup "peers" d) | 161 | <*> getPeers (M.lookup "peers" d) |
165 | |||
166 | where | 162 | where |
167 | getPeers :: Maybe BEncode -> Result [PeerAddr] | 163 | getPeers :: Maybe BEncode -> Result [PeerAddr] |
168 | getPeers (Just (BList l)) = fromBEncode (BList l) | 164 | getPeers (Just (BList l)) = fromBEncode (BList l) |
@@ -196,9 +192,9 @@ instance URLEncode TRequest where | |||
196 | ] | 192 | ] |
197 | where s :: String -> String; s = id; {-# INLINE s #-} | 193 | where s :: String -> String; s = id; {-# INLINE s #-} |
198 | 194 | ||
199 | encodeRequest :: TRequest -> URI | 195 | encodeRequest :: URI -> TRequest -> URI |
200 | encodeRequest req = URL.urlEncode req | 196 | encodeRequest announce req = URL.urlEncode req |
201 | `addToURI` reqAnnounce req | 197 | `addToURI` announce |
202 | `addHashToURI` reqInfoHash req | 198 | `addHashToURI` reqInfoHash req |
203 | 199 | ||
204 | {----------------------------------------------------------------------- | 200 | {----------------------------------------------------------------------- |
@@ -259,9 +255,7 @@ instance Serialize TRequest where | |||
259 | port <- get | 255 | port <- get |
260 | 256 | ||
261 | return $ TRequest { | 257 | return $ TRequest { |
262 | -- TODO remove reqAnnounce field from TRequest | 258 | reqInfoHash = ih |
263 | reqAnnounce = error "tracker request decode" | ||
264 | , reqInfoHash = ih | ||
265 | , reqPeerId = pid | 259 | , reqPeerId = pid |
266 | , reqPort = port | 260 | , reqPort = port |
267 | , reqUploaded = fromIntegral up | 261 | , reqUploaded = fromIntegral up |
@@ -322,9 +316,9 @@ mkHTTPRequest uri = Request uri GET [] "" | |||
322 | -- announce list. This function throws 'IOException' if it couldn't | 316 | -- announce list. This function throws 'IOException' if it couldn't |
323 | -- send request or receive response or decode response. | 317 | -- send request or receive response or decode response. |
324 | -- | 318 | -- |
325 | askTracker :: TRequest -> IO TResponse | 319 | askTracker :: URI -> TRequest -> IO TResponse |
326 | askTracker req = do | 320 | askTracker announce req = do |
327 | let r = mkHTTPRequest (encodeRequest req) | 321 | let r = mkHTTPRequest (encodeRequest announce req) |
328 | 322 | ||
329 | rawResp <- simpleHTTP r | 323 | rawResp <- simpleHTTP r |
330 | respBody <- getResponseBody rawResp | 324 | respBody <- getResponseBody rawResp |
@@ -339,7 +333,7 @@ askTracker req = do | |||
339 | 333 | ||
340 | -- | The same as the 'askTracker' but ignore response. Used in | 334 | -- | The same as the 'askTracker' but ignore response. Used in |
341 | -- conjunction with 'Stopped'. | 335 | -- conjunction with 'Stopped'. |
342 | leaveTracker :: TRequest -> IO () | 336 | leaveTracker :: URI -> TRequest -> IO () |
343 | leaveTracker req = do | 337 | leaveTracker announce req = do |
344 | let r = mkHTTPRequest (encodeRequest req) | 338 | let r = mkHTTPRequest (encodeRequest announce req) |
345 | void $ simpleHTTP r >>= getResponseBody | 339 | void $ simpleHTTP r >>= getResponseBody |