diff options
Diffstat (limited to 'bittorrent/src/Network/BitTorrent/Tracker/Message.hs')
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker/Message.hs | 22 |
1 files changed, 11 insertions, 11 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/Message.hs b/bittorrent/src/Network/BitTorrent/Tracker/Message.hs index b9b6a9d3..e01ebbf4 100644 --- a/bittorrent/src/Network/BitTorrent/Tracker/Message.hs +++ b/bittorrent/src/Network/BitTorrent/Tracker/Message.hs | |||
@@ -404,8 +404,8 @@ parseAnnounceQuery params = AnnounceQuery | |||
404 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> | 404 | -- For more info see: <http://www.bittorrent.org/beps/bep_0023.html> |
405 | -- | 405 | -- |
406 | data PeerList ip | 406 | data PeerList ip |
407 | = PeerList [PeerAddr IP] | 407 | = PeerList [PeerAddr] |
408 | | CompactPeerList [PeerAddr ip] | 408 | | CompactPeerList [PeerAddr] |
409 | deriving (Show, Eq, Typeable, Functor) | 409 | deriving (Show, Eq, Typeable, Functor) |
410 | 410 | ||
411 | -- | The empty non-compact peer list. | 411 | -- | The empty non-compact peer list. |
@@ -413,11 +413,11 @@ instance Default (PeerList IP) where | |||
413 | def = PeerList [] | 413 | def = PeerList [] |
414 | {-# INLINE def #-} | 414 | {-# INLINE def #-} |
415 | 415 | ||
416 | getPeerList :: PeerList IP -> [PeerAddr IP] | 416 | getPeerList :: PeerList IP -> [PeerAddr] |
417 | getPeerList (PeerList xs) = xs | 417 | getPeerList (PeerList xs) = xs |
418 | getPeerList (CompactPeerList xs) = xs | 418 | getPeerList (CompactPeerList xs) = xs |
419 | 419 | ||
420 | instance Serialize a => BEncode (PeerList a) where | 420 | instance BEncode (PeerList a) where |
421 | toBEncode (PeerList xs) = toBEncode xs | 421 | toBEncode (PeerList xs) = toBEncode xs |
422 | toBEncode (CompactPeerList xs) = toBEncode $ runPut (mapM_ put xs) | 422 | toBEncode (CompactPeerList xs) = toBEncode $ runPut (mapM_ put xs) |
423 | 423 | ||
@@ -491,10 +491,10 @@ instance BEncode AnnounceInfo where | |||
491 | | L.null v6s = (CompactPeerList v4s, Nothing) | 491 | | L.null v6s = (CompactPeerList v4s, Nothing) |
492 | | otherwise = (CompactPeerList v4s, Just (CompactPeerList v6s)) | 492 | | otherwise = (CompactPeerList v4s, Just (CompactPeerList v6s)) |
493 | 493 | ||
494 | toEither :: PeerAddr IP -> Either (PeerAddr IPv4) (PeerAddr IPv6) | 494 | toEither :: PeerAddr -> Either PeerAddr PeerAddr |
495 | toEither PeerAddr {..} = case peerHost of | 495 | toEither PeerAddr {..} = case peerHost of |
496 | IPv4 ipv4 -> Left $ PeerAddr peerId ipv4 peerPort | 496 | ipv4@IPv4{} -> Left $ PeerAddr peerId ipv4 peerPort |
497 | IPv6 ipv6 -> Right $ PeerAddr peerId ipv6 peerPort | 497 | ipv6@IPv6{} -> Right $ PeerAddr peerId ipv6 peerPort |
498 | 498 | ||
499 | fromBEncode (BDict d) | 499 | fromBEncode (BDict d) |
500 | | Just t <- BE.lookup "failure reason" d = Failure <$> fromBEncode t | 500 | | Just t <- BE.lookup "failure reason" d = Failure <$> fromBEncode t |
@@ -514,7 +514,7 @@ instance BEncode AnnounceInfo where | |||
514 | \but the `peers6' field present" | 514 | \but the `peers6' field present" |
515 | 515 | ||
516 | merge (CompactPeerList ipv4s) Nothing | 516 | merge (CompactPeerList ipv4s) Nothing |
517 | = pure $ CompactPeerList (fmap IPv4 <$> ipv4s) | 517 | = pure $ CompactPeerList ipv4s |
518 | 518 | ||
519 | merge (CompactPeerList _ ) (Just (PeerList _)) | 519 | merge (CompactPeerList _ ) (Just (PeerList _)) |
520 | = fail "PeerList: the `peers6' field value \ | 520 | = fail "PeerList: the `peers6' field value \ |
@@ -522,7 +522,7 @@ instance BEncode AnnounceInfo where | |||
522 | 522 | ||
523 | merge (CompactPeerList ipv4s) (Just (CompactPeerList ipv6s)) | 523 | merge (CompactPeerList ipv4s) (Just (CompactPeerList ipv6s)) |
524 | = pure $ CompactPeerList $ | 524 | = pure $ CompactPeerList $ |
525 | (fmap IPv4 <$> ipv4s) <> (fmap IPv6 <$> ipv6s) | 525 | ipv4s <> ipv6s |
526 | 526 | ||
527 | fromBEncode _ = decodingError "Announce info" | 527 | fromBEncode _ = decodingError "Announce info" |
528 | 528 | ||
@@ -533,13 +533,13 @@ instance Serialize AnnounceInfo where | |||
533 | putWord32be $ fromIntegral respInterval | 533 | putWord32be $ fromIntegral respInterval |
534 | putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete | 534 | putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete |
535 | putWord32be $ fromIntegral $ fromMaybe 0 respComplete | 535 | putWord32be $ fromIntegral $ fromMaybe 0 respComplete |
536 | forM_ (fmap ipv4 <$> getPeerList respPeers) put | 536 | forM_ (getPeerList respPeers) put |
537 | 537 | ||
538 | get = do | 538 | get = do |
539 | interval <- getWord32be | 539 | interval <- getWord32be |
540 | leechers <- getWord32be | 540 | leechers <- getWord32be |
541 | seeders <- getWord32be | 541 | seeders <- getWord32be |
542 | peers <- many $ fmap IPv4 <$> get | 542 | peers <- many $ isolate 6 get -- isolated to specify IPv4. |
543 | 543 | ||
544 | return $ AnnounceInfo { | 544 | return $ AnnounceInfo { |
545 | respWarning = Nothing | 545 | respWarning = Nothing |