summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal2
-rw-r--r--src/Network/BitTorrent.hs2
-rw-r--r--src/Network/BitTorrent/Tracker.hs19
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
42import Control.Concurrent.STM 42import Control.Concurrent.STM
43import Control.Exception 43import Control.Exception
44import Control.Monad 44import Control.Monad
45
46import Data.Aeson hiding (Result)
45import Data.BEncode 47import Data.BEncode
46import Data.ByteString (ByteString) 48import Data.ByteString (ByteString)
47import qualified Data.ByteString as B 49import 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
292instance ToJSON ScrapeInfo where
293 toJSON ScrapeInfo {..} = object
294 [ "complete" .= siComplete
295 , "downloaded" .= siDownloaded
296 , "incomplete" .= siIncomplete
297 , "name" .= siName
298 ]
299
300instance 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