+ Add JSON instance for ScrapeInfo.

2 files changed, 21 insertions, 0 deletions

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)
       when done $ do
         yieldEvent $ Available $ singleton blkPiece (succ blkPiece)
 
+        -- WARN this is not reliable: if peer do not return all piece
+        -- block we could slow don't until some other event occured
         offer <- peerOffer
         if BF.null offer
           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
 import Control.Concurrent.STM
 import Control.Exception
 import Control.Monad
+
+import Data.Aeson hiding (Result)
 import Data.BEncode
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
@@ -287,6 +289,23 @@ instance BEncodable ScrapeInfo where
                <*> d >--? "name"
   fromBEncode _ = decodingError "ScrapeInfo"
 
+instance ToJSON ScrapeInfo where
+  toJSON ScrapeInfo {..} = object
+    [ "complete"   .= siComplete
+    , "downloaded" .= siDownloaded
+    , "incomplete" .= siIncomplete
+    , "name"       .= siName
+    ]
+
+instance FromJSON ScrapeInfo where
+  parseJSON (Object obj) = do
+    ScrapeInfo <$> obj .:  "complete"
+               <*> obj .:  "downloaded"
+               <*> obj .:  "incomplete"
+               <*> obj .:? "name"
+
+  parseJSON _ = fail "ScrapeInfo"
+
 -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL'
 --   gives 'Nothing' then tracker do not support scraping. The info hash
 --   list is used to restrict the tracker's report to that particular