summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Exchange/Message.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Exchange/Message.hs')
-rw-r--r--src/Network/BitTorrent/Exchange/Message.hs92
1 files changed, 46 insertions, 46 deletions
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index f8b76186..74232b47 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -115,7 +115,7 @@ import Data.IP
115import Network 115import Network
116import Network.Socket hiding (KeepAlive) 116import Network.Socket hiding (KeepAlive)
117import Text.PrettyPrint as PP hiding ((<>)) 117import Text.PrettyPrint as PP hiding ((<>))
118import Text.PrettyPrint.Class 118import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
119 119
120import Data.Torrent hiding (Piece (..)) 120import Data.Torrent hiding (Piece (..))
121import qualified Data.Torrent as P (Piece (..)) 121import qualified Data.Torrent as P (Piece (..))
@@ -141,7 +141,7 @@ class Capabilities caps where
141 allowed :: Ext caps -> caps -> Bool 141 allowed :: Ext caps -> caps -> Bool
142 142
143ppCaps :: Capabilities caps => Pretty (Ext caps) => caps -> Doc 143ppCaps :: Capabilities caps => Pretty (Ext caps) => caps -> Doc
144ppCaps = hcat . punctuate ", " . L.map pretty . fromCaps 144ppCaps = hcat . punctuate ", " . L.map pPrint . fromCaps
145 145
146{----------------------------------------------------------------------- 146{-----------------------------------------------------------------------
147-- Extensions 147-- Extensions
@@ -159,9 +159,9 @@ data Extension
159 159
160-- | Full extension names, suitable for logging. 160-- | Full extension names, suitable for logging.
161instance Pretty Extension where 161instance Pretty Extension where
162 pretty ExtDHT = "Distributed Hash Table Protocol" 162 pPrint ExtDHT = "Distributed Hash Table Protocol"
163 pretty ExtFast = "Fast Extension" 163 pPrint ExtFast = "Fast Extension"
164 pretty ExtExtended = "Extension Protocol" 164 pPrint ExtExtended = "Extension Protocol"
165 165
166-- | Extension bitmask as specified by BEP 4. 166-- | Extension bitmask as specified by BEP 4.
167extMask :: Extension -> Word64 167extMask :: Extension -> Word64
@@ -180,8 +180,8 @@ newtype Caps = Caps Word64
180 180
181-- | Render set of extensions as comma separated list. 181-- | Render set of extensions as comma separated list.
182instance Pretty Caps where 182instance Pretty Caps where
183 pretty = ppCaps 183 pPrint = ppCaps
184 {-# INLINE pretty #-} 184 {-# INLINE pPrint #-}
185 185
186-- | The empty set. 186-- | The empty set.
187instance Default Caps where 187instance Default Caps where
@@ -235,7 +235,7 @@ instance Show ProtocolName where
235 show (ProtocolName bs) = show bs 235 show (ProtocolName bs) = show bs
236 236
237instance Pretty ProtocolName where 237instance Pretty ProtocolName where
238 pretty (ProtocolName bs) = PP.text $ BC.unpack bs 238 pPrint (ProtocolName bs) = PP.text $ BC.unpack bs
239 239
240instance IsString ProtocolName where 240instance IsString ProtocolName where
241 fromString str 241 fromString str
@@ -287,10 +287,10 @@ instance Serialize Handshake where
287 287
288-- | Show handshake protocol string, caps and fingerprint. 288-- | Show handshake protocol string, caps and fingerprint.
289instance Pretty Handshake where 289instance Pretty Handshake where
290 pretty Handshake {..} 290 pPrint Handshake {..}
291 = pretty hsProtocol $$ 291 = pPrint hsProtocol $$
292 pretty hsReserved $$ 292 pPrint hsReserved $$
293 pretty (fingerprint hsPeerId) 293 pPrint (fingerprint hsPeerId)
294 294
295-- | Get handshake message size in bytes from the length of protocol 295-- | Get handshake message size in bytes from the length of protocol
296-- string. 296-- string.
@@ -334,7 +334,7 @@ data ByteStats = ByteStats
334 } deriving Show 334 } deriving Show
335 335
336instance Pretty ByteStats where 336instance Pretty ByteStats where
337 pretty s @ ByteStats {..} = fsep 337 pPrint s @ ByteStats {..} = fsep
338 [ PP.int overhead, "overhead" 338 [ PP.int overhead, "overhead"
339 , PP.int control, "control" 339 , PP.int control, "control"
340 , PP.int payload, "payload" 340 , PP.int payload, "payload"
@@ -408,10 +408,10 @@ data StatusUpdate
408 deriving (Show, Eq, Ord, Typeable) 408 deriving (Show, Eq, Ord, Typeable)
409 409
410instance Pretty StatusUpdate where 410instance Pretty StatusUpdate where
411 pretty (Choking False) = "not choking" 411 pPrint (Choking False) = "not choking"
412 pretty (Choking True ) = "choking" 412 pPrint (Choking True ) = "choking"
413 pretty (Interested False) = "not interested" 413 pPrint (Interested False) = "not interested"
414 pretty (Interested True ) = "interested" 414 pPrint (Interested True ) = "interested"
415 415
416instance PeerMessage StatusUpdate where 416instance PeerMessage StatusUpdate where
417 envelop _ = Status 417 envelop _ = Status
@@ -439,8 +439,8 @@ data Available =
439 deriving (Show, Eq) 439 deriving (Show, Eq)
440 440
441instance Pretty Available where 441instance Pretty Available where
442 pretty (Have ix ) = "Have" <+> int ix 442 pPrint (Have ix ) = "Have" <+> int ix
443 pretty (Bitfield _ ) = "Bitfield" 443 pPrint (Bitfield _ ) = "Bitfield"
444 444
445instance PeerMessage Available where 445instance PeerMessage Available where
446 envelop _ = Available 446 envelop _ = Available
@@ -472,9 +472,9 @@ data Transfer
472 deriving (Show, Eq) 472 deriving (Show, Eq)
473 473
474instance Pretty Transfer where 474instance Pretty Transfer where
475 pretty (Request ix ) = "Request" <+> pretty ix 475 pPrint (Request ix ) = "Request" <+> pPrint ix
476 pretty (Piece blk) = "Piece" <+> pretty blk 476 pPrint (Piece blk) = "Piece" <+> pPrint blk
477 pretty (Cancel i ) = "Cancel" <+> pretty i 477 pPrint (Cancel i ) = "Cancel" <+> pPrint i
478 478
479instance PeerMessage Transfer where 479instance PeerMessage Transfer where
480 envelop _ = Transfer 480 envelop _ = Transfer
@@ -519,11 +519,11 @@ data FastMessage =
519 deriving (Show, Eq) 519 deriving (Show, Eq)
520 520
521instance Pretty FastMessage where 521instance Pretty FastMessage where
522 pretty (HaveAll ) = "Have all" 522 pPrint (HaveAll ) = "Have all"
523 pretty (HaveNone ) = "Have none" 523 pPrint (HaveNone ) = "Have none"
524 pretty (SuggestPiece pix) = "Suggest" <+> int pix 524 pPrint (SuggestPiece pix) = "Suggest" <+> int pix
525 pretty (RejectRequest bix) = "Reject" <+> pretty bix 525 pPrint (RejectRequest bix) = "Reject" <+> pPrint bix
526 pretty (AllowedFast pix) = "Allowed fast" <+> int pix 526 pPrint (AllowedFast pix) = "Allowed fast" <+> int pix
527 527
528instance PeerMessage FastMessage where 528instance PeerMessage FastMessage where
529 envelop _ = Fast 529 envelop _ = Fast
@@ -556,7 +556,7 @@ instance IsString ExtendedExtension where
556 msg = "fromString: could not parse ExtendedExtension" 556 msg = "fromString: could not parse ExtendedExtension"
557 557
558instance Pretty ExtendedExtension where 558instance Pretty ExtendedExtension where
559 pretty ExtMetadata = "Extension for Peers to Send Metadata Files" 559 pPrint ExtMetadata = "Extension for Peers to Send Metadata Files"
560 560
561fromKey :: BKey -> Maybe ExtendedExtension 561fromKey :: BKey -> Maybe ExtendedExtension
562fromKey "ut_metadata" = Just ExtMetadata 562fromKey "ut_metadata" = Just ExtMetadata
@@ -582,8 +582,8 @@ newtype ExtendedCaps = ExtendedCaps { extendedCaps :: ExtendedMap }
582 deriving (Show, Eq) 582 deriving (Show, Eq)
583 583
584instance Pretty ExtendedCaps where 584instance Pretty ExtendedCaps where
585 pretty = ppCaps 585 pPrint = ppCaps
586 {-# INLINE pretty #-} 586 {-# INLINE pPrint #-}
587 587
588-- | The empty set. 588-- | The empty set.
589instance Default ExtendedCaps where 589instance Default ExtendedCaps where
@@ -738,7 +738,7 @@ getYourIp f =
738 _ -> fail "" 738 _ -> fail ""
739 739
740instance Pretty ExtendedHandshake where 740instance Pretty ExtendedHandshake where
741 pretty = PP.text . show 741 pPrint = PP.text . show
742 742
743-- | NOTE: Approximated 'stats'. 743-- | NOTE: Approximated 'stats'.
744instance PeerMessage ExtendedHandshake where 744instance PeerMessage ExtendedHandshake where
@@ -760,7 +760,7 @@ nullExtendedHandshake caps = ExtendedHandshake
760 , ehsMetadataSize = Nothing 760 , ehsMetadataSize = Nothing
761 , ehsPort = Nothing 761 , ehsPort = Nothing
762 , ehsQueueLength = Just defaultQueueLength 762 , ehsQueueLength = Just defaultQueueLength
763 , ehsVersion = Just $ T.pack $ render $ pretty libFingerprint 763 , ehsVersion = Just $ T.pack $ render $ pPrint libFingerprint
764 , ehsYourIp = Nothing 764 , ehsYourIp = Nothing
765 } 765 }
766 766
@@ -843,10 +843,10 @@ instance BEncode ExtendedMetadata where
843 843
844-- | Piece data bytes are omitted. 844-- | Piece data bytes are omitted.
845instance Pretty ExtendedMetadata where 845instance Pretty ExtendedMetadata where
846 pretty (MetadataRequest pix ) = "Request" <+> PP.int pix 846 pPrint (MetadataRequest pix ) = "Request" <+> PP.int pix
847 pretty (MetadataData p t) = "Data" <+> pretty p <+> PP.int t 847 pPrint (MetadataData p t) = "Data" <+> pPrint p <+> PP.int t
848 pretty (MetadataReject pix ) = "Reject" <+> PP.int pix 848 pPrint (MetadataReject pix ) = "Reject" <+> PP.int pix
849 pretty (MetadataUnknown bval ) = "Unknown" <+> ppBEncode bval 849 pPrint (MetadataUnknown bval ) = "Unknown" <+> ppBEncode bval
850 850
851-- | NOTE: Approximated 'stats'. 851-- | NOTE: Approximated 'stats'.
852instance PeerMessage ExtendedMetadata where 852instance PeerMessage ExtendedMetadata where
@@ -957,9 +957,9 @@ data ExtendedMessage
957 deriving (Show, Eq, Typeable) 957 deriving (Show, Eq, Typeable)
958 958
959instance Pretty ExtendedMessage where 959instance Pretty ExtendedMessage where
960 pretty (EHandshake ehs) = pretty ehs 960 pPrint (EHandshake ehs) = pPrint ehs
961 pretty (EMetadata _ msg) = "Metadata" <+> pretty msg 961 pPrint (EMetadata _ msg) = "Metadata" <+> pPrint msg
962 pretty (EUnknown mid _ ) = "Unknown" <+> PP.text (show mid) 962 pPrint (EUnknown mid _ ) = "Unknown" <+> PP.text (show mid)
963 963
964instance PeerMessage ExtendedMessage where 964instance PeerMessage ExtendedMessage where
965 envelop _ = Extended 965 envelop _ = Extended
@@ -1010,13 +1010,13 @@ instance Default Message where
1010 1010
1011-- | Payload bytes are omitted. 1011-- | Payload bytes are omitted.
1012instance Pretty Message where 1012instance Pretty Message where
1013 pretty (KeepAlive ) = "Keep alive" 1013 pPrint (KeepAlive ) = "Keep alive"
1014 pretty (Status m) = "Status" <+> pretty m 1014 pPrint (Status m) = "Status" <+> pPrint m
1015 pretty (Available m) = pretty m 1015 pPrint (Available m) = pPrint m
1016 pretty (Transfer m) = pretty m 1016 pPrint (Transfer m) = pPrint m
1017 pretty (Port p) = "Port" <+> int (fromEnum p) 1017 pPrint (Port p) = "Port" <+> int (fromEnum p)
1018 pretty (Fast m) = pretty m 1018 pPrint (Fast m) = pPrint m
1019 pretty (Extended m) = pretty m 1019 pPrint (Extended m) = pPrint m
1020 1020
1021instance PeerMessage Message where 1021instance PeerMessage Message where
1022 envelop _ = id 1022 envelop _ = id