diff options
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r-- | src/Network/BitTorrent/Tracker/Protocol.hs | 30 |
1 files changed, 12 insertions, 18 deletions
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 |