summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Tracker.hs9
-rw-r--r--src/Network/BitTorrent/Tracker/Protocol.hs30
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
91genericReq :: TConnection -> Progress -> TRequest 91genericReq :: TConnection -> Progress -> TRequest
92genericReq ses pr = TRequest { 92genericReq 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
221withTracker initProgress conn action = bracket start end (action . fst) 220withTracker 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--
76data TRequest = TRequest { -- TODO peer here -- TODO detach announce 76data 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
199encodeRequest :: TRequest -> URI 195encodeRequest :: URI -> TRequest -> URI
200encodeRequest req = URL.urlEncode req 196encodeRequest 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--
325askTracker :: TRequest -> IO TResponse 319askTracker :: URI -> TRequest -> IO TResponse
326askTracker req = do 320askTracker 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'.
342leaveTracker :: TRequest -> IO () 336leaveTracker :: URI -> TRequest -> IO ()
343leaveTracker req = do 337leaveTracker 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