+ Add message and block pprint for logging.

2 files changed, 18 insertions, 0 deletions

diff --git a/src/Network/BitTorrent/PeerWire/Block.hs b/src/Network/BitTorrent/PeerWire/Block.hs
index ddbc1020..9685a4fb 100644
--- a/src/Network/BitTorrent/PeerWire/Block.hs
+++ b/src/Network/BitTorrent/PeerWire/Block.hs
@@ -4,6 +4,7 @@ module Network.BitTorrent.PeerWire.Block
        , defaultBlockSize
        , pieceIx, blockIx
        , blockRange, ixRange, isPiece
+       , ppBlockIx, ppBlock
 
        , putInt, getInt
        ) where
@@ -48,6 +49,10 @@ instance Serialize BlockIx where
               putInt (ixLength ix)
   {-# INLINE put #-}
 
+ppBlockIx :: BlockIx -> String
+ppBlockIx ix = "piece = "  ++ show (ixPiece ix)  ++ ", "
+            ++ "offset = " ++ show (ixOffset ix) ++ ", "
+            ++ "length = " ++ show (ixLength ix)
 
 data Block = Block {
     -- ^ Zero-based piece index.
@@ -60,6 +65,8 @@ data Block = Block {
   , blkData   :: ByteString
   } deriving (Show, Eq)
 
+ppBlock :: Block -> String
+ppBlock = ppBlockIx . blockIx
 
 -- | Widely used semi-official block size.
 defaultBlockSize :: Int
diff --git a/src/Network/BitTorrent/PeerWire/Message.hs b/src/Network/BitTorrent/PeerWire/Message.hs
index 650e0082..c98c9808 100644
--- a/src/Network/BitTorrent/PeerWire/Message.hs
+++ b/src/Network/BitTorrent/PeerWire/Message.hs
@@ -1,5 +1,6 @@
 module Network.BitTorrent.PeerWire.Message
        ( Message(..)
+       , ppMessage
        ) where
 
 import Control.Applicative
@@ -129,3 +130,13 @@ instance Serialize Message where
   put (SuggestPiece pix) = putInt 5  >> putWord8 0x0D >> putInt pix
   put (RejectRequest ix) = putInt 13 >> putWord8 0x10 >> put ix
   put (AllowedFast   ix) = putInt 5  >> putWord8 0x11 >> putInt ix
+
+
+-- | Compact output for logging: only useful information but not payload bytes.
+ppMessage :: Message -> String
+ppMessage (Bitfield _)       = "Bitfield "
+ppMessage (Piece blk)        = "Piece "    ++ ppBlock blk
+ppMessage (Cancel ix)        = "Cancel "   ++ ppBlockIx ix
+ppMessage (SuggestPiece pix) = "Suggest"   ++ show pix
+ppMessage (RejectRequest ix) = "Reject"    ++ ppBlockIx ix
+ppMessage msg = show msg
\ No newline at end of file