diff options
-rw-r--r-- | bittorrent.cabal | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent.hs | 2 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 19 |
3 files changed, 23 insertions, 0 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index e4f84523..211eee06 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -85,6 +85,7 @@ library | |||
85 | , vector | 85 | , vector |
86 | 86 | ||
87 | -- Encoding/Serialization | 87 | -- Encoding/Serialization |
88 | , aeson | ||
88 | , bencoding >= 0.1.0.1 | 89 | , bencoding >= 0.1.0.1 |
89 | , cereal >= 0.3 | 90 | , cereal >= 0.3 |
90 | , binary >= 0.5 | 91 | , binary >= 0.5 |
@@ -128,6 +129,7 @@ test-suite properties | |||
128 | , directory | 129 | , directory |
129 | , filepath | 130 | , filepath |
130 | 131 | ||
132 | , aeson | ||
131 | , cereal | 133 | , cereal |
132 | , network | 134 | , network |
133 | , text | 135 | , text |
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs index 95a4c4e3..4f6eaf16 100644 --- a/src/Network/BitTorrent.hs +++ b/src/Network/BitTorrent.hs | |||
@@ -151,6 +151,8 @@ exchange storage = {-# SCC exchange #-} (awaitEvent >>= handler) | |||
151 | when done $ do | 151 | when done $ do |
152 | yieldEvent $ Available $ singleton blkPiece (succ blkPiece) | 152 | yieldEvent $ Available $ singleton blkPiece (succ blkPiece) |
153 | 153 | ||
154 | -- WARN this is not reliable: if peer do not return all piece | ||
155 | -- block we could slow don't until some other event occured | ||
154 | offer <- peerOffer | 156 | offer <- peerOffer |
155 | if BF.null offer | 157 | if BF.null offer |
156 | then return () | 158 | then return () |
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs index bfe4182d..01e61025 100644 --- a/src/Network/BitTorrent/Tracker.hs +++ b/src/Network/BitTorrent/Tracker.hs | |||
@@ -42,6 +42,8 @@ import Control.Concurrent.BoundedChan as BC | |||
42 | import Control.Concurrent.STM | 42 | import Control.Concurrent.STM |
43 | import Control.Exception | 43 | import Control.Exception |
44 | import Control.Monad | 44 | import Control.Monad |
45 | |||
46 | import Data.Aeson hiding (Result) | ||
45 | import Data.BEncode | 47 | import Data.BEncode |
46 | import Data.ByteString (ByteString) | 48 | import Data.ByteString (ByteString) |
47 | import qualified Data.ByteString as B | 49 | import qualified Data.ByteString as B |
@@ -287,6 +289,23 @@ instance BEncodable ScrapeInfo where | |||
287 | <*> d >--? "name" | 289 | <*> d >--? "name" |
288 | fromBEncode _ = decodingError "ScrapeInfo" | 290 | fromBEncode _ = decodingError "ScrapeInfo" |
289 | 291 | ||
292 | instance ToJSON ScrapeInfo where | ||
293 | toJSON ScrapeInfo {..} = object | ||
294 | [ "complete" .= siComplete | ||
295 | , "downloaded" .= siDownloaded | ||
296 | , "incomplete" .= siIncomplete | ||
297 | , "name" .= siName | ||
298 | ] | ||
299 | |||
300 | instance FromJSON ScrapeInfo where | ||
301 | parseJSON (Object obj) = do | ||
302 | ScrapeInfo <$> obj .: "complete" | ||
303 | <*> obj .: "downloaded" | ||
304 | <*> obj .: "incomplete" | ||
305 | <*> obj .:? "name" | ||
306 | |||
307 | parseJSON _ = fail "ScrapeInfo" | ||
308 | |||
290 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' | 309 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' |
291 | -- gives 'Nothing' then tracker do not support scraping. The info hash | 310 | -- gives 'Nothing' then tracker do not support scraping. The info hash |
292 | -- list is used to restrict the tracker's report to that particular | 311 | -- list is used to restrict the tracker's report to that particular |