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 /src/Data/Torrent | |
parent | c45c87c587046fcc7f2656bc1eb7302286c0ef96 (diff) |
Refactor Network.BitTorrent.Peer module
Diffstat (limited to 'src/Data/Torrent')
-rw-r--r-- | src/Data/Torrent/Client.hs | 233 | ||||
-rw-r--r-- | src/Data/Torrent/Progress.hs | 95 |
2 files changed, 328 insertions, 0 deletions
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 #-} | ||