diff options
Diffstat (limited to 'src/Network/BitTorrent/Peer')
-rw-r--r-- | src/Network/BitTorrent/Peer/Addr.hs | 11 | ||||
-rw-r--r-- | src/Network/BitTorrent/Peer/ClientInfo.hs | 17 | ||||
-rw-r--r-- | src/Network/BitTorrent/Peer/ID.hs | 5 |
3 files changed, 21 insertions, 12 deletions
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 #-} |
10 | module Network.BitTorrent.Peer.Addr | 11 | module Network.BitTorrent.Peer.Addr |
11 | ( PeerAddr(..) | 12 | ( PeerAddr(..) |
@@ -17,6 +18,7 @@ import Control.Applicative | |||
17 | import Data.BEncode | 18 | import Data.BEncode |
18 | import Data.Bits | 19 | import Data.Bits |
19 | import Data.Word | 20 | import Data.Word |
21 | import Text.PrettyPrint | ||
20 | import Network | 22 | import Network |
21 | import Network.Socket | 23 | import 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 | ||
76 | ppPeer :: PeerAddr -> String | 78 | ppPeer :: PeerAddr -> Doc |
77 | ppPeer p = maybe "" (++ " at ") ((ppClientInfo . clientInfo) <$> peerID p) | 79 | ppPeer 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 #-} | ||
15 | module Network.BitTorrent.Peer.ClientInfo | 16 | module 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 | |||
30 | import Data.ByteString (ByteString) | 31 | import Data.ByteString (ByteString) |
31 | import qualified Data.ByteString.Char8 as BC | 32 | import qualified Data.ByteString.Char8 as BC |
32 | import Data.Serialize.Get | 33 | import Data.Serialize.Get |
34 | import Text.PrettyPrint | ||
33 | 35 | ||
34 | import Network.BitTorrent.Peer.ID | 36 | import 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. |
166 | ppClientImpl :: ClientImpl -> String | 168 | ppClientImpl :: ClientImpl -> Doc |
167 | ppClientImpl = tail . show | 169 | ppClientImpl = text . tail . show |
168 | 170 | ||
169 | unknownImpl :: ClientImpl | 171 | unknownImpl :: ClientImpl |
170 | unknownImpl = IUnknown | 172 | unknownImpl = IUnknown |
@@ -174,8 +176,8 @@ unknownImpl = IUnknown | |||
174 | type ClientVersion = ByteString | 176 | type ClientVersion = ByteString |
175 | 177 | ||
176 | -- | Format client implementation version in human readable form. | 178 | -- | Format client implementation version in human readable form. |
177 | ppClientVersion :: ClientVersion -> String | 179 | ppClientVersion :: ClientVersion -> Doc |
178 | ppClientVersion = BC.unpack | 180 | ppClientVersion = text . BC.unpack |
179 | 181 | ||
180 | unknownVersion :: ClientVersion | 182 | unknownVersion :: ClientVersion |
181 | unknownVersion = "0000" | 183 | unknownVersion = "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. |
192 | ppClientInfo :: ClientInfo -> String | 194 | ppClientInfo :: ClientInfo -> Doc |
193 | ppClientInfo ci = ppClientImpl (ciImpl ci) ++ " version " | 195 | ppClientInfo ClientInfo {..} = |
194 | ++ ppClientVersion (ciVersion ci) | 196 | ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion |
197 | |||
195 | 198 | ||
196 | -- | Unrecognized client implementation. | 199 | -- | Unrecognized client implementation. |
197 | unknownClient :: ClientInfo | 200 | unknownClient :: 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 | |||
44 | import Data.Version (Version(Version), versionBranch) | 44 | import Data.Version (Version(Version), versionBranch) |
45 | import Data.Time.Clock (getCurrentTime) | 45 | import Data.Time.Clock (getCurrentTime) |
46 | import Data.Time.Format (formatTime) | 46 | import Data.Time.Format (formatTime) |
47 | import Text.PrettyPrint (text, Doc) | ||
47 | import System.Locale (defaultTimeLocale) | 48 | import System.Locale (defaultTimeLocale) |
48 | 49 | ||
49 | 50 | ||
@@ -64,8 +65,8 @@ instance Serialize PeerID where | |||
64 | instance URLShow PeerID where | 65 | instance URLShow PeerID where |
65 | urlShow = BC.unpack . getPeerID | 66 | urlShow = BC.unpack . getPeerID |
66 | 67 | ||
67 | ppPeerID :: PeerID -> String | 68 | ppPeerID :: PeerID -> Doc |
68 | ppPeerID = BC.unpack . getPeerID | 69 | ppPeerID = text . BC.unpack . getPeerID |
69 | 70 | ||
70 | 71 | ||
71 | -- | Azureus-style encoding have the following layout: | 72 | -- | Azureus-style encoding have the following layout: |