diff options
author | joe <joe@jerkface.net> | 2018-06-08 22:10:26 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2018-06-08 22:10:42 -0400 |
commit | 71f8dde4f3b7d7cd2274c3bcf235287457969095 (patch) | |
tree | 05a621a4c7066ed78790e428e1c368d4ca6afc4a /bittorrent/src/Network/BitTorrent | |
parent | e6e9799e4bed42daac27739d2cf2ae77414fb3b5 (diff) |
Bittorrent: Fix build of tracker-related modules.
Diffstat (limited to 'bittorrent/src/Network/BitTorrent')
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker/Message.hs | 22 | ||||
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs | 2 | ||||
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Tracker/Session.hs | 6 |
3 files changed, 15 insertions, 15 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 |
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs index 9b6e056a..44b123a3 100644 --- a/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs +++ b/bittorrent/src/Network/BitTorrent/Tracker/RPC/HTTP.hs | |||
@@ -129,7 +129,7 @@ fillRequest Options {..} q r = r | |||
129 | 129 | ||
130 | httpTracker :: BEncode a => Manager -> URI -> SimpleQuery -> IO a | 130 | httpTracker :: BEncode a => Manager -> URI -> SimpleQuery -> IO a |
131 | httpTracker Manager {..} uri q = packHttpException $ do | 131 | httpTracker Manager {..} uri q = packHttpException $ do |
132 | request <- fillRequest options q <$> setUri def {- http-client instance for Request -} uri | 132 | request <- fillRequest options q <$> setUri defaultRequest {- http-client instance for Request -} uri |
133 | response <- runResourceT $ httpLbs request httpMgr | 133 | response <- runResourceT $ httpLbs request httpMgr |
134 | case BE.decode $ BL.toStrict $ responseBody response of | 134 | case BE.decode $ BL.toStrict $ responseBody response of |
135 | Left msg -> throwIO (ParserFailure msg) | 135 | Left msg -> throwIO (ParserFailure msg) |
diff --git a/bittorrent/src/Network/BitTorrent/Tracker/Session.hs b/bittorrent/src/Network/BitTorrent/Tracker/Session.hs index aa4a832f..db6ebaff 100644 --- a/bittorrent/src/Network/BitTorrent/Tracker/Session.hs +++ b/bittorrent/src/Network/BitTorrent/Tracker/Session.hs | |||
@@ -98,7 +98,7 @@ data TrackerSession = TrackerSession | |||
98 | statusSent :: !(Maybe Status) | 98 | statusSent :: !(Maybe Status) |
99 | 99 | ||
100 | -- | Can be used to retrieve peer set. | 100 | -- | Can be used to retrieve peer set. |
101 | , trackerPeers :: Cached [PeerAddr IP] | 101 | , trackerPeers :: Cached [PeerAddr] |
102 | 102 | ||
103 | -- | Can be used to show brief swarm stats in client GUI. | 103 | -- | Can be used to show brief swarm stats in client GUI. |
104 | , trackerScrape :: Cached LastScrape | 104 | , trackerScrape :: Cached LastScrape |
@@ -129,7 +129,7 @@ nextStatus Completed = Nothing -- must keep previous status | |||
129 | seconds :: Int -> NominalDiffTime | 129 | seconds :: Int -> NominalDiffTime |
130 | seconds n = realToFrac (toEnum n :: Uni) | 130 | seconds n = realToFrac (toEnum n :: Uni) |
131 | 131 | ||
132 | cachePeers :: AnnounceInfo -> IO (Cached [PeerAddr IP]) | 132 | cachePeers :: AnnounceInfo -> IO (Cached [PeerAddr]) |
133 | cachePeers AnnounceInfo {..} = | 133 | cachePeers AnnounceInfo {..} = |
134 | newCached (seconds respInterval) | 134 | newCached (seconds respInterval) |
135 | (seconds (fromMaybe respInterval respMinInterval)) | 135 | (seconds (fromMaybe respInterval respMinInterval)) |
@@ -264,7 +264,7 @@ notify mgr ses event = do | |||
264 | -- TODO run announce if sesion have no peers | 264 | -- TODO run announce if sesion have no peers |
265 | -- | The returned list of peers can have duplicates. | 265 | -- | The returned list of peers can have duplicates. |
266 | -- This function /may/ block. Use async if needed. | 266 | -- This function /may/ block. Use async if needed. |
267 | askPeers :: Manager -> Session -> IO [PeerAddr IP] | 267 | askPeers :: Manager -> Session -> IO [PeerAddr] |
268 | askPeers _mgr ses = do | 268 | askPeers _mgr ses = do |
269 | list <- readMVar (sessionTrackers ses) | 269 | list <- readMVar (sessionTrackers ses) |
270 | L.concat <$> collect (tryTakeData . trackerPeers) list | 270 | L.concat <$> collect (tryTakeData . trackerPeers) list |