diff options
Diffstat (limited to 'src/Network/BitTorrent/Exchange')
-rw-r--r-- | src/Network/BitTorrent/Exchange/Protocol.hs | 16 |
1 files changed, 14 insertions, 2 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 |