summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Extension.hs9
-rw-r--r--src/Network/BitTorrent/Peer/Addr.hs11
-rw-r--r--src/Network/BitTorrent/Peer/ClientInfo.hs17
-rw-r--r--src/Network/BitTorrent/Peer/ID.hs5
-rw-r--r--src/Network/BitTorrent/PeerWire/Block.hs14
-rw-r--r--src/Network/BitTorrent/PeerWire/Handshake.hs9
-rw-r--r--src/Network/BitTorrent/PeerWire/Message.hs16
7 files changed, 50 insertions, 31 deletions
diff --git a/src/Network/BitTorrent/Extension.hs b/src/Network/BitTorrent/Extension.hs
index e37f3afb..4b71f91f 100644
--- a/src/Network/BitTorrent/Extension.hs
+++ b/src/Network/BitTorrent/Extension.hs
@@ -9,20 +9,21 @@
9-- 9--
10-- > See http://www.bittorrent.org/beps/bep_0004.html 10-- > See http://www.bittorrent.org/beps/bep_0004.html
11-- 11--
12{-# LANGUAGE OverloadedStrings #-}
12module Network.BitTorrent.Extension 13module Network.BitTorrent.Extension
13 ( Capabilities, ppCaps, defaultCaps, enabledCaps 14 ( Capabilities, ppCaps, defaultCaps, enabledCaps
14 , Extension, ppExtension, encodeExts, decodeExts 15 , Extension, ppExtension, encodeExts, decodeExts
15 ) where 16 ) where
16 17
17import Data.Bits 18import Data.Bits
18import Data.List
19import Data.Word 19import Data.Word
20import Text.PrettyPrint
20 21
21 22
22type Capabilities = Word64 23type Capabilities = Word64
23 24
24ppCaps :: Capabilities -> String 25ppCaps :: Capabilities -> Doc
25ppCaps = intercalate ", " . map ppExtension . decodeExts 26ppCaps = hcat . punctuate ", " . map ppExtension . decodeExts
26 27
27defaultCaps :: Capabilities 28defaultCaps :: Capabilities
28defaultCaps = 0 29defaultCaps = 0
@@ -38,7 +39,7 @@ data Extension = ExtDHT -- ^ BEP 5
38 | ExtFast -- ^ BEP 6 39 | ExtFast -- ^ BEP 6
39 deriving (Show, Eq, Ord, Enum, Bounded) 40 deriving (Show, Eq, Ord, Enum, Bounded)
40 41
41ppExtension :: Extension -> String 42ppExtension :: Extension -> Doc
42ppExtension ExtDHT = "DHT" 43ppExtension ExtDHT = "DHT"
43ppExtension ExtFast = "Fast Extension" 44ppExtension ExtFast = "Fast Extension"
44 45
diff --git a/src/Network/BitTorrent/Peer/Addr.hs b/src/Network/BitTorrent/Peer/Addr.hs
index 1c2ac2eb..5c05180a 100644
--- a/src/Network/BitTorrent/Peer/Addr.hs
+++ b/src/Network/BitTorrent/Peer/Addr.hs
@@ -6,6 +6,7 @@
6-- Portability : non-portable 6-- Portability : non-portable
7-- 7--
8{-# LANGUAGE OverloadedStrings #-} 8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE RecordWildCards #-}
9{-# OPTIONS -fno-warn-orphans #-} 10{-# OPTIONS -fno-warn-orphans #-}
10module Network.BitTorrent.Peer.Addr 11module Network.BitTorrent.Peer.Addr
11 ( PeerAddr(..) 12 ( PeerAddr(..)
@@ -17,6 +18,7 @@ import Control.Applicative
17import Data.BEncode 18import Data.BEncode
18import Data.Bits 19import Data.Bits
19import Data.Word 20import Data.Word
21import Text.PrettyPrint
20import Network 22import Network
21import Network.Socket 23import Network.Socket
22 24
@@ -73,6 +75,9 @@ connectToPeer p = do
73 connect sock (peerSockAddr p) 75 connect sock (peerSockAddr p)
74 return sock 76 return sock
75 77
76ppPeer :: PeerAddr -> String 78ppPeer :: PeerAddr -> Doc
77ppPeer p = maybe "" (++ " at ") ((ppClientInfo . clientInfo) <$> peerID p) 79ppPeer p @ PeerAddr {..} = case peerID of
78 ++ show (peerSockAddr p) 80 Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr
81 Nothing -> paddr
82 where
83 paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Peer/ClientInfo.hs b/src/Network/BitTorrent/Peer/ClientInfo.hs
index ebbecbd7..bf7fcaab 100644
--- a/src/Network/BitTorrent/Peer/ClientInfo.hs
+++ b/src/Network/BitTorrent/Peer/ClientInfo.hs
@@ -12,6 +12,7 @@
12-- > See http://bittorrent.org/beps/bep_0020.html for more information. 12-- > See http://bittorrent.org/beps/bep_0020.html for more information.
13-- 13--
14{-# LANGUAGE OverloadedStrings #-} 14{-# LANGUAGE OverloadedStrings #-}
15{-# LANGUAGE RecordWildCards #-}
15module Network.BitTorrent.Peer.ClientInfo 16module Network.BitTorrent.Peer.ClientInfo
16 ( -- * Info 17 ( -- * Info
17 ClientInfo(..), clientInfo, ppClientInfo, unknownClient 18 ClientInfo(..), clientInfo, ppClientInfo, unknownClient
@@ -30,6 +31,7 @@ import Control.Applicative
30import Data.ByteString (ByteString) 31import Data.ByteString (ByteString)
31import qualified Data.ByteString.Char8 as BC 32import qualified Data.ByteString.Char8 as BC
32import Data.Serialize.Get 33import Data.Serialize.Get
34import Text.PrettyPrint
33 35
34import Network.BitTorrent.Peer.ID 36import Network.BitTorrent.Peer.ID
35 37
@@ -163,8 +165,8 @@ parseImpl = f . BC.unpack
163 f _ = IUnknown 165 f _ = IUnknown
164 166
165-- | Format client implementation info in human readable form. 167-- | Format client implementation info in human readable form.
166ppClientImpl :: ClientImpl -> String 168ppClientImpl :: ClientImpl -> Doc
167ppClientImpl = tail . show 169ppClientImpl = text . tail . show
168 170
169unknownImpl :: ClientImpl 171unknownImpl :: ClientImpl
170unknownImpl = IUnknown 172unknownImpl = IUnknown
@@ -174,8 +176,8 @@ unknownImpl = IUnknown
174type ClientVersion = ByteString 176type ClientVersion = ByteString
175 177
176-- | Format client implementation version in human readable form. 178-- | Format client implementation version in human readable form.
177ppClientVersion :: ClientVersion -> String 179ppClientVersion :: ClientVersion -> Doc
178ppClientVersion = BC.unpack 180ppClientVersion = text . BC.unpack
179 181
180unknownVersion :: ClientVersion 182unknownVersion :: ClientVersion
181unknownVersion = "0000" 183unknownVersion = "0000"
@@ -189,9 +191,10 @@ data ClientInfo = ClientInfo {
189 } deriving (Show, Eq, Ord) 191 } deriving (Show, Eq, Ord)
190 192
191-- | Format client implementation in human readable form. 193-- | Format client implementation in human readable form.
192ppClientInfo :: ClientInfo -> String 194ppClientInfo :: ClientInfo -> Doc
193ppClientInfo ci = ppClientImpl (ciImpl ci) ++ " version " 195ppClientInfo ClientInfo {..} =
194 ++ ppClientVersion (ciVersion ci) 196 ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
197
195 198
196-- | Unrecognized client implementation. 199-- | Unrecognized client implementation.
197unknownClient :: ClientInfo 200unknownClient :: ClientInfo
diff --git a/src/Network/BitTorrent/Peer/ID.hs b/src/Network/BitTorrent/Peer/ID.hs
index f93409ed..9bf0ae31 100644
--- a/src/Network/BitTorrent/Peer/ID.hs
+++ b/src/Network/BitTorrent/Peer/ID.hs
@@ -44,6 +44,7 @@ import Data.URLEncoded
44import Data.Version (Version(Version), versionBranch) 44import Data.Version (Version(Version), versionBranch)
45import Data.Time.Clock (getCurrentTime) 45import Data.Time.Clock (getCurrentTime)
46import Data.Time.Format (formatTime) 46import Data.Time.Format (formatTime)
47import Text.PrettyPrint (text, Doc)
47import System.Locale (defaultTimeLocale) 48import System.Locale (defaultTimeLocale)
48 49
49 50
@@ -64,8 +65,8 @@ instance Serialize PeerID where
64instance URLShow PeerID where 65instance URLShow PeerID where
65 urlShow = BC.unpack . getPeerID 66 urlShow = BC.unpack . getPeerID
66 67
67ppPeerID :: PeerID -> String 68ppPeerID :: PeerID -> Doc
68ppPeerID = BC.unpack . getPeerID 69ppPeerID = text . BC.unpack . getPeerID
69 70
70 71
71-- | Azureus-style encoding have the following layout: 72-- | Azureus-style encoding have the following layout:
diff --git a/src/Network/BitTorrent/PeerWire/Block.hs b/src/Network/BitTorrent/PeerWire/Block.hs
index fbc65338..dea37321 100644
--- a/src/Network/BitTorrent/PeerWire/Block.hs
+++ b/src/Network/BitTorrent/PeerWire/Block.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE RecordWildCards #-}
2{-# LANGUAGE OverloadedStrings #-}
1module Network.BitTorrent.PeerWire.Block 3module Network.BitTorrent.PeerWire.Block
2 ( BlockIx(..) 4 ( BlockIx(..)
3 , Block(..), blockSize 5 , Block(..), blockSize
@@ -16,6 +18,7 @@ import Data.ByteString (ByteString)
16import qualified Data.ByteString as B 18import qualified Data.ByteString as B
17import Data.Int 19import Data.Int
18import Data.Serialize 20import Data.Serialize
21import Text.PrettyPrint
19 22
20 23
21type BlockLIx = Int 24type BlockLIx = Int
@@ -51,10 +54,11 @@ instance Serialize BlockIx where
51 putInt (ixLength ix) 54 putInt (ixLength ix)
52 {-# INLINE put #-} 55 {-# INLINE put #-}
53 56
54ppBlockIx :: BlockIx -> String 57ppBlockIx :: BlockIx -> Doc
55ppBlockIx ix = "piece = " ++ show (ixPiece ix) ++ ", " 58ppBlockIx BlockIx {..} =
56 ++ "offset = " ++ show (ixOffset ix) ++ ", " 59 "piece = " <> int ixPiece <> "," <+>
57 ++ "length = " ++ show (ixLength ix) 60 "offset = " <> int ixOffset <> "," <+>
61 "length = " <> int ixLength
58 62
59data Block = Block { 63data Block = Block {
60 -- | Zero-based piece index. 64 -- | Zero-based piece index.
@@ -67,7 +71,7 @@ data Block = Block {
67 , blkData :: ByteString 71 , blkData :: ByteString
68 } deriving (Show, Eq) 72 } deriving (Show, Eq)
69 73
70ppBlock :: Block -> String 74ppBlock :: Block -> Doc
71ppBlock = ppBlockIx . blockIx 75ppBlock = ppBlockIx . blockIx
72 76
73blockSize :: Block -> Int 77blockSize :: Block -> Int
diff --git a/src/Network/BitTorrent/PeerWire/Handshake.hs b/src/Network/BitTorrent/PeerWire/Handshake.hs
index 6f4598ae..ff768cae 100644
--- a/src/Network/BitTorrent/PeerWire/Handshake.hs
+++ b/src/Network/BitTorrent/PeerWire/Handshake.hs
@@ -11,6 +11,7 @@
11-- peer. 11-- peer.
12-- 12--
13{-# LANGUAGE OverloadedStrings #-} 13{-# LANGUAGE OverloadedStrings #-}
14{-# LANGUAGE RecordWildCards #-}
14module Network.BitTorrent.PeerWire.Handshake 15module Network.BitTorrent.PeerWire.Handshake
15 ( Handshake(..), handshakeCaps 16 ( Handshake(..), handshakeCaps
16 , handshake 17 , handshake
@@ -27,6 +28,8 @@ import Data.ByteString (ByteString)
27import qualified Data.ByteString as B 28import qualified Data.ByteString as B
28import qualified Data.ByteString.Char8 as BC 29import qualified Data.ByteString.Char8 as BC
29import Data.Serialize as S 30import Data.Serialize as S
31import Text.PrettyPrint
32
30import Network 33import Network
31import Network.Socket.ByteString 34import Network.Socket.ByteString
32 35
@@ -77,9 +80,9 @@ handshakeCaps :: Handshake -> Capabilities
77handshakeCaps = hsReserved 80handshakeCaps = hsReserved
78 81
79-- | Format handshake in human readable form. 82-- | Format handshake in human readable form.
80ppHandshake :: Handshake -> String 83ppHandshake :: Handshake -> Doc
81ppHandshake hs = BC.unpack (hsProtocol hs) ++ " " 84ppHandshake Handshake {..} =
82 ++ ppClientInfo (clientInfo (hsPeerID hs)) 85 text (BC.unpack hsProtocol) <+> ppClientInfo (clientInfo hsPeerID)
83 86
84-- | Get handshake message size in bytes from the length of protocol string. 87-- | Get handshake message size in bytes from the length of protocol string.
85handshakeSize :: Word8 -> Int 88handshakeSize :: Word8 -> Int
diff --git a/src/Network/BitTorrent/PeerWire/Message.hs b/src/Network/BitTorrent/PeerWire/Message.hs
index f5ad2693..6515fdf2 100644
--- a/src/Network/BitTorrent/PeerWire/Message.hs
+++ b/src/Network/BitTorrent/PeerWire/Message.hs
@@ -1,3 +1,4 @@
1{-# LANGUAGE OverloadedStrings #-}
1module Network.BitTorrent.PeerWire.Message 2module Network.BitTorrent.PeerWire.Message
2 ( Message(..) 3 ( Message(..)
3 , Bitfield 4 , Bitfield
@@ -7,6 +8,7 @@ module Network.BitTorrent.PeerWire.Message
7import Control.Applicative 8import Control.Applicative
8import qualified Data.ByteString as B 9import qualified Data.ByteString as B
9import Data.Serialize 10import Data.Serialize
11import Text.PrettyPrint
10import Network 12import Network
11 13
12import Network.BitTorrent.PeerWire.Block 14import Network.BitTorrent.PeerWire.Block
@@ -141,10 +143,10 @@ instance Serialize Message where
141-- compact and suitable for logging: only useful information but not 143-- compact and suitable for logging: only useful information but not
142-- payload bytes. 144-- payload bytes.
143-- 145--
144ppMessage :: Message -> String 146ppMessage :: Message -> Doc
145ppMessage (Bitfield _) = "Bitfield " 147ppMessage (Bitfield _) = "Bitfield"
146ppMessage (Piece blk) = "Piece " ++ ppBlock blk 148ppMessage (Piece blk) = "Piece" <+> ppBlock blk
147ppMessage (Cancel ix) = "Cancel " ++ ppBlockIx ix 149ppMessage (Cancel ix) = "Cancel" <+> ppBlockIx ix
148ppMessage (SuggestPiece pix) = "Suggest" ++ show pix 150ppMessage (SuggestPiece pix) = "Suggest" <+> int pix
149ppMessage (RejectRequest ix) = "Reject" ++ ppBlockIx ix 151ppMessage (RejectRequest ix) = "Reject" <+> ppBlockIx ix
150ppMessage msg = show msg \ No newline at end of file 152ppMessage msg = text (show msg) \ No newline at end of file