diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-07-21 00:48:19 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-07-21 00:48:19 +0400 |
commit | 9101056298bbbd891b6134c45b63146c2b2125e2 (patch) | |
tree | 8bace6ba2831f6e1448bae50dba8bf0b0dccf12a /src/Network/BitTorrent/Peer.hs | |
parent | 8fe68502f23cd737cfd198ce63ae8522c8e11a7f (diff) |
+ Add JSON instances for Tracker info.
Diffstat (limited to 'src/Network/BitTorrent/Peer.hs')
-rw-r--r-- | src/Network/BitTorrent/Peer.hs | 41 |
1 files changed, 26 insertions, 15 deletions
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs index 7e4a1b5d..27f9ac10 100644 --- a/src/Network/BitTorrent/Peer.hs +++ b/src/Network/BitTorrent/Peer.hs | |||
@@ -28,10 +28,12 @@ | |||
28 | -- capabilities (such as supported enchancements), this should be | 28 | -- capabilities (such as supported enchancements), this should be |
29 | -- done using 'Network.BitTorrent.Extension'! | 29 | -- done using 'Network.BitTorrent.Extension'! |
30 | -- | 30 | -- |
31 | {-# LANGUAGE OverloadedStrings #-} | 31 | {-# LANGUAGE OverloadedStrings #-} |
32 | {-# LANGUAGE RecordWildCards #-} | ||
32 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | 33 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} |
33 | {-# LANGUAGE RecordWildCards #-} | 34 | {-# LANGUAGE StandaloneDeriving #-} |
34 | {-# OPTIONS -fno-warn-orphans #-} | 35 | {-# LANGUAGE TemplateHaskell #-} |
36 | {-# OPTIONS -fno-warn-orphans #-} | ||
35 | module Network.BitTorrent.Peer | 37 | module Network.BitTorrent.Peer |
36 | ( -- * Peer identificators | 38 | ( -- * Peer identificators |
37 | PeerId (getPeerId), ppPeerId | 39 | PeerId (getPeerId), ppPeerId |
@@ -70,8 +72,12 @@ module Network.BitTorrent.Peer | |||
70 | 72 | ||
71 | 73 | ||
72 | import Control.Applicative | 74 | import Control.Applicative |
75 | import Data.Aeson | ||
76 | import Data.Aeson.TH | ||
73 | import Data.BEncode | 77 | import Data.BEncode |
74 | import Data.Bits | 78 | import Data.Bits |
79 | import Data.Char | ||
80 | import Data.List as L | ||
75 | import Data.Word | 81 | import Data.Word |
76 | import Data.ByteString (ByteString) | 82 | import Data.ByteString (ByteString) |
77 | import qualified Data.ByteString as B | 83 | import qualified Data.ByteString as B |
@@ -106,7 +112,7 @@ version = Version [0, 10, 0, 0] [] | |||
106 | 112 | ||
107 | -- | Peer identifier is exactly 20 bytes long bytestring. | 113 | -- | Peer identifier is exactly 20 bytes long bytestring. |
108 | newtype PeerId = PeerId { getPeerId :: ByteString } | 114 | newtype PeerId = PeerId { getPeerId :: ByteString } |
109 | deriving (Show, Eq, Ord, BEncodable) | 115 | deriving (Show, Eq, Ord, BEncodable, ToJSON, FromJSON) |
110 | 116 | ||
111 | instance Serialize PeerId where | 117 | instance Serialize PeerId where |
112 | put = putByteString . getPeerId | 118 | put = putByteString . getPeerId |
@@ -492,6 +498,21 @@ nameMap = | |||
492 | {----------------------------------------------------------------------- | 498 | {----------------------------------------------------------------------- |
493 | Peer address | 499 | Peer address |
494 | -----------------------------------------------------------------------} | 500 | -----------------------------------------------------------------------} |
501 | deriving instance ToJSON PortNumber | ||
502 | deriving instance FromJSON PortNumber | ||
503 | |||
504 | instance BEncodable PortNumber where | ||
505 | toBEncode = toBEncode . fromEnum | ||
506 | fromBEncode b = toEnum <$> fromBEncode b | ||
507 | |||
508 | instance Serialize PortNumber where | ||
509 | get = fromIntegral <$> getWord16be | ||
510 | {-# INLINE get #-} | ||
511 | put = putWord16be . fromIntegral | ||
512 | {-# INLINE put #-} | ||
513 | |||
514 | -- TODO check semantic of ord and eq instances | ||
515 | |||
495 | 516 | ||
496 | -- | Peer address info normally extracted from peer list or peer | 517 | -- | Peer address info normally extracted from peer list or peer |
497 | -- compact list encoding. | 518 | -- compact list encoding. |
@@ -501,11 +522,7 @@ data PeerAddr = PeerAddr { | |||
501 | , peerPort :: {-# UNPACK #-} !PortNumber | 522 | , peerPort :: {-# UNPACK #-} !PortNumber |
502 | } deriving (Show, Eq, Ord) | 523 | } deriving (Show, Eq, Ord) |
503 | 524 | ||
504 | -- TODO check semantic of ord and eq instances | 525 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''PeerAddr) |
505 | |||
506 | instance BEncodable PortNumber where | ||
507 | toBEncode = toBEncode . fromEnum | ||
508 | fromBEncode b = toEnum <$> fromBEncode b | ||
509 | 526 | ||
510 | instance BEncodable PeerAddr where | 527 | instance BEncodable PeerAddr where |
511 | toBEncode (PeerAddr pid pip pport) = fromAssocs | 528 | toBEncode (PeerAddr pid pip pport) = fromAssocs |
@@ -521,12 +538,6 @@ instance BEncodable PeerAddr where | |||
521 | 538 | ||
522 | fromBEncode _ = decodingError "PeerAddr" | 539 | fromBEncode _ = decodingError "PeerAddr" |
523 | 540 | ||
524 | instance Serialize PortNumber where | ||
525 | get = fromIntegral <$> getWord16be | ||
526 | {-# INLINE get #-} | ||
527 | put = putWord16be . fromIntegral | ||
528 | {-# INLINE put #-} | ||
529 | |||
530 | instance Serialize PeerAddr where | 541 | instance Serialize PeerAddr where |
531 | put PeerAddr {..} = put peerID >> put peerPort | 542 | put PeerAddr {..} = put peerID >> put peerPort |
532 | {-# INLINE put #-} | 543 | {-# INLINE put #-} |