summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Peer.hs
diff options
context:
space:
mode:
authorSam T <pxqr.sta@gmail.com>2013-07-21 00:48:19 +0400
committerSam T <pxqr.sta@gmail.com>2013-07-21 00:48:19 +0400
commit9101056298bbbd891b6134c45b63146c2b2125e2 (patch)
tree8bace6ba2831f6e1448bae50dba8bf0b0dccf12a /src/Network/BitTorrent/Peer.hs
parent8fe68502f23cd737cfd198ce63ae8522c8e11a7f (diff)
+ Add JSON instances for Tracker info.
Diffstat (limited to 'src/Network/BitTorrent/Peer.hs')
-rw-r--r--src/Network/BitTorrent/Peer.hs41
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 #-}
35module Network.BitTorrent.Peer 37module 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
72import Control.Applicative 74import Control.Applicative
75import Data.Aeson
76import Data.Aeson.TH
73import Data.BEncode 77import Data.BEncode
74import Data.Bits 78import Data.Bits
79import Data.Char
80import Data.List as L
75import Data.Word 81import Data.Word
76import Data.ByteString (ByteString) 82import Data.ByteString (ByteString)
77import qualified Data.ByteString as B 83import 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.
108newtype PeerId = PeerId { getPeerId :: ByteString } 114newtype PeerId = PeerId { getPeerId :: ByteString }
109 deriving (Show, Eq, Ord, BEncodable) 115 deriving (Show, Eq, Ord, BEncodable, ToJSON, FromJSON)
110 116
111instance Serialize PeerId where 117instance 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-----------------------------------------------------------------------}
501deriving instance ToJSON PortNumber
502deriving instance FromJSON PortNumber
503
504instance BEncodable PortNumber where
505 toBEncode = toBEncode . fromEnum
506 fromBEncode b = toEnum <$> fromBEncode b
507
508instance 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
506instance BEncodable PortNumber where
507 toBEncode = toBEncode . fromEnum
508 fromBEncode b = toEnum <$> fromBEncode b
509 526
510instance BEncodable PeerAddr where 527instance 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
524instance Serialize PortNumber where
525 get = fromIntegral <$> getWord16be
526 {-# INLINE get #-}
527 put = putWord16be . fromIntegral
528 {-# INLINE put #-}
529
530instance Serialize PeerAddr where 541instance Serialize PeerAddr where
531 put PeerAddr {..} = put peerID >> put peerPort 542 put PeerAddr {..} = put peerID >> put peerPort
532 {-# INLINE put #-} 543 {-# INLINE put #-}