summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Tracker/RPC
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Tracker/RPC')
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/HTTP.hs2
-rw-r--r--src/Network/BitTorrent/Tracker/RPC/UDP.hs147
2 files changed, 1 insertions, 148 deletions
diff --git a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
index cc5bd318..4a8e5f79 100644
--- a/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/HTTP.hs
@@ -49,7 +49,7 @@ import Network.HTTP.Types.URI (SimpleQuery, renderSimpleQuery)
49 49
50import Data.Torrent.InfoHash (InfoHash) 50import Data.Torrent.InfoHash (InfoHash)
51import Network.BitTorrent.Core.Fingerprint (libUserAgent) 51import Network.BitTorrent.Core.Fingerprint (libUserAgent)
52import Network.BitTorrent.Tracker.Message 52import Network.BitTorrent.Tracker.Message hiding (Request, Response)
53 53
54{----------------------------------------------------------------------- 54{-----------------------------------------------------------------------
55-- Exceptions 55-- Exceptions
diff --git a/src/Network/BitTorrent/Tracker/RPC/UDP.hs b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
index 0c9c3367..35e8b7b6 100644
--- a/src/Network/BitTorrent/Tracker/RPC/UDP.hs
+++ b/src/Network/BitTorrent/Tracker/RPC/UDP.hs
@@ -15,7 +15,6 @@
15{-# LANGUAGE FlexibleInstances #-} 15{-# LANGUAGE FlexibleInstances #-}
16{-# LANGUAGE GeneralizedNewtypeDeriving #-} 16{-# LANGUAGE GeneralizedNewtypeDeriving #-}
17{-# LANGUAGE DeriveDataTypeable #-} 17{-# LANGUAGE DeriveDataTypeable #-}
18{-# LANGUAGE TypeFamilies #-}
19module Network.BitTorrent.Tracker.RPC.UDP 18module Network.BitTorrent.Tracker.RPC.UDP
20 ( -- * Manager 19 ( -- * Manager
21 Options (..) 20 Options (..)
@@ -52,7 +51,6 @@ import Text.Read (readMaybe)
52import Network.Socket hiding (Connected, connect, listen) 51import Network.Socket hiding (Connected, connect, listen)
53import Network.Socket.ByteString as BS 52import Network.Socket.ByteString as BS
54import Network.URI 53import Network.URI
55import System.Entropy
56import System.Timeout 54import System.Timeout
57import Numeric 55import Numeric
58 56
@@ -259,151 +257,6 @@ getTrackerAddr _ uri
259 | otherwise = throwIO (UnrecognizedScheme (uriScheme uri)) 257 | otherwise = throwIO (UnrecognizedScheme (uriScheme uri))
260 258
261{----------------------------------------------------------------------- 259{-----------------------------------------------------------------------
262 Tokens
263-----------------------------------------------------------------------}
264
265genToken :: IO Word64
266genToken = do
267 bs <- getEntropy 8
268 either err return $ runGet getWord64be bs
269 where
270 err = error "genToken: impossible happen"
271
272-- | Connection Id is used for entire tracker session.
273newtype ConnectionId = ConnectionId Word64
274 deriving (Eq, Serialize)
275
276instance Show ConnectionId where
277 showsPrec _ (ConnectionId cid) = showString "0x" <> showHex cid
278
279initialConnectionId :: ConnectionId
280initialConnectionId = ConnectionId 0x41727101980
281
282-- | Transaction Id is used within a UDP RPC.
283newtype TransactionId = TransactionId Word32
284 deriving (Eq, Ord, Enum, Bounded, Serialize)
285
286instance Show TransactionId where
287 showsPrec _ (TransactionId tid) = showString "0x" <> showHex tid
288
289genTransactionId :: IO TransactionId
290genTransactionId = (TransactionId . fromIntegral) <$> genToken
291
292{-----------------------------------------------------------------------
293 Transactions
294-----------------------------------------------------------------------}
295
296data Request = Connect
297 | Announce AnnounceQuery
298 | Scrape ScrapeQuery
299 deriving Show
300
301data Response = Connected ConnectionId
302 | Announced AnnounceInfo
303 | Scraped [ScrapeEntry]
304 | Failed Text
305 deriving Show
306
307responseName :: Response -> String
308responseName (Connected _) = "connected"
309responseName (Announced _) = "announced"
310responseName (Scraped _) = "scraped"
311responseName (Failed _) = "failed"
312
313data family Transaction a
314data instance Transaction Request = TransactionQ
315 { connIdQ :: {-# UNPACK #-} !ConnectionId
316 , transIdQ :: {-# UNPACK #-} !TransactionId
317 , request :: !Request
318 } deriving Show
319data instance Transaction Response = TransactionR
320 { transIdR :: {-# UNPACK #-} !TransactionId
321 , response :: !Response
322 } deriving Show
323
324-- TODO newtype
325newtype MessageId = MessageId Word32
326 deriving (Show, Eq, Num, Serialize)
327
328connectId, announceId, scrapeId, errorId :: MessageId
329connectId = 0
330announceId = 1
331scrapeId = 2
332errorId = 3
333
334instance Serialize (Transaction Request) where
335 put TransactionQ {..} = do
336 case request of
337 Connect -> do
338 put initialConnectionId
339 put connectId
340 put transIdQ
341
342 Announce ann -> do
343 put connIdQ
344 put announceId
345 put transIdQ
346 put ann
347
348 Scrape hashes -> do
349 put connIdQ
350 put scrapeId
351 put transIdQ
352 forM_ hashes put
353
354 get = do
355 cid <- get
356 mid <- get
357 TransactionQ cid <$> get <*> getBody mid
358 where
359 getBody :: MessageId -> Get Request
360 getBody msgId
361 | msgId == connectId = pure Connect
362 | msgId == announceId = Announce <$> get
363 | msgId == scrapeId = Scrape <$> many get
364 | otherwise = fail errMsg
365 where
366 errMsg = "unknown request: " ++ show msgId
367
368instance Serialize (Transaction Response) where
369 put TransactionR {..} = do
370 case response of
371 Connected conn -> do
372 put connectId
373 put transIdR
374 put conn
375
376 Announced info -> do
377 put announceId
378 put transIdR
379 put info
380
381 Scraped infos -> do
382 put scrapeId
383 put transIdR
384 forM_ infos put
385
386 Failed info -> do
387 put errorId
388 put transIdR
389 put (encodeUtf8 info)
390
391
392 get = do
393 mid <- get
394 TransactionR <$> get <*> getBody mid
395 where
396 getBody :: MessageId -> Get Response
397 getBody msgId
398 | msgId == connectId = Connected <$> get
399 | msgId == announceId = Announced <$> get
400 | msgId == scrapeId = Scraped <$> many get
401 | msgId == errorId = (Failed . decodeUtf8) <$> get
402 | otherwise = fail msg
403 where
404 msg = "unknown response: " ++ show msgId
405
406{-----------------------------------------------------------------------
407 Connection 260 Connection
408-----------------------------------------------------------------------} 261-----------------------------------------------------------------------}
409 262