diff options
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 16 | ||||
-rw-r--r-- | src/Network/BitTorrent/Tracker.hs | 4 |
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 | |||
67 | import Control.Exception | 67 | import Control.Exception |
68 | import Control.Monad | 68 | import Control.Monad |
69 | import Control.Lens | 69 | import Control.Lens |
70 | |||
71 | import Data.Aeson.TH | ||
70 | import Data.ByteString (ByteString) | 72 | import Data.ByteString (ByteString) |
71 | import qualified Data.ByteString as B | 73 | import qualified Data.ByteString as B |
72 | import qualified Data.ByteString.Char8 as BC | 74 | import qualified Data.ByteString.Char8 as BC |
73 | import qualified Data.ByteString.Lazy as Lazy | 75 | import qualified Data.ByteString.Lazy as Lazy |
76 | import Data.Char | ||
74 | import Data.Default | 77 | import Data.Default |
75 | import Data.Int | 78 | import Data.Int |
79 | import Data.List as L | ||
76 | import Data.Word | 80 | import Data.Word |
77 | 81 | ||
78 | import Data.Binary as B | 82 | import Data.Binary as B |
@@ -191,7 +195,7 @@ handshake sock hs = do | |||
191 | checkIH x = x | 195 | checkIH x = x |
192 | 196 | ||
193 | {----------------------------------------------------------------------- | 197 | {----------------------------------------------------------------------- |
194 | Blocks | 198 | Block Index |
195 | -----------------------------------------------------------------------} | 199 | -----------------------------------------------------------------------} |
196 | 200 | ||
197 | type BlockLIx = Int | 201 | type BlockLIx = Int |
@@ -209,6 +213,8 @@ data BlockIx = BlockIx { | |||
209 | , ixLength :: {-# UNPACK #-} !Int | 213 | , ixLength :: {-# UNPACK #-} !Int |
210 | } deriving (Show, Eq) | 214 | } deriving (Show, Eq) |
211 | 215 | ||
216 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''BlockIx) | ||
217 | |||
212 | getInt :: S.Get Int | 218 | getInt :: S.Get Int |
213 | getInt = fromIntegral <$> S.getWord32be | 219 | getInt = fromIntegral <$> S.getWord32be |
214 | {-# INLINE getInt #-} | 220 | {-# INLINE getInt #-} |
@@ -252,6 +258,10 @@ ppBlockIx BlockIx {..} = | |||
252 | "offset = " <> int ixOffset <> "," <+> | 258 | "offset = " <> int ixOffset <> "," <+> |
253 | "length = " <> int ixLength | 259 | "length = " <> int ixLength |
254 | 260 | ||
261 | {----------------------------------------------------------------------- | ||
262 | Block | ||
263 | -----------------------------------------------------------------------} | ||
264 | |||
255 | data Block = Block { | 265 | data Block = Block { |
256 | -- | Zero-based piece index. | 266 | -- | Zero-based piece index. |
257 | blkPiece :: {-# UNPACK #-} !PieceLIx | 267 | blkPiece :: {-# UNPACK #-} !PieceLIx |
@@ -260,7 +270,7 @@ data Block = Block { | |||
260 | , blkOffset :: {-# UNPACK #-} !Int | 270 | , blkOffset :: {-# UNPACK #-} !Int |
261 | 271 | ||
262 | -- | Payload. | 272 | -- | Payload. |
263 | , blkData :: !Lazy.ByteString -- TODO make lazy bytestring | 273 | , blkData :: !Lazy.ByteString |
264 | } deriving (Show, Eq) | 274 | } deriving (Show, Eq) |
265 | 275 | ||
266 | -- | Format block in human readable form. Payload is ommitted. | 276 | -- | Format block in human readable form. Payload is ommitted. |
@@ -520,6 +530,7 @@ data PeerStatus = PeerStatus { | |||
520 | } deriving (Show, Eq) | 530 | } deriving (Show, Eq) |
521 | 531 | ||
522 | $(makeLenses ''PeerStatus) | 532 | $(makeLenses ''PeerStatus) |
533 | $(deriveJSON (L.dropWhile (== '_')) ''PeerStatus) | ||
523 | 534 | ||
524 | instance Default PeerStatus where | 535 | instance Default PeerStatus where |
525 | def = PeerStatus True False | 536 | def = PeerStatus True False |
@@ -531,6 +542,7 @@ data SessionStatus = SessionStatus { | |||
531 | } deriving (Show, Eq) | 542 | } deriving (Show, Eq) |
532 | 543 | ||
533 | $(makeLenses ''SessionStatus) | 544 | $(makeLenses ''SessionStatus) |
545 | $(deriveJSON (L.dropWhile (== '_')) ''SessionStatus) | ||
534 | 546 | ||
535 | instance Default SessionStatus where | 547 | instance Default SessionStatus where |
536 | def = SessionStatus def def | 548 | 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 { | |||
277 | , siName :: !(Maybe Text) | 277 | , siName :: !(Maybe Text) |
278 | } deriving (Show, Eq) | 278 | } deriving (Show, Eq) |
279 | 279 | ||
280 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) | ||
281 | |||
280 | -- | Scrape info about a set of torrents. | 282 | -- | Scrape info about a set of torrents. |
281 | type Scrape = Map InfoHash ScrapeInfo | 283 | type Scrape = Map InfoHash ScrapeInfo |
282 | 284 | ||
@@ -295,8 +297,6 @@ instance BEncodable ScrapeInfo where | |||
295 | <*> d >--? "name" | 297 | <*> d >--? "name" |
296 | fromBEncode _ = decodingError "ScrapeInfo" | 298 | fromBEncode _ = decodingError "ScrapeInfo" |
297 | 299 | ||
298 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''ScrapeInfo) | ||
299 | |||
300 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' | 300 | -- | Trying to convert /announce/ URL to /scrape/ URL. If 'scrapeURL' |
301 | -- gives 'Nothing' then tracker do not support scraping. The info hash | 301 | -- gives 'Nothing' then tracker do not support scraping. The info hash |
302 | -- list is used to restrict the tracker's report to that particular | 302 | -- list is used to restrict the tracker's report to that particular |