~ Add more JSON instances.

2 files changed, 16 insertions, 4 deletions

diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index 073dad58..aa0f4eaa 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -67,12 +67,16 @@ import Control.Applicative
 import Control.Exception
 import Control.Monad
 import Control.Lens
+
+import Data.Aeson.TH
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as Lazy
+import Data.Char
 import Data.Default
 import Data.Int
+import Data.List as L
 import Data.Word
 
 import Data.Binary as B
@@ -191,7 +195,7 @@ handshake sock hs = do
     checkIH x = x
 
 {-----------------------------------------------------------------------
-    Blocks
+    Block Index
 -----------------------------------------------------------------------}
 
 type BlockLIx = Int
@@ -209,6 +213,8 @@ data BlockIx = BlockIx {
   , ixLength :: {-# UNPACK #-} !Int
   } deriving (Show, Eq)
 
+$(deriveJSON (L.map toLower . L.dropWhile isLower) ''BlockIx)
+
 getInt :: S.Get Int
 getInt = fromIntegral <$> S.getWord32be
 {-# INLINE getInt #-}
@@ -252,6 +258,10 @@ ppBlockIx BlockIx {..} =
   "offset = " <> int ixOffset <> "," <+>
   "length = " <> int ixLength
 
+{-----------------------------------------------------------------------
+    Block
+-----------------------------------------------------------------------}
+
 data Block = Block {
     -- | Zero-based piece index.
     blkPiece  :: {-# UNPACK #-} !PieceLIx
@@ -260,7 +270,7 @@ data Block = Block {
   , blkOffset :: {-# UNPACK #-} !Int
 
     -- | Payload.
-  , blkData   :: !Lazy.ByteString -- TODO make lazy bytestring
+  , blkData   :: !Lazy.ByteString
   } deriving (Show, Eq)
 
 -- | Format block in human readable form. Payload is ommitted.
@@ -520,6 +530,7 @@ data PeerStatus = PeerStatus {
   } deriving (Show, Eq)
 
 $(makeLenses ''PeerStatus)
+$(deriveJSON (L.dropWhile (== '_')) ''PeerStatus)
 
 instance Default PeerStatus where
   def = PeerStatus True False
@@ -531,6 +542,7 @@ data SessionStatus = SessionStatus {
   } deriving (Show, Eq)
 
 $(makeLenses ''SessionStatus)
+$(deriveJSON (L.dropWhile (== '_')) ''SessionStatus)
 
 instance Default SessionStatus where
   def = SessionStatus def def
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index f7d88bd9..2b8fab07 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -277,6 +277,8 @@ data ScrapeInfo = ScrapeInfo {
   , siName       :: !(Maybe Text)
   } deriving (Show, Eq)
 
+$(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo)
+
 -- | Scrape info about a set of torrents.
 type Scrape = Map InfoHash ScrapeInfo
 
@@ -295,8 +297,6 @@ instance BEncodable ScrapeInfo where
                <*> d >--? "name"
   fromBEncode _ = decodingError "ScrapeInfo"
 
-$(deriveJSON (L.map toLower . L.dropWhile isLower) ''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