diff options
author | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-20 22:01:34 +0400 |
---|---|---|
committer | Sam Truzjan <pxqr.sta@gmail.com> | 2013-11-20 22:01:34 +0400 |
commit | cdd1782b0d55ed0119ac905904437ab8209f7cf2 (patch) | |
tree | 54dfd5d6fe0fe4de32c964718e8ae3859d42b46e | |
parent | c45c87c587046fcc7f2656bc1eb7302286c0ef96 (diff) |
Refactor Network.BitTorrent.Peer module
-rw-r--r-- | bittorrent.cabal | 11 | ||||
-rw-r--r-- | src/Data/Torrent/Client.hs | 233 | ||||
-rw-r--r-- | src/Data/Torrent/Progress.hs | 95 | ||||
-rw-r--r-- | src/Network/BitTorrent/Core/PeerAddr.hs | 119 | ||||
-rw-r--r-- | src/Network/BitTorrent/Core/PeerId.hs | 278 | ||||
-rw-r--r-- | src/Network/BitTorrent/Peer.hs | 661 |
6 files changed, 733 insertions, 664 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal index 576d0b36..a08386d0 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal | |||
@@ -41,20 +41,25 @@ library | |||
41 | , OverloadedStrings | 41 | , OverloadedStrings |
42 | , RecordWildCards | 42 | , RecordWildCards |
43 | hs-source-dirs: src | 43 | hs-source-dirs: src |
44 | exposed-modules: Data.Torrent | 44 | exposed-modules: Paths_bittorrent |
45 | , Data.Torrent | ||
45 | -- , Data.Torrent.Bitfield | 46 | -- , Data.Torrent.Bitfield |
46 | , Data.Torrent.Block | 47 | , Data.Torrent.Block |
48 | , Data.Torrent.Client | ||
47 | , Data.Torrent.InfoHash | 49 | , Data.Torrent.InfoHash |
48 | , Data.Torrent.Layout | 50 | , Data.Torrent.Layout |
49 | , Data.Torrent.Magnet | 51 | , Data.Torrent.Magnet |
50 | , Data.Torrent.Piece | 52 | , Data.Torrent.Piece |
53 | , Data.Torrent.Progress | ||
51 | , Data.Torrent.Tree | 54 | , Data.Torrent.Tree |
52 | 55 | , Network.BitTorrent.Core.PeerId | |
56 | , Network.BitTorrent.Core.PeerAddr | ||
53 | -- , System.IO.MMap.Fixed | 57 | -- , System.IO.MMap.Fixed |
54 | -- , System.Torrent.Storage | 58 | -- , System.Torrent.Storage |
55 | 59 | ||
56 | -- Network.BitTorrent | 60 | -- Network.BitTorrent |
57 | -- , Network.BitTorrent.Extension | 61 | -- , Network.BitTorrent.Extension |
62 | |||
58 | -- , Network.BitTorrent.Peer | 63 | -- , Network.BitTorrent.Peer |
59 | -- , Network.BitTorrent.Tracker | 64 | -- , Network.BitTorrent.Tracker |
60 | -- , Network.BitTorrent.Tracker.Protocol | 65 | -- , Network.BitTorrent.Tracker.Protocol |
@@ -99,7 +104,7 @@ library | |||
99 | , vector | 104 | , vector |
100 | 105 | ||
101 | -- Hashing | 106 | -- Hashing |
102 | , cryptohash | 107 | , cryptohash == 0.10.* |
103 | , hashable | 108 | , hashable |
104 | 109 | ||
105 | -- Codecs & Serialization | 110 | -- Codecs & Serialization |
diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs new file mode 100644 index 00000000..b6649e04 --- /dev/null +++ b/src/Data/Torrent/Client.hs | |||
@@ -0,0 +1,233 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- 'ClientInfo' is used to identify the client implementation and | ||
9 | -- version which also contained in 'Peer'. For exsample first 6 | ||
10 | -- bytes of peer id of this this library are @-HS0100-@ while for | ||
11 | -- mainline we have @M4-3-6--@. We could extract this info and | ||
12 | -- print in human frienly form: this is useful for debugging and | ||
13 | -- logging. For more information see: | ||
14 | -- <http://bittorrent.org/beps/bep_0020.html> NOTE: Do _not_ use | ||
15 | -- this information to control client capabilities (such as | ||
16 | -- supported enchancements), this should be done using | ||
17 | -- 'Network.BitTorrent.Extension'! | ||
18 | -- | ||
19 | module Data.Torrent.Client | ||
20 | ( ClientImpl (..) | ||
21 | , ppClientImpl | ||
22 | |||
23 | , ClientVersion (..) | ||
24 | , ppClientVersion | ||
25 | |||
26 | , ClientInfo (..) | ||
27 | , ppClientInfo | ||
28 | , libClientInfo | ||
29 | ) where | ||
30 | |||
31 | import Control.Applicative | ||
32 | import Data.ByteString as BS | ||
33 | import Data.ByteString.Char8 as BC | ||
34 | import Data.Default | ||
35 | import Data.List as L | ||
36 | import Data.Monoid | ||
37 | import Data.Text as T | ||
38 | import Data.Version | ||
39 | import Text.PrettyPrint hiding ((<>)) | ||
40 | import Paths_bittorrent (version) | ||
41 | |||
42 | |||
43 | -- | All known client versions. | ||
44 | data ClientImpl = | ||
45 | IUnknown | ||
46 | | IAres | ||
47 | | IArctic | ||
48 | | IAvicora | ||
49 | | IBitPump | ||
50 | | IAzureus | ||
51 | | IBitBuddy | ||
52 | | IBitComet | ||
53 | | IBitflu | ||
54 | | IBTG | ||
55 | | IBitRocket | ||
56 | | IBTSlave | ||
57 | | IBittorrentX | ||
58 | | IEnhancedCTorrent | ||
59 | | ICTorrent | ||
60 | | IDelugeTorrent | ||
61 | | IPropagateDataClient | ||
62 | | IEBit | ||
63 | | IElectricSheep | ||
64 | | IFoxTorrent | ||
65 | | IGSTorrent | ||
66 | | IHalite | ||
67 | | IlibHSbittorrent | ||
68 | | IHydranode | ||
69 | | IKGet | ||
70 | | IKTorrent | ||
71 | | ILH_ABC | ||
72 | | ILphant | ||
73 | | ILibtorrent | ||
74 | | ILibTorrent | ||
75 | | ILimeWire | ||
76 | | IMonoTorrent | ||
77 | | IMooPolice | ||
78 | | IMiro | ||
79 | | IMoonlightTorrent | ||
80 | | INetTransport | ||
81 | | IPando | ||
82 | | IqBittorrent | ||
83 | | IQQDownload | ||
84 | | IQt4TorrentExample | ||
85 | | IRetriever | ||
86 | | IShareaza | ||
87 | | ISwiftbit | ||
88 | | ISwarmScope | ||
89 | | ISymTorrent | ||
90 | | Isharktorrent | ||
91 | | ITorrentDotNET | ||
92 | | ITransmission | ||
93 | | ITorrentstorm | ||
94 | | ITuoTu | ||
95 | | IuLeecher | ||
96 | | IuTorrent | ||
97 | | IVagaa | ||
98 | | IBitLet | ||
99 | | IFireTorrent | ||
100 | | IXunlei | ||
101 | | IXanTorrent | ||
102 | | IXtorrent | ||
103 | | IZipTorrent | ||
104 | deriving (Show, Eq, Ord, Enum, Bounded) | ||
105 | |||
106 | -- | Used to represent not recognized implementation | ||
107 | instance Default ClientImpl where | ||
108 | def = IUnknown | ||
109 | |||
110 | -- | Format client implementation info in human readable form. | ||
111 | ppClientImpl :: ClientImpl -> Doc | ||
112 | ppClientImpl = text . L.tail . show | ||
113 | |||
114 | -- | Raw version of client, normally extracted from peer id. | ||
115 | newtype ClientVersion = ClientVersion { getClientVersion :: Version } | ||
116 | deriving (Show, Eq, Ord) | ||
117 | |||
118 | instance Default ClientVersion where | ||
119 | def = ClientVersion $ Version [0] [] | ||
120 | |||
121 | -- | Format client implementation version in human readable form. | ||
122 | ppClientVersion :: ClientVersion -> Doc | ||
123 | ppClientVersion = text . showVersion . getClientVersion | ||
124 | |||
125 | -- | All useful infomation that can be obtained from a peer | ||
126 | -- identifier. | ||
127 | data ClientInfo = ClientInfo { | ||
128 | ciImpl :: ClientImpl | ||
129 | , ciVersion :: ClientVersion | ||
130 | } deriving (Show, Eq, Ord) | ||
131 | |||
132 | -- | Unrecognized client implementation. | ||
133 | instance Default ClientInfo where | ||
134 | def = ClientInfo def def | ||
135 | |||
136 | -- | Format client implementation in human readable form. | ||
137 | ppClientInfo :: ClientInfo -> Doc | ||
138 | ppClientInfo ClientInfo {..} = | ||
139 | ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion | ||
140 | |||
141 | libClientInfo :: ClientInfo | ||
142 | libClientInfo = ClientInfo IlibHSbittorrent (ClientVersion version) | ||
143 | |||
144 | {----------------------------------------------------------------------- | ||
145 | -- For torrent file | ||
146 | -----------------------------------------------------------------------} | ||
147 | |||
148 | renderImpl :: ClientImpl -> Text | ||
149 | renderImpl = T.pack . L.tail . show | ||
150 | |||
151 | renderVersion :: ClientVersion -> Text | ||
152 | renderVersion = undefined | ||
153 | |||
154 | renderClientInfo :: ClientInfo -> Text | ||
155 | renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion | ||
156 | |||
157 | parseClientInfo :: Text -> ClientImpl | ||
158 | parseClientInfo t = undefined | ||
159 | |||
160 | {- | ||
161 | -- code used for generation; remove it later on | ||
162 | |||
163 | mkEnumTyDef :: NM -> String | ||
164 | mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd | ||
165 | |||
166 | mkPars :: NM -> String | ||
167 | mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl) | ||
168 | |||
169 | type NM = [(String, String)] | ||
170 | nameMap :: NM | ||
171 | nameMap = | ||
172 | [ ("AG", "Ares") | ||
173 | , ("A~", "Ares") | ||
174 | , ("AR", "Arctic") | ||
175 | , ("AV", "Avicora") | ||
176 | , ("AX", "BitPump") | ||
177 | , ("AZ", "Azureus") | ||
178 | , ("BB", "BitBuddy") | ||
179 | , ("BC", "BitComet") | ||
180 | , ("BF", "Bitflu") | ||
181 | , ("BG", "BTG") | ||
182 | , ("BR", "BitRocket") | ||
183 | , ("BS", "BTSlave") | ||
184 | , ("BX", "BittorrentX") | ||
185 | , ("CD", "EnhancedCTorrent") | ||
186 | , ("CT", "CTorrent") | ||
187 | , ("DE", "DelugeTorrent") | ||
188 | , ("DP", "PropagateDataClient") | ||
189 | , ("EB", "EBit") | ||
190 | , ("ES", "ElectricSheep") | ||
191 | , ("FT", "FoxTorrent") | ||
192 | , ("GS", "GSTorrent") | ||
193 | , ("HL", "Halite") | ||
194 | , ("HS", "libHSnetwork_bittorrent") | ||
195 | , ("HN", "Hydranode") | ||
196 | , ("KG", "KGet") | ||
197 | , ("KT", "KTorrent") | ||
198 | , ("LH", "LH_ABC") | ||
199 | , ("LP", "Lphant") | ||
200 | , ("LT", "Libtorrent") | ||
201 | , ("lt", "LibTorrent") | ||
202 | , ("LW", "LimeWire") | ||
203 | , ("MO", "MonoTorrent") | ||
204 | , ("MP", "MooPolice") | ||
205 | , ("MR", "Miro") | ||
206 | , ("MT", "MoonlightTorrent") | ||
207 | , ("NX", "NetTransport") | ||
208 | , ("PD", "Pando") | ||
209 | , ("qB", "qBittorrent") | ||
210 | , ("QD", "QQDownload") | ||
211 | , ("QT", "Qt4TorrentExample") | ||
212 | , ("RT", "Retriever") | ||
213 | , ("S~", "Shareaza") | ||
214 | , ("SB", "Swiftbit") | ||
215 | , ("SS", "SwarmScope") | ||
216 | , ("ST", "SymTorrent") | ||
217 | , ("st", "sharktorrent") | ||
218 | , ("SZ", "Shareaza") | ||
219 | , ("TN", "TorrentDotNET") | ||
220 | , ("TR", "Transmission") | ||
221 | , ("TS", "Torrentstorm") | ||
222 | , ("TT", "TuoTu") | ||
223 | , ("UL", "uLeecher") | ||
224 | , ("UT", "uTorrent") | ||
225 | , ("VG", "Vagaa") | ||
226 | , ("WT", "BitLet") | ||
227 | , ("WY", "FireTorrent") | ||
228 | , ("XL", "Xunlei") | ||
229 | , ("XT", "XanTorrent") | ||
230 | , ("XX", "Xtorrent") | ||
231 | , ("ZT", "ZipTorrent") | ||
232 | ] | ||
233 | -} | ||
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs new file mode 100644 index 00000000..c1515cf0 --- /dev/null +++ b/src/Data/Torrent/Progress.hs | |||
@@ -0,0 +1,95 @@ | |||
1 | {-# LANGUAGE TemplateHaskell #-} | ||
2 | {-# LANGUAGE ViewPatterns #-} | ||
3 | module Data.Torrent.Progress | ||
4 | ( -- * Peer progress | ||
5 | Progress (..) | ||
6 | , left | ||
7 | , uploaded | ||
8 | , downloaded | ||
9 | |||
10 | , startProgress | ||
11 | |||
12 | , downloadedProgress | ||
13 | , enqueuedProgress | ||
14 | , uploadedProgress | ||
15 | , dequeuedProgress | ||
16 | |||
17 | ) where | ||
18 | |||
19 | import Control.Applicative | ||
20 | import Control.Lens | ||
21 | import Data.Aeson.TH | ||
22 | import Data.List as L | ||
23 | import Data.Default | ||
24 | import Data.Serialize as S | ||
25 | |||
26 | |||
27 | -- TODO: Use Word64? | ||
28 | -- TODO: Use atomic bits? | ||
29 | |||
30 | -- | 'Progress' contains upload/download/left stats about | ||
31 | -- current client state and used to notify the tracker. | ||
32 | -- | ||
33 | -- Progress data is considered as dynamic within one client | ||
34 | -- session. This data also should be shared across client application | ||
35 | -- sessions (e.g. files), otherwise use 'startProgress' to get initial | ||
36 | -- 'Progress'. | ||
37 | -- | ||
38 | data Progress = Progress | ||
39 | { _downloaded :: !Integer -- ^ Total amount of bytes downloaded; | ||
40 | , _left :: !Integer -- ^ Total amount of bytes left; | ||
41 | , _uploaded :: !Integer -- ^ Total amount of bytes uploaded. | ||
42 | } deriving (Show, Read, Eq) | ||
43 | |||
44 | $(makeLenses ''Progress) | ||
45 | $(deriveJSON L.tail ''Progress) | ||
46 | |||
47 | instance Serialize Progress where | ||
48 | put Progress {..} = do | ||
49 | putWord64be $ fromIntegral _downloaded | ||
50 | putWord64be $ fromIntegral _left | ||
51 | putWord64be $ fromIntegral _uploaded | ||
52 | |||
53 | get = Progress | ||
54 | <$> (fromIntegral <$> getWord64be) | ||
55 | <*> (fromIntegral <$> getWord64be) | ||
56 | <*> (fromIntegral <$> getWord64be) | ||
57 | |||
58 | instance Default Progress where | ||
59 | def = Progress 0 0 0 | ||
60 | {-# INLINE def #-} | ||
61 | |||
62 | -- TODO Monoid instance | ||
63 | |||
64 | -- | Initial progress is used when there are no session before. | ||
65 | -- | ||
66 | -- Please note that tracker might penalize client some way if the do | ||
67 | -- not accumulate progress. If possible and save 'Progress' between | ||
68 | -- client sessions to avoid that. | ||
69 | -- | ||
70 | startProgress :: Integer -> Progress | ||
71 | startProgress = Progress 0 0 | ||
72 | {-# INLINE startProgress #-} | ||
73 | |||
74 | -- | Used when the client download some data from /any/ peer. | ||
75 | downloadedProgress :: Int -> Progress -> Progress | ||
76 | downloadedProgress (fromIntegral -> amount) | ||
77 | = (left -~ amount) | ||
78 | . (downloaded +~ amount) | ||
79 | {-# INLINE downloadedProgress #-} | ||
80 | |||
81 | -- | Used when the client upload some data to /any/ peer. | ||
82 | uploadedProgress :: Int -> Progress -> Progress | ||
83 | uploadedProgress (fromIntegral -> amount) = uploaded +~ amount | ||
84 | {-# INLINE uploadedProgress #-} | ||
85 | |||
86 | -- | Used when leecher join client session. | ||
87 | enqueuedProgress :: Integer -> Progress -> Progress | ||
88 | enqueuedProgress amount = left +~ amount | ||
89 | {-# INLINE enqueuedProgress #-} | ||
90 | |||
91 | -- | Used when leecher leave client session. | ||
92 | -- (e.g. user deletes not completed torrent) | ||
93 | dequeuedProgress :: Integer -> Progress -> Progress | ||
94 | dequeuedProgress amount = left -~ amount | ||
95 | {-# INLINE dequeuedProgress #-} | ||
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs new file mode 100644 index 00000000..84b1e1f6 --- /dev/null +++ b/src/Network/BitTorrent/Core/PeerAddr.hs | |||
@@ -0,0 +1,119 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- * 'PeerAddr' is used to represent peer location. Currently it's | ||
9 | -- just peer IP and peer port but this might be changed later. | ||
10 | -- | ||
11 | {-# LANGUAGE TemplateHaskell #-} | ||
12 | {-# LANGUAGE StandaloneDeriving #-} | ||
13 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
14 | {-# LANGUAGE DeriveDataTypeable #-} | ||
15 | {-# OPTIONS -fno-warn-orphans #-} -- for PortNumber instances | ||
16 | module Network.BitTorrent.Core.PeerAddr | ||
17 | ( -- * Peer address | ||
18 | PeerAddr(..) | ||
19 | , getCompactPeerList | ||
20 | , peerSockAddr | ||
21 | , connectToPeer | ||
22 | , ppPeer | ||
23 | ) where | ||
24 | |||
25 | import Control.Applicative | ||
26 | import Data.Aeson (ToJSON, FromJSON) | ||
27 | import Data.Aeson.TH | ||
28 | import Data.BEncode as BS | ||
29 | import Data.Bits | ||
30 | import Data.Char | ||
31 | import Data.List as L | ||
32 | import Data.Serialize as S | ||
33 | import Data.Typeable | ||
34 | import Data.Word | ||
35 | import Network.Socket | ||
36 | import Text.PrettyPrint | ||
37 | |||
38 | import Data.Torrent.Client | ||
39 | import Network.BitTorrent.Core.PeerId | ||
40 | |||
41 | |||
42 | deriving instance ToJSON PortNumber | ||
43 | deriving instance FromJSON PortNumber | ||
44 | |||
45 | instance BEncode PortNumber where | ||
46 | toBEncode = toBEncode . fromEnum | ||
47 | fromBEncode b = toEnum <$> fromBEncode b | ||
48 | |||
49 | instance Serialize PortNumber where | ||
50 | get = fromIntegral <$> getWord16be | ||
51 | {-# INLINE get #-} | ||
52 | put = putWord16be . fromIntegral | ||
53 | {-# INLINE put #-} | ||
54 | |||
55 | -- TODO check semantic of ord and eq instances | ||
56 | |||
57 | -- | Peer address info normally extracted from peer list or peer | ||
58 | -- compact list encoding. | ||
59 | data PeerAddr = PeerAddr { | ||
60 | peerID :: Maybe PeerId | ||
61 | , peerIP :: {-# UNPACK #-} !HostAddress | ||
62 | , peerPort :: {-# UNPACK #-} !PortNumber | ||
63 | } deriving (Show, Eq, Ord, Typeable) | ||
64 | |||
65 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''PeerAddr) | ||
66 | |||
67 | instance BEncode PeerAddr where | ||
68 | toBEncode (PeerAddr pid pip pport) = toDict $ | ||
69 | "peer id" .=? pid | ||
70 | .: "ip" .=! pip | ||
71 | .: "port" .=! pport | ||
72 | .: endDict | ||
73 | |||
74 | fromBEncode = fromDict $ do | ||
75 | PeerAddr <$>? "peer id" | ||
76 | <*>! "ip" | ||
77 | <*>! "port" | ||
78 | |||
79 | instance Serialize PeerAddr where | ||
80 | put PeerAddr {..} = put peerID >> put peerPort | ||
81 | {-# INLINE put #-} | ||
82 | get = PeerAddr Nothing <$> get <*> get | ||
83 | {-# INLINE get #-} | ||
84 | |||
85 | getCompactPeerList :: S.Get [PeerAddr] | ||
86 | getCompactPeerList = many get | ||
87 | |||
88 | -- TODO make platform independent, clarify htonl | ||
89 | |||
90 | -- | Convert peer info from tracker response to socket address. Used | ||
91 | -- for establish connection between peers. | ||
92 | -- | ||
93 | peerSockAddr :: PeerAddr -> SockAddr | ||
94 | peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP) | ||
95 | where | ||
96 | htonl :: Word32 -> Word32 | ||
97 | htonl d = | ||
98 | ((d .&. 0xff) `shiftL` 24) .|. | ||
99 | (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|. | ||
100 | (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|. | ||
101 | ((d `shiftR` 24) .&. 0xff) | ||
102 | |||
103 | g :: PortNumber -> PortNumber | ||
104 | g = id | ||
105 | |||
106 | -- | Tries to connect to peer using reasonable default parameters. | ||
107 | connectToPeer :: PeerAddr -> IO Socket | ||
108 | connectToPeer p = do | ||
109 | sock <- socket AF_INET Stream Network.Socket.defaultProtocol | ||
110 | connect sock (peerSockAddr p) | ||
111 | return sock | ||
112 | |||
113 | -- | Pretty print peer address in human readable form. | ||
114 | ppPeer :: PeerAddr -> Doc | ||
115 | ppPeer p @ PeerAddr {..} = case peerID of | ||
116 | Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr | ||
117 | Nothing -> paddr | ||
118 | where | ||
119 | paddr = text (show (peerSockAddr p)) | ||
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs new file mode 100644 index 00000000..a32aa990 --- /dev/null +++ b/src/Network/BitTorrent/Core/PeerId.hs | |||
@@ -0,0 +1,278 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : portable | ||
7 | -- | ||
8 | -- 'PeerID' represent self assigned peer identificator. Ideally each | ||
9 | -- host in the network should have unique peer id to avoid | ||
10 | -- collisions, therefore for peer ID generation we use good entropy | ||
11 | -- source. (FIX not really) Peer ID is sent in /tracker request/, | ||
12 | -- sent and received in /peer handshakes/ and used in /distributed | ||
13 | -- hash table/ queries. | ||
14 | -- | ||
15 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
16 | module Network.BitTorrent.Core.PeerId | ||
17 | ( -- * PeerId | ||
18 | PeerId (getPeerId) | ||
19 | , ppPeerId | ||
20 | |||
21 | -- * Generation | ||
22 | , genPeerId | ||
23 | , timestamp | ||
24 | , entropy | ||
25 | |||
26 | -- * Encoding | ||
27 | , azureusStyle | ||
28 | , shadowStyle | ||
29 | |||
30 | -- * Decoding | ||
31 | , clientInfo | ||
32 | |||
33 | -- ** Extra | ||
34 | , byteStringPadded | ||
35 | , defaultClientId | ||
36 | , defaultVersionNumber | ||
37 | ) where | ||
38 | |||
39 | import Control.Applicative | ||
40 | import Data.Aeson | ||
41 | import Data.BEncode as BE | ||
42 | import Data.ByteString as BS | ||
43 | import Data.ByteString.Char8 as BC | ||
44 | import qualified Data.ByteString.Lazy as BL | ||
45 | import qualified Data.ByteString.Lazy.Builder as BS | ||
46 | import Data.Default | ||
47 | import Data.Foldable (foldMap) | ||
48 | import Data.List as L | ||
49 | import Data.Maybe (fromMaybe) | ||
50 | import Data.Monoid | ||
51 | import Data.Serialize as S | ||
52 | import Data.Time.Clock (getCurrentTime) | ||
53 | import Data.Time.Format (formatTime) | ||
54 | import Data.URLEncoded | ||
55 | import Data.Version (Version(Version), versionBranch) | ||
56 | import System.Entropy (getEntropy) | ||
57 | import System.Locale (defaultTimeLocale) | ||
58 | import Text.PrettyPrint hiding ((<>)) | ||
59 | import Text.Read (readMaybe) | ||
60 | import Paths_bittorrent (version) | ||
61 | |||
62 | import Data.Torrent.Client | ||
63 | |||
64 | |||
65 | -- | Peer identifier is exactly 20 bytes long bytestring. | ||
66 | newtype PeerId = PeerId { getPeerId :: ByteString } | ||
67 | deriving (Show, Eq, Ord, BEncode, ToJSON, FromJSON) | ||
68 | |||
69 | instance Serialize PeerId where | ||
70 | put = putByteString . getPeerId | ||
71 | get = PeerId <$> getBytes 20 | ||
72 | |||
73 | instance URLShow PeerId where | ||
74 | urlShow = BC.unpack . getPeerId | ||
75 | |||
76 | -- | Format peer id in human readable form. | ||
77 | ppPeerId :: PeerId -> Doc | ||
78 | ppPeerId = text . BC.unpack . getPeerId | ||
79 | |||
80 | {----------------------------------------------------------------------- | ||
81 | -- Encoding | ||
82 | -----------------------------------------------------------------------} | ||
83 | |||
84 | -- | Pad bytestring so it's becomes exactly request length. Conversion | ||
85 | -- is done like so: | ||
86 | -- | ||
87 | -- * length < size: Complete bytestring by given charaters. | ||
88 | -- | ||
89 | -- * length = size: Output bytestring as is. | ||
90 | -- | ||
91 | -- * length > size: Drop last (length - size) charaters from a | ||
92 | -- given bytestring. | ||
93 | -- | ||
94 | byteStringPadded :: ByteString -- ^ bytestring to be padded. | ||
95 | -> Int -- ^ size of result builder. | ||
96 | -> Char -- ^ character used for padding. | ||
97 | -> BS.Builder | ||
98 | byteStringPadded bs s c = | ||
99 | BS.byteString (BS.take s bs) <> | ||
100 | BS.byteString (BC.replicate padLen c) | ||
101 | where | ||
102 | padLen = s - min (BS.length bs) s | ||
103 | |||
104 | -- | Azureus-style encoding have the following layout: | ||
105 | -- | ||
106 | -- * 1 byte : '-' | ||
107 | -- | ||
108 | -- * 2 bytes: client id | ||
109 | -- | ||
110 | -- * 4 bytes: version number | ||
111 | -- | ||
112 | -- * 1 byte : '-' | ||
113 | -- | ||
114 | -- * 12 bytes: random number | ||
115 | -- | ||
116 | azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'. | ||
117 | -> ByteString -- ^ Version number, padded with 'X'. | ||
118 | -> ByteString -- ^ Random number, padded with '0'. | ||
119 | -> PeerId -- ^ Azureus-style encoded peer ID. | ||
120 | azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $ | ||
121 | BS.char8 '-' <> | ||
122 | byteStringPadded cid 2 'H' <> | ||
123 | byteStringPadded ver 4 'X' <> | ||
124 | BS.char8 '-' <> | ||
125 | byteStringPadded rnd 12 '0' | ||
126 | |||
127 | -- | Shadow-style encoding have the following layout: | ||
128 | -- | ||
129 | -- * 1 byte : client id. | ||
130 | -- | ||
131 | -- * 0-4 bytes: version number. If less than 4 then padded with | ||
132 | -- '-' char. | ||
133 | -- | ||
134 | -- * 15 bytes : random number. If length is less than 15 then | ||
135 | -- padded with '0' char. | ||
136 | -- | ||
137 | shadowStyle :: Char -- ^ Client ID. | ||
138 | -> ByteString -- ^ Version number. | ||
139 | -> ByteString -- ^ Random number. | ||
140 | -> PeerId -- ^ Shadow style encoded peer ID. | ||
141 | shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $ | ||
142 | BS.char8 cid <> | ||
143 | byteStringPadded ver 4 '-' <> | ||
144 | byteStringPadded rnd 15 '0' | ||
145 | |||
146 | |||
147 | -- | "HS" - 2 bytes long client identifier. | ||
148 | defaultClientId :: ByteString | ||
149 | defaultClientId = "HS" | ||
150 | |||
151 | -- | Gives exactly 4 bytes long version number for any version of the | ||
152 | -- package. Version is taken from .cabal. | ||
153 | defaultVersionNumber :: ByteString | ||
154 | defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $ | ||
155 | versionBranch version | ||
156 | |||
157 | {----------------------------------------------------------------------- | ||
158 | -- Generation | ||
159 | -----------------------------------------------------------------------} | ||
160 | |||
161 | -- | Gives 15 characters long decimal timestamp such that: | ||
162 | -- | ||
163 | -- * 6 bytes : first 6 characters from picoseconds obtained with %q. | ||
164 | -- | ||
165 | -- * 1 bytes : character '.' for readability. | ||
166 | -- | ||
167 | -- * 9..* bytes: number of whole seconds since the Unix epoch | ||
168 | -- (!)REVERSED. | ||
169 | -- | ||
170 | -- Can be used both with shadow and azureus style encoding. This | ||
171 | -- format is used to make the ID's readable(for debugging) and more | ||
172 | -- or less random. | ||
173 | -- | ||
174 | timestamp :: IO ByteString | ||
175 | timestamp = (BC.pack . format) <$> getCurrentTime | ||
176 | where | ||
177 | format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ | ||
178 | L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t)) | ||
179 | |||
180 | -- | Gives 15 character long random bytestring. This is more robust | ||
181 | -- method for generation of random part of peer ID than timestamp. | ||
182 | entropy :: IO ByteString | ||
183 | entropy = getEntropy 15 | ||
184 | |||
185 | -- NOTE: entropy generates incorrrect peer id | ||
186 | |||
187 | -- | Here we use Azureus-style encoding with the following args: | ||
188 | -- | ||
189 | -- * 'HS' for the client id. | ||
190 | -- | ||
191 | -- * Version of the package for the version number | ||
192 | -- | ||
193 | -- * UTC time day ++ day time for the random number. | ||
194 | -- | ||
195 | genPeerId :: IO PeerId | ||
196 | genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp | ||
197 | |||
198 | {----------------------------------------------------------------------- | ||
199 | -- Decoding | ||
200 | -----------------------------------------------------------------------} | ||
201 | |||
202 | parseImpl :: ByteString -> ClientImpl | ||
203 | parseImpl = f . BC.unpack | ||
204 | where | ||
205 | f "AG" = IAres | ||
206 | f "A~" = IAres | ||
207 | f "AR" = IArctic | ||
208 | f "AV" = IAvicora | ||
209 | f "AX" = IBitPump | ||
210 | f "AZ" = IAzureus | ||
211 | f "BB" = IBitBuddy | ||
212 | f "BC" = IBitComet | ||
213 | f "BF" = IBitflu | ||
214 | f "BG" = IBTG | ||
215 | f "BR" = IBitRocket | ||
216 | f "BS" = IBTSlave | ||
217 | f "BX" = IBittorrentX | ||
218 | f "CD" = IEnhancedCTorrent | ||
219 | f "CT" = ICTorrent | ||
220 | f "DE" = IDelugeTorrent | ||
221 | f "DP" = IPropagateDataClient | ||
222 | f "EB" = IEBit | ||
223 | f "ES" = IElectricSheep | ||
224 | f "FT" = IFoxTorrent | ||
225 | f "GS" = IGSTorrent | ||
226 | f "HL" = IHalite | ||
227 | f "HS" = IlibHSbittorrent | ||
228 | f "HN" = IHydranode | ||
229 | f "KG" = IKGet | ||
230 | f "KT" = IKTorrent | ||
231 | f "LH" = ILH_ABC | ||
232 | f "LP" = ILphant | ||
233 | f "LT" = ILibtorrent | ||
234 | f "lt" = ILibTorrent | ||
235 | f "LW" = ILimeWire | ||
236 | f "MO" = IMonoTorrent | ||
237 | f "MP" = IMooPolice | ||
238 | f "MR" = IMiro | ||
239 | f "MT" = IMoonlightTorrent | ||
240 | f "NX" = INetTransport | ||
241 | f "PD" = IPando | ||
242 | f "qB" = IqBittorrent | ||
243 | f "QD" = IQQDownload | ||
244 | f "QT" = IQt4TorrentExample | ||
245 | f "RT" = IRetriever | ||
246 | f "S~" = IShareaza | ||
247 | f "SB" = ISwiftbit | ||
248 | f "SS" = ISwarmScope | ||
249 | f "ST" = ISymTorrent | ||
250 | f "st" = Isharktorrent | ||
251 | f "SZ" = IShareaza | ||
252 | f "TN" = ITorrentDotNET | ||
253 | f "TR" = ITransmission | ||
254 | f "TS" = ITorrentstorm | ||
255 | f "TT" = ITuoTu | ||
256 | f "UL" = IuLeecher | ||
257 | f "UT" = IuTorrent | ||
258 | f "VG" = IVagaa | ||
259 | f "WT" = IBitLet | ||
260 | f "WY" = IFireTorrent | ||
261 | f "XL" = IXunlei | ||
262 | f "XT" = IXanTorrent | ||
263 | f "XX" = IXtorrent | ||
264 | f "ZT" = IZipTorrent | ||
265 | f _ = IUnknown | ||
266 | |||
267 | -- | Tries to extract meaningful information from peer ID bytes. If | ||
268 | -- peer id uses unknown coding style then client info returned is | ||
269 | -- 'def'. | ||
270 | -- | ||
271 | clientInfo :: PeerId -> ClientInfo | ||
272 | clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid) | ||
273 | where -- TODO other styles | ||
274 | getCI = getWord8 >> ClientInfo <$> getClientImpl <*> getClientVersion | ||
275 | getClientImpl = parseImpl <$> getByteString 2 | ||
276 | getClientVersion = mkVer <$> getByteString 4 | ||
277 | where | ||
278 | mkVer bs = ClientVersion $ Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] [] | ||
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs deleted file mode 100644 index f2148eda..00000000 --- a/src/Network/BitTorrent/Peer.hs +++ /dev/null | |||
@@ -1,661 +0,0 @@ | |||
1 | -- | | ||
2 | -- Copyright : (c) Sam Truzjan 2013 | ||
3 | -- License : BSD3 | ||
4 | -- Maintainer : pxqr.sta@gmail.com | ||
5 | -- Stability : experimental | ||
6 | -- Portability : non-portable | ||
7 | -- | ||
8 | -- This modules provides three datatypes related to a peer as a host: | ||
9 | -- | ||
10 | -- * 'PeerID' represent self assigned peer identificator. Ideally | ||
11 | -- each host in the network should have unique peer id to avoid | ||
12 | -- collisions, therefor for peer ID generation we use good entropy | ||
13 | -- source. (FIX not really) Peer ID is sent in /tracker request/, | ||
14 | -- sent and received in /peer handshakes/ and used in /distributed | ||
15 | -- hash table/ queries. | ||
16 | -- | ||
17 | -- * 'PeerAddr' is used to represent peer location. Currently it's | ||
18 | -- just peer IP and peer port but this might be changed later. | ||
19 | -- | ||
20 | -- * 'ClientInfo' is used to identify the client implementation and | ||
21 | -- version which also contained in 'Peer'. For exsample first | ||
22 | -- 6 bytes of peer id of this this library are @-HS0100-@ while | ||
23 | -- for mainline we have @M4-3-6--@. | ||
24 | -- We could extract this info and print in human frienly form: this | ||
25 | -- is useful for debugging and logging. For more information see: | ||
26 | -- <http://bittorrent.org/beps/bep_0020.html> | ||
27 | -- NOTE: Do _not_ use this information to control client | ||
28 | -- capabilities (such as supported enchancements), this should be | ||
29 | -- done using 'Network.BitTorrent.Extension'! | ||
30 | -- | ||
31 | {-# LANGUAGE ViewPatterns #-} | ||
32 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} | ||
33 | {-# LANGUAGE StandaloneDeriving #-} | ||
34 | {-# LANGUAGE TemplateHaskell #-} | ||
35 | {-# OPTIONS -fno-warn-orphans #-} | ||
36 | module Network.BitTorrent.Peer | ||
37 | ( -- * Peer identificators | ||
38 | PeerId (getPeerId), ppPeerId | ||
39 | |||
40 | -- ** Encoding styles | ||
41 | , azureusStyle, shadowStyle | ||
42 | |||
43 | -- ** Defaults | ||
44 | , defaultClientId, defaultVersionNumber | ||
45 | |||
46 | -- ** Generation | ||
47 | , genPeerId | ||
48 | , timestamp, entropy | ||
49 | |||
50 | -- ** Extra | ||
51 | , byteStringPadded | ||
52 | |||
53 | -- * Peer address | ||
54 | , PeerAddr(..) | ||
55 | , getCompactPeerList | ||
56 | , peerSockAddr | ||
57 | , connectToPeer | ||
58 | , ppPeer | ||
59 | |||
60 | -- * Peer progress | ||
61 | , Progress (..) | ||
62 | , left | ||
63 | , uploaded | ||
64 | , downloaded | ||
65 | |||
66 | , startProgress | ||
67 | |||
68 | , downloadedProgress | ||
69 | , enqueuedProgress | ||
70 | , uploadedProgress | ||
71 | , dequeuedProgress | ||
72 | |||
73 | -- * Client version detection | ||
74 | -- ** Info | ||
75 | , ClientInfo(..), clientInfo, ppClientInfo, unknownClient | ||
76 | |||
77 | -- ** Version | ||
78 | , ClientVersion, ppClientVersion | ||
79 | |||
80 | -- ** Implementation | ||
81 | , ClientImpl(..), ppClientImpl | ||
82 | |||
83 | ) where | ||
84 | |||
85 | |||
86 | import Control.Applicative | ||
87 | import Control.Lens | ||
88 | import Data.Aeson | ||
89 | import Data.Aeson.TH | ||
90 | import Data.BEncode | ||
91 | import Data.Bits | ||
92 | import Data.ByteString (ByteString) | ||
93 | import qualified Data.ByteString as B | ||
94 | import qualified Data.ByteString.Char8 as BC | ||
95 | import qualified Data.ByteString.Lazy as BL | ||
96 | import qualified Data.ByteString.Lazy.Builder as B | ||
97 | import Data.Char | ||
98 | import Data.List as L | ||
99 | import Data.Word | ||
100 | import Data.Foldable (foldMap) | ||
101 | import Data.Monoid ((<>)) | ||
102 | import Data.Serialize | ||
103 | import Data.URLEncoded | ||
104 | import Data.Version (Version(Version), versionBranch) | ||
105 | import Data.Time.Clock (getCurrentTime) | ||
106 | import Data.Time.Format (formatTime) | ||
107 | import Text.PrettyPrint (text, Doc, (<+>)) | ||
108 | import System.Locale (defaultTimeLocale) | ||
109 | import System.Entropy (getEntropy) | ||
110 | import Network hiding (accept) | ||
111 | import Network.Socket | ||
112 | |||
113 | |||
114 | -- TODO we have linker error here, so manually hardcoded version for a | ||
115 | -- while. | ||
116 | |||
117 | -- import Paths_network_bittorrent (version) | ||
118 | |||
119 | version :: Version | ||
120 | version = Version [0, 10, 0, 0] [] | ||
121 | |||
122 | {----------------------------------------------------------------------- | ||
123 | Peer identification | ||
124 | -----------------------------------------------------------------------} | ||
125 | |||
126 | -- | Peer identifier is exactly 20 bytes long bytestring. | ||
127 | newtype PeerId = PeerId { getPeerId :: ByteString } | ||
128 | deriving (Show, Eq, Ord, BEncodable, ToJSON, FromJSON) | ||
129 | |||
130 | instance Serialize PeerId where | ||
131 | put = putByteString . getPeerId | ||
132 | get = PeerId <$> getBytes 20 | ||
133 | |||
134 | instance URLShow PeerId where | ||
135 | urlShow = BC.unpack . getPeerId | ||
136 | |||
137 | -- | Format peer id in human readable form. | ||
138 | ppPeerId :: PeerId -> Doc | ||
139 | ppPeerId = text . BC.unpack . getPeerId | ||
140 | |||
141 | |||
142 | -- | Azureus-style encoding have the following layout: | ||
143 | -- | ||
144 | -- * 1 byte : '-' | ||
145 | -- | ||
146 | -- * 2 bytes: client id | ||
147 | -- | ||
148 | -- * 4 bytes: version number | ||
149 | -- | ||
150 | -- * 1 byte : '-' | ||
151 | -- | ||
152 | -- * 12 bytes: random number | ||
153 | -- | ||
154 | azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'. | ||
155 | -> ByteString -- ^ Version number, padded with 'X'. | ||
156 | -> ByteString -- ^ Random number, padded with '0'. | ||
157 | -> PeerId -- ^ Azureus-style encoded peer ID. | ||
158 | azureusStyle cid ver rnd = PeerId $ BL.toStrict $ B.toLazyByteString $ | ||
159 | B.char8 '-' <> | ||
160 | byteStringPadded cid 2 'H' <> | ||
161 | byteStringPadded ver 4 'X' <> | ||
162 | B.char8 '-' <> | ||
163 | byteStringPadded rnd 12 '0' | ||
164 | |||
165 | -- | Shadow-style encoding have the following layout: | ||
166 | -- | ||
167 | -- * 1 byte : client id. | ||
168 | -- | ||
169 | -- * 0-4 bytes: version number. If less than 4 then padded with | ||
170 | -- '-' char. | ||
171 | -- | ||
172 | -- * 15 bytes : random number. If length is less than 15 then | ||
173 | -- padded with '0' char. | ||
174 | -- | ||
175 | shadowStyle :: Char -- ^ Client ID. | ||
176 | -> ByteString -- ^ Version number. | ||
177 | -> ByteString -- ^ Random number. | ||
178 | -> PeerId -- ^ Shadow style encoded peer ID. | ||
179 | shadowStyle cid ver rnd = PeerId $ BL.toStrict $ B.toLazyByteString $ | ||
180 | B.char8 cid <> | ||
181 | byteStringPadded ver 4 '-' <> | ||
182 | byteStringPadded rnd 15 '0' | ||
183 | |||
184 | |||
185 | -- | "HS" - 2 bytes long client identifier. | ||
186 | defaultClientId :: ByteString | ||
187 | defaultClientId = "HS" | ||
188 | |||
189 | -- | Gives exactly 4 bytes long version number for any version of the | ||
190 | -- package. Version is taken from .cabal. | ||
191 | defaultVersionNumber :: ByteString | ||
192 | defaultVersionNumber = B.take 4 $ BC.pack $ foldMap show $ | ||
193 | versionBranch version | ||
194 | |||
195 | -- | Gives 15 characters long decimal timestamp such that: | ||
196 | -- | ||
197 | -- * 6 bytes : first 6 characters from picoseconds obtained with %q. | ||
198 | -- | ||
199 | -- * 1 bytes : character '.' for readability. | ||
200 | -- | ||
201 | -- * 9..* bytes: number of whole seconds since the Unix epoch | ||
202 | -- (!)REVERSED. | ||
203 | -- | ||
204 | -- Can be used both with shadow and azureus style encoding. This | ||
205 | -- format is used to make the ID's readable(for debugging) and more | ||
206 | -- or less random. | ||
207 | -- | ||
208 | timestamp :: IO ByteString | ||
209 | timestamp = (BC.pack . format) <$> getCurrentTime | ||
210 | where | ||
211 | format t = take 6 (formatTime defaultTimeLocale "%q" t) ++ "." ++ | ||
212 | take 9 (reverse (formatTime defaultTimeLocale "%s" t)) | ||
213 | |||
214 | -- | Gives 15 character long random bytestring. This is more robust | ||
215 | -- method for generation of random part of peer ID than timestamp. | ||
216 | entropy :: IO ByteString | ||
217 | entropy = getEntropy 15 | ||
218 | |||
219 | -- NOTE: entropy generates incorrrect peer id | ||
220 | |||
221 | -- | Here we use Azureus-style encoding with the following args: | ||
222 | -- | ||
223 | -- * 'HS' for the client id. | ||
224 | -- | ||
225 | -- * Version of the package for the version number | ||
226 | -- | ||
227 | -- * UTC time day ++ day time for the random number. | ||
228 | -- | ||
229 | genPeerId :: IO PeerId | ||
230 | genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp | ||
231 | |||
232 | -- | Pad bytestring so it's becomes exactly request length. Conversion | ||
233 | -- is done like so: | ||
234 | -- | ||
235 | -- * length < size: Complete bytestring by given charaters. | ||
236 | -- | ||
237 | -- * length = size: Output bytestring as is. | ||
238 | -- | ||
239 | -- * length > size: Drop last (length - size) charaters from a | ||
240 | -- given bytestring. | ||
241 | -- | ||
242 | byteStringPadded :: ByteString -- ^ bytestring to be padded. | ||
243 | -> Int -- ^ size of result builder. | ||
244 | -> Char -- ^ character used for padding. | ||
245 | -> B.Builder | ||
246 | byteStringPadded bs s c = | ||
247 | B.byteString (B.take s bs) <> | ||
248 | B.byteString (BC.replicate padLen c) | ||
249 | where | ||
250 | padLen = s - min (B.length bs) s | ||
251 | |||
252 | |||
253 | {----------------------------------------------------------------------- | ||
254 | Client detection | ||
255 | -----------------------------------------------------------------------} | ||
256 | |||
257 | -- | All known client versions. | ||
258 | data ClientImpl = | ||
259 | IUnknown | ||
260 | | IAres | ||
261 | | IArctic | ||
262 | | IAvicora | ||
263 | | IBitPump | ||
264 | | IAzureus | ||
265 | | IBitBuddy | ||
266 | | IBitComet | ||
267 | | IBitflu | ||
268 | | IBTG | ||
269 | | IBitRocket | ||
270 | | IBTSlave | ||
271 | | IBittorrentX | ||
272 | | IEnhancedCTorrent | ||
273 | | ICTorrent | ||
274 | | IDelugeTorrent | ||
275 | | IPropagateDataClient | ||
276 | | IEBit | ||
277 | | IElectricSheep | ||
278 | | IFoxTorrent | ||
279 | | IGSTorrent | ||
280 | | IHalite | ||
281 | | IlibHSbittorrent | ||
282 | | IHydranode | ||
283 | | IKGet | ||
284 | | IKTorrent | ||
285 | | ILH_ABC | ||
286 | | ILphant | ||
287 | | ILibtorrent | ||
288 | | ILibTorrent | ||
289 | | ILimeWire | ||
290 | | IMonoTorrent | ||
291 | | IMooPolice | ||
292 | | IMiro | ||
293 | | IMoonlightTorrent | ||
294 | | INetTransport | ||
295 | | IPando | ||
296 | | IqBittorrent | ||
297 | | IQQDownload | ||
298 | | IQt4TorrentExample | ||
299 | | IRetriever | ||
300 | | IShareaza | ||
301 | | ISwiftbit | ||
302 | | ISwarmScope | ||
303 | | ISymTorrent | ||
304 | | Isharktorrent | ||
305 | | ITorrentDotNET | ||
306 | | ITransmission | ||
307 | | ITorrentstorm | ||
308 | | ITuoTu | ||
309 | | IuLeecher | ||
310 | | IuTorrent | ||
311 | | IVagaa | ||
312 | | IBitLet | ||
313 | | IFireTorrent | ||
314 | | IXunlei | ||
315 | | IXanTorrent | ||
316 | | IXtorrent | ||
317 | | IZipTorrent | ||
318 | deriving (Show, Eq, Ord) | ||
319 | |||
320 | parseImpl :: ByteString -> ClientImpl | ||
321 | parseImpl = f . BC.unpack | ||
322 | where | ||
323 | f "AG" = IAres | ||
324 | f "A~" = IAres | ||
325 | f "AR" = IArctic | ||
326 | f "AV" = IAvicora | ||
327 | f "AX" = IBitPump | ||
328 | f "AZ" = IAzureus | ||
329 | f "BB" = IBitBuddy | ||
330 | f "BC" = IBitComet | ||
331 | f "BF" = IBitflu | ||
332 | f "BG" = IBTG | ||
333 | f "BR" = IBitRocket | ||
334 | f "BS" = IBTSlave | ||
335 | f "BX" = IBittorrentX | ||
336 | f "CD" = IEnhancedCTorrent | ||
337 | f "CT" = ICTorrent | ||
338 | f "DE" = IDelugeTorrent | ||
339 | f "DP" = IPropagateDataClient | ||
340 | f "EB" = IEBit | ||
341 | f "ES" = IElectricSheep | ||
342 | f "FT" = IFoxTorrent | ||
343 | f "GS" = IGSTorrent | ||
344 | f "HL" = IHalite | ||
345 | f "HS" = IlibHSbittorrent | ||
346 | f "HN" = IHydranode | ||
347 | f "KG" = IKGet | ||
348 | f "KT" = IKTorrent | ||
349 | f "LH" = ILH_ABC | ||
350 | f "LP" = ILphant | ||
351 | f "LT" = ILibtorrent | ||
352 | f "lt" = ILibTorrent | ||
353 | f "LW" = ILimeWire | ||
354 | f "MO" = IMonoTorrent | ||
355 | f "MP" = IMooPolice | ||
356 | f "MR" = IMiro | ||
357 | f "MT" = IMoonlightTorrent | ||
358 | f "NX" = INetTransport | ||
359 | f "PD" = IPando | ||
360 | f "qB" = IqBittorrent | ||
361 | f "QD" = IQQDownload | ||
362 | f "QT" = IQt4TorrentExample | ||
363 | f "RT" = IRetriever | ||
364 | f "S~" = IShareaza | ||
365 | f "SB" = ISwiftbit | ||
366 | f "SS" = ISwarmScope | ||
367 | f "ST" = ISymTorrent | ||
368 | f "st" = Isharktorrent | ||
369 | f "SZ" = IShareaza | ||
370 | f "TN" = ITorrentDotNET | ||
371 | f "TR" = ITransmission | ||
372 | f "TS" = ITorrentstorm | ||
373 | f "TT" = ITuoTu | ||
374 | f "UL" = IuLeecher | ||
375 | f "UT" = IuTorrent | ||
376 | f "VG" = IVagaa | ||
377 | f "WT" = IBitLet | ||
378 | f "WY" = IFireTorrent | ||
379 | f "XL" = IXunlei | ||
380 | f "XT" = IXanTorrent | ||
381 | f "XX" = IXtorrent | ||
382 | f "ZT" = IZipTorrent | ||
383 | f _ = IUnknown | ||
384 | |||
385 | -- | Format client implementation info in human readable form. | ||
386 | ppClientImpl :: ClientImpl -> Doc | ||
387 | ppClientImpl = text . tail . show | ||
388 | |||
389 | -- | Used to represent not recognized implementation | ||
390 | unknownImpl :: ClientImpl | ||
391 | unknownImpl = IUnknown | ||
392 | |||
393 | -- TODO use Data.Version | ||
394 | |||
395 | -- | Raw version of client, normally extracted from peer id. | ||
396 | type ClientVersion = ByteString | ||
397 | |||
398 | -- | Format client implementation version in human readable form. | ||
399 | ppClientVersion :: ClientVersion -> Doc | ||
400 | ppClientVersion = text . BC.unpack | ||
401 | |||
402 | unknownVersion :: ClientVersion | ||
403 | unknownVersion = "0000" | ||
404 | |||
405 | |||
406 | -- | All useful infomation that can be obtained from a peer | ||
407 | -- identifier. | ||
408 | data ClientInfo = ClientInfo { | ||
409 | ciImpl :: ClientImpl | ||
410 | , ciVersion :: ClientVersion | ||
411 | } deriving (Show, Eq, Ord) | ||
412 | |||
413 | -- | Format client implementation in human readable form. | ||
414 | ppClientInfo :: ClientInfo -> Doc | ||
415 | ppClientInfo ClientInfo {..} = | ||
416 | ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion | ||
417 | |||
418 | |||
419 | -- | Unrecognized client implementation. | ||
420 | unknownClient :: ClientInfo | ||
421 | unknownClient = ClientInfo unknownImpl unknownVersion | ||
422 | |||
423 | -- | Tries to extract meaningful information from peer ID bytes. If | ||
424 | -- peer id uses unknown coding style then client info returned is | ||
425 | -- 'unknownClient'. | ||
426 | -- | ||
427 | clientInfo :: PeerId -> ClientInfo | ||
428 | clientInfo pid = either (const unknownClient) id $ | ||
429 | runGet getCI (getPeerId pid) | ||
430 | where -- TODO other styles | ||
431 | getCI = do | ||
432 | _ <- getWord8 | ||
433 | ClientInfo <$> (parseImpl <$> getByteString 2) <*> getByteString 4 | ||
434 | |||
435 | |||
436 | {- | ||
437 | -- code used for generation; remove it later on | ||
438 | |||
439 | mkEnumTyDef :: NM -> String | ||
440 | mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd | ||
441 | |||
442 | mkPars :: NM -> String | ||
443 | mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl) | ||
444 | |||
445 | type NM = [(String, String)] | ||
446 | nameMap :: NM | ||
447 | nameMap = | ||
448 | [ ("AG", "Ares") | ||
449 | , ("A~", "Ares") | ||
450 | , ("AR", "Arctic") | ||
451 | , ("AV", "Avicora") | ||
452 | , ("AX", "BitPump") | ||
453 | , ("AZ", "Azureus") | ||
454 | , ("BB", "BitBuddy") | ||
455 | , ("BC", "BitComet") | ||
456 | , ("BF", "Bitflu") | ||
457 | , ("BG", "BTG") | ||
458 | , ("BR", "BitRocket") | ||
459 | , ("BS", "BTSlave") | ||
460 | , ("BX", "BittorrentX") | ||
461 | , ("CD", "EnhancedCTorrent") | ||
462 | , ("CT", "CTorrent") | ||
463 | , ("DE", "DelugeTorrent") | ||
464 | , ("DP", "PropagateDataClient") | ||
465 | , ("EB", "EBit") | ||
466 | , ("ES", "ElectricSheep") | ||
467 | , ("FT", "FoxTorrent") | ||
468 | , ("GS", "GSTorrent") | ||
469 | , ("HL", "Halite") | ||
470 | , ("HS", "libHSnetwork_bittorrent") | ||
471 | , ("HN", "Hydranode") | ||
472 | , ("KG", "KGet") | ||
473 | , ("KT", "KTorrent") | ||
474 | , ("LH", "LH_ABC") | ||
475 | , ("LP", "Lphant") | ||
476 | , ("LT", "Libtorrent") | ||
477 | , ("lt", "LibTorrent") | ||
478 | , ("LW", "LimeWire") | ||
479 | , ("MO", "MonoTorrent") | ||
480 | , ("MP", "MooPolice") | ||
481 | , ("MR", "Miro") | ||
482 | , ("MT", "MoonlightTorrent") | ||
483 | , ("NX", "NetTransport") | ||
484 | , ("PD", "Pando") | ||
485 | , ("qB", "qBittorrent") | ||
486 | , ("QD", "QQDownload") | ||
487 | , ("QT", "Qt4TorrentExample") | ||
488 | , ("RT", "Retriever") | ||
489 | , ("S~", "Shareaza") | ||
490 | , ("SB", "Swiftbit") | ||
491 | , ("SS", "SwarmScope") | ||
492 | , ("ST", "SymTorrent") | ||
493 | , ("st", "sharktorrent") | ||
494 | , ("SZ", "Shareaza") | ||
495 | , ("TN", "TorrentDotNET") | ||
496 | , ("TR", "Transmission") | ||
497 | , ("TS", "Torrentstorm") | ||
498 | , ("TT", "TuoTu") | ||
499 | , ("UL", "uLeecher") | ||
500 | , ("UT", "uTorrent") | ||
501 | , ("VG", "Vagaa") | ||
502 | , ("WT", "BitLet") | ||
503 | , ("WY", "FireTorrent") | ||
504 | , ("XL", "Xunlei") | ||
505 | , ("XT", "XanTorrent") | ||
506 | , ("XX", "Xtorrent") | ||
507 | , ("ZT", "ZipTorrent") | ||
508 | ] | ||
509 | -} | ||
510 | |||
511 | {----------------------------------------------------------------------- | ||
512 | Peer address | ||
513 | -----------------------------------------------------------------------} | ||
514 | deriving instance ToJSON PortNumber | ||
515 | deriving instance FromJSON PortNumber | ||
516 | |||
517 | instance BEncodable PortNumber where | ||
518 | toBEncode = toBEncode . fromEnum | ||
519 | fromBEncode b = toEnum <$> fromBEncode b | ||
520 | |||
521 | instance Serialize PortNumber where | ||
522 | get = fromIntegral <$> getWord16be | ||
523 | {-# INLINE get #-} | ||
524 | put = putWord16be . fromIntegral | ||
525 | {-# INLINE put #-} | ||
526 | |||
527 | -- TODO check semantic of ord and eq instances | ||
528 | |||
529 | |||
530 | -- | Peer address info normally extracted from peer list or peer | ||
531 | -- compact list encoding. | ||
532 | data PeerAddr = PeerAddr { | ||
533 | peerID :: Maybe PeerId | ||
534 | , peerIP :: {-# UNPACK #-} !HostAddress | ||
535 | , peerPort :: {-# UNPACK #-} !PortNumber | ||
536 | } deriving (Show, Eq, Ord) | ||
537 | |||
538 | $(deriveJSON (L.map toLower . L.dropWhile isLower) ''PeerAddr) | ||
539 | |||
540 | instance BEncodable PeerAddr where | ||
541 | toBEncode (PeerAddr pid pip pport) = fromAssocs | ||
542 | [ "peer id" -->? pid | ||
543 | , "ip" --> pip | ||
544 | , "port" --> pport | ||
545 | ] | ||
546 | |||
547 | fromBEncode (BDict d) = | ||
548 | PeerAddr <$> d >--? "peer id" | ||
549 | <*> d >-- "ip" | ||
550 | <*> d >-- "port" | ||
551 | |||
552 | fromBEncode _ = decodingError "PeerAddr" | ||
553 | |||
554 | instance Serialize PeerAddr where | ||
555 | put PeerAddr {..} = put peerID >> put peerPort | ||
556 | {-# INLINE put #-} | ||
557 | get = PeerAddr Nothing <$> get <*> get | ||
558 | {-# INLINE get #-} | ||
559 | |||
560 | getCompactPeerList :: Get [PeerAddr] | ||
561 | getCompactPeerList = many get | ||
562 | |||
563 | -- TODO make platform independent, clarify htonl | ||
564 | |||
565 | -- | Convert peer info from tracker response to socket address. Used | ||
566 | -- for establish connection between peers. | ||
567 | -- | ||
568 | peerSockAddr :: PeerAddr -> SockAddr | ||
569 | peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP) | ||
570 | where | ||
571 | htonl :: Word32 -> Word32 | ||
572 | htonl d = | ||
573 | ((d .&. 0xff) `shiftL` 24) .|. | ||
574 | (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|. | ||
575 | (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|. | ||
576 | ((d `shiftR` 24) .&. 0xff) | ||
577 | |||
578 | g :: PortNumber -> PortNumber | ||
579 | g = id | ||
580 | |||
581 | -- | Tries to connect to peer using reasonable default parameters. | ||
582 | connectToPeer :: PeerAddr -> IO Socket | ||
583 | connectToPeer p = do | ||
584 | sock <- socket AF_INET Stream Network.Socket.defaultProtocol | ||
585 | connect sock (peerSockAddr p) | ||
586 | return sock | ||
587 | |||
588 | -- | Pretty print peer address in human readable form. | ||
589 | ppPeer :: PeerAddr -> Doc | ||
590 | ppPeer p @ PeerAddr {..} = case peerID of | ||
591 | Just pid -> ppClientInfo (clientInfo pid) <+> "at" <+> paddr | ||
592 | Nothing -> paddr | ||
593 | where | ||
594 | paddr = text (show (peerSockAddr p)) | ||
595 | |||
596 | {----------------------------------------------------------------------- | ||
597 | Progress | ||
598 | -----------------------------------------------------------------------} | ||
599 | |||
600 | -- TODO: Use Word64? | ||
601 | -- TODO: Use atomic bits? | ||
602 | |||
603 | -- | 'Progress' contains upload/download/left stats about | ||
604 | -- current client state and used to notify the tracker. | ||
605 | -- | ||
606 | -- Progress data is considered as dynamic within one client | ||
607 | -- session. This data also should be shared across client application | ||
608 | -- sessions (e.g. files), otherwise use 'startProgress' to get initial | ||
609 | -- 'Progress'. | ||
610 | -- | ||
611 | data Progress = Progress | ||
612 | { _downloaded :: !Integer -- ^ Total amount of bytes downloaded; | ||
613 | , _left :: !Integer -- ^ Total amount of bytes left; | ||
614 | , _uploaded :: !Integer -- ^ Total amount of bytes uploaded. | ||
615 | } deriving (Show, Read, Eq) | ||
616 | |||
617 | $(makeLenses ''Progress) | ||
618 | $(deriveJSON (L.tail) ''Progress) | ||
619 | |||
620 | instance Serialize Progress where | ||
621 | put Progress {..} = do | ||
622 | putWord64be $ fromIntegral _downloaded | ||
623 | putWord64be $ fromIntegral _left | ||
624 | putWord64be $ fromIntegral _uploaded | ||
625 | |||
626 | get = Progress | ||
627 | <$> (fromIntegral <$> getWord64be) | ||
628 | <*> (fromIntegral <$> getWord64be) | ||
629 | <*> (fromIntegral <$> getWord64be) | ||
630 | |||
631 | -- | Initial progress is used when there are no session before. | ||
632 | -- | ||
633 | -- Please note that tracker might penalize client some way if the do | ||
634 | -- not accumulate progress. If possible and save 'Progress' between | ||
635 | -- client sessions to avoid that. | ||
636 | -- | ||
637 | startProgress :: Integer -> Progress | ||
638 | startProgress = Progress 0 0 | ||
639 | |||
640 | -- | Used when the client download some data from /any/ peer. | ||
641 | downloadedProgress :: Int -> Progress -> Progress | ||
642 | downloadedProgress (fromIntegral -> amount) | ||
643 | = (left -~ amount) | ||
644 | . (downloaded +~ amount) | ||
645 | {-# INLINE downloadedProgress #-} | ||
646 | |||
647 | -- | Used when the client upload some data to /any/ peer. | ||
648 | uploadedProgress :: Int -> Progress -> Progress | ||
649 | uploadedProgress (fromIntegral -> amount) = uploaded +~ amount | ||
650 | {-# INLINE uploadedProgress #-} | ||
651 | |||
652 | -- | Used when leecher join client session. | ||
653 | enqueuedProgress :: Integer -> Progress -> Progress | ||
654 | enqueuedProgress amount = left +~ amount | ||
655 | {-# INLINE enqueuedProgress #-} | ||
656 | |||
657 | -- | Used when leecher leave client session. | ||
658 | -- (e.g. user deletes not completed torrent) | ||
659 | dequeuedProgress :: Integer -> Progress -> Progress | ||
660 | dequeuedProgress amount = left -~ amount | ||
661 | {-# INLINE dequeuedProgress #-} | ||