summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker')
-rw-r--r--src/Network/BitTorrent/Tracker/Protocol.hs32
1 files changed, 10 insertions, 22 deletions
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs
index e7755a10..3f264aed 100644
--- a/src/Network/BitTorrent/Tracker/Protocol.hs
+++ b/src/Network/BitTorrent/Tracker/Protocol.hs
@@ -63,6 +63,7 @@ import Network
63import Network.Socket 63import Network.Socket
64 64
65import Network.BitTorrent.Peer 65import Network.BitTorrent.Peer
66import Network.BitTorrent.Sessions.Types
66 67
67{----------------------------------------------------------------------- 68{-----------------------------------------------------------------------
68 Announce messages 69 Announce messages
@@ -97,14 +98,8 @@ data AnnounceQuery = AnnounceQuery {
97 -- peers. Normally, tracker should respond with this port when 98 -- peers. Normally, tracker should respond with this port when
98 -- some peer request the tracker with the same info hash. 99 -- some peer request the tracker with the same info hash.
99 100
100 , reqUploaded :: !Integer 101 , reqProgress :: !Progress
101 -- ^ Number of bytes that the peer has uploaded in the swarm. 102 -- ^ Current progress of peer doing request.
102
103 , reqDownloaded :: !Integer
104 -- ^ Number of bytes downloaded in the swarm by the peer.
105
106 , reqLeft :: !Integer
107 -- ^ Number of bytes needed in order to complete download.
108 103
109 , reqIP :: Maybe HostAddress 104 , reqIP :: Maybe HostAddress
110 -- ^ The peer IP. Needed only when client communicated with 105 -- ^ The peer IP. Needed only when client communicated with
@@ -213,9 +208,9 @@ instance URLEncode AnnounceQuery where
213 urlEncode AnnounceQuery {..} = mconcat 208 urlEncode AnnounceQuery {..} = mconcat
214 [ s "peer_id" %= reqPeerId 209 [ s "peer_id" %= reqPeerId
215 , s "port" %= reqPort 210 , s "port" %= reqPort
216 , s "uploaded" %= reqUploaded 211 , s "uploaded" %= _uploaded reqProgress
217 , s "downloaded" %= reqDownloaded 212 , s "left" %= _left reqProgress
218 , s "left" %= reqLeft 213 , s "downloaded" %= _downloaded reqProgress
219 , s "ip" %=? reqIP 214 , s "ip" %=? reqIP
220 , s "numwant" %=? reqNumWant 215 , s "numwant" %=? reqNumWant
221 , s "event" %=? reqEvent 216 , s "event" %=? reqEvent
@@ -248,15 +243,12 @@ getEvent = do
248 3 -> return $ Just Stopped 243 3 -> return $ Just Stopped
249 _ -> fail "unknown event id" 244 _ -> fail "unknown event id"
250 245
246
251instance Serialize AnnounceQuery where 247instance Serialize AnnounceQuery where
252 put AnnounceQuery {..} = do 248 put AnnounceQuery {..} = do
253 put reqInfoHash 249 put reqInfoHash
254 put reqPeerId 250 put reqPeerId
255 251 put reqProgress
256 putWord64be $ fromIntegral reqDownloaded
257 putWord64be $ fromIntegral reqLeft
258 putWord64be $ fromIntegral reqUploaded
259
260 putEvent reqEvent 252 putEvent reqEvent
261 putWord32be $ fromMaybe 0 reqIP 253 putWord32be $ fromMaybe 0 reqIP
262 putWord32be $ 0 -- TODO what the fuck is "key"? 254 putWord32be $ 0 -- TODO what the fuck is "key"?
@@ -268,9 +260,7 @@ instance Serialize AnnounceQuery where
268 ih <- get 260 ih <- get
269 pid <- get 261 pid <- get
270 262
271 down <- getWord64be 263 progress <- get
272 left <- getWord64be
273 up <- getWord64be
274 264
275 ev <- getEvent 265 ev <- getEvent
276 ip <- getWord32be 266 ip <- getWord32be
@@ -283,9 +273,7 @@ instance Serialize AnnounceQuery where
283 reqInfoHash = ih 273 reqInfoHash = ih
284 , reqPeerId = pid 274 , reqPeerId = pid
285 , reqPort = port 275 , reqPort = port
286 , reqUploaded = fromIntegral up 276 , reqProgress = progress
287 , reqDownloaded = fromIntegral down
288 , reqLeft = fromIntegral left
289 , reqIP = if ip == 0 then Nothing else Just ip 277 , reqIP = if ip == 0 then Nothing else Just ip
290 , reqNumWant = if want == -1 then Nothing else Just (fromIntegral want) 278 , reqNumWant = if want == -1 then Nothing else Just (fromIntegral want)
291 , reqEvent = ev 279 , reqEvent = ev