summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Exchange/Protocol.hs16
-rw-r--r--src/Network/BitTorrent/Tracker.hs4
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
67import Control.Exception 67import Control.Exception
68import Control.Monad 68import Control.Monad
69import Control.Lens 69import Control.Lens
70
71import Data.Aeson.TH
70import Data.ByteString (ByteString) 72import Data.ByteString (ByteString)
71import qualified Data.ByteString as B 73import qualified Data.ByteString as B
72import qualified Data.ByteString.Char8 as BC 74import qualified Data.ByteString.Char8 as BC
73import qualified Data.ByteString.Lazy as Lazy 75import qualified Data.ByteString.Lazy as Lazy
76import Data.Char
74import Data.Default 77import Data.Default
75import Data.Int 78import Data.Int
79import Data.List as L
76import Data.Word 80import Data.Word
77 81
78import Data.Binary as B 82import 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
197type BlockLIx = Int 201type 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
212getInt :: S.Get Int 218getInt :: S.Get Int
213getInt = fromIntegral <$> S.getWord32be 219getInt = 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
255data Block = Block { 265data 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
524instance Default PeerStatus where 535instance 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
535instance Default SessionStatus where 547instance 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.
281type Scrape = Map InfoHash ScrapeInfo 283type 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