summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Data/Torrent/Client.hs233
-rw-r--r--src/Data/Torrent/Progress.hs95
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs119
-rw-r--r--src/Network/BitTorrent/Core/PeerId.hs278
-rw-r--r--src/Network/BitTorrent/Peer.hs661
5 files changed, 725 insertions, 661 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--
19module Data.Torrent.Client
20 ( ClientImpl (..)
21 , ppClientImpl
22
23 , ClientVersion (..)
24 , ppClientVersion
25
26 , ClientInfo (..)
27 , ppClientInfo
28 , libClientInfo
29 ) where
30
31import Control.Applicative
32import Data.ByteString as BS
33import Data.ByteString.Char8 as BC
34import Data.Default
35import Data.List as L
36import Data.Monoid
37import Data.Text as T
38import Data.Version
39import Text.PrettyPrint hiding ((<>))
40import Paths_bittorrent (version)
41
42
43-- | All known client versions.
44data 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
107instance Default ClientImpl where
108 def = IUnknown
109
110-- | Format client implementation info in human readable form.
111ppClientImpl :: ClientImpl -> Doc
112ppClientImpl = text . L.tail . show
113
114-- | Raw version of client, normally extracted from peer id.
115newtype ClientVersion = ClientVersion { getClientVersion :: Version }
116 deriving (Show, Eq, Ord)
117
118instance Default ClientVersion where
119 def = ClientVersion $ Version [0] []
120
121-- | Format client implementation version in human readable form.
122ppClientVersion :: ClientVersion -> Doc
123ppClientVersion = text . showVersion . getClientVersion
124
125-- | All useful infomation that can be obtained from a peer
126-- identifier.
127data ClientInfo = ClientInfo {
128 ciImpl :: ClientImpl
129 , ciVersion :: ClientVersion
130 } deriving (Show, Eq, Ord)
131
132-- | Unrecognized client implementation.
133instance Default ClientInfo where
134 def = ClientInfo def def
135
136-- | Format client implementation in human readable form.
137ppClientInfo :: ClientInfo -> Doc
138ppClientInfo ClientInfo {..} =
139 ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
140
141libClientInfo :: ClientInfo
142libClientInfo = ClientInfo IlibHSbittorrent (ClientVersion version)
143
144{-----------------------------------------------------------------------
145-- For torrent file
146-----------------------------------------------------------------------}
147
148renderImpl :: ClientImpl -> Text
149renderImpl = T.pack . L.tail . show
150
151renderVersion :: ClientVersion -> Text
152renderVersion = undefined
153
154renderClientInfo :: ClientInfo -> Text
155renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion
156
157parseClientInfo :: Text -> ClientImpl
158parseClientInfo t = undefined
159
160{-
161-- code used for generation; remove it later on
162
163mkEnumTyDef :: NM -> String
164mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
165
166mkPars :: NM -> String
167mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)
168
169type NM = [(String, String)]
170nameMap :: NM
171nameMap =
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 #-}
3module 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
19import Control.Applicative
20import Control.Lens
21import Data.Aeson.TH
22import Data.List as L
23import Data.Default
24import 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--
38data 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
47instance 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
58instance 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--
70startProgress :: Integer -> Progress
71startProgress = Progress 0 0
72{-# INLINE startProgress #-}
73
74-- | Used when the client download some data from /any/ peer.
75downloadedProgress :: Int -> Progress -> Progress
76downloadedProgress (fromIntegral -> amount)
77 = (left -~ amount)
78 . (downloaded +~ amount)
79{-# INLINE downloadedProgress #-}
80
81-- | Used when the client upload some data to /any/ peer.
82uploadedProgress :: Int -> Progress -> Progress
83uploadedProgress (fromIntegral -> amount) = uploaded +~ amount
84{-# INLINE uploadedProgress #-}
85
86-- | Used when leecher join client session.
87enqueuedProgress :: Integer -> Progress -> Progress
88enqueuedProgress amount = left +~ amount
89{-# INLINE enqueuedProgress #-}
90
91-- | Used when leecher leave client session.
92-- (e.g. user deletes not completed torrent)
93dequeuedProgress :: Integer -> Progress -> Progress
94dequeuedProgress 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
16module Network.BitTorrent.Core.PeerAddr
17 ( -- * Peer address
18 PeerAddr(..)
19 , getCompactPeerList
20 , peerSockAddr
21 , connectToPeer
22 , ppPeer
23 ) where
24
25import Control.Applicative
26import Data.Aeson (ToJSON, FromJSON)
27import Data.Aeson.TH
28import Data.BEncode as BS
29import Data.Bits
30import Data.Char
31import Data.List as L
32import Data.Serialize as S
33import Data.Typeable
34import Data.Word
35import Network.Socket
36import Text.PrettyPrint
37
38import Data.Torrent.Client
39import Network.BitTorrent.Core.PeerId
40
41
42deriving instance ToJSON PortNumber
43deriving instance FromJSON PortNumber
44
45instance BEncode PortNumber where
46 toBEncode = toBEncode . fromEnum
47 fromBEncode b = toEnum <$> fromBEncode b
48
49instance 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.
59data 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
67instance 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
79instance Serialize PeerAddr where
80 put PeerAddr {..} = put peerID >> put peerPort
81 {-# INLINE put #-}
82 get = PeerAddr Nothing <$> get <*> get
83 {-# INLINE get #-}
84
85getCompactPeerList :: S.Get [PeerAddr]
86getCompactPeerList = 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--
93peerSockAddr :: PeerAddr -> SockAddr
94peerSockAddr = 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.
107connectToPeer :: PeerAddr -> IO Socket
108connectToPeer 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.
114ppPeer :: PeerAddr -> Doc
115ppPeer 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 #-}
16module 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
39import Control.Applicative
40import Data.Aeson
41import Data.BEncode as BE
42import Data.ByteString as BS
43import Data.ByteString.Char8 as BC
44import qualified Data.ByteString.Lazy as BL
45import qualified Data.ByteString.Lazy.Builder as BS
46import Data.Default
47import Data.Foldable (foldMap)
48import Data.List as L
49import Data.Maybe (fromMaybe)
50import Data.Monoid
51import Data.Serialize as S
52import Data.Time.Clock (getCurrentTime)
53import Data.Time.Format (formatTime)
54import Data.URLEncoded
55import Data.Version (Version(Version), versionBranch)
56import System.Entropy (getEntropy)
57import System.Locale (defaultTimeLocale)
58import Text.PrettyPrint hiding ((<>))
59import Text.Read (readMaybe)
60import Paths_bittorrent (version)
61
62import Data.Torrent.Client
63
64
65-- | Peer identifier is exactly 20 bytes long bytestring.
66newtype PeerId = PeerId { getPeerId :: ByteString }
67 deriving (Show, Eq, Ord, BEncode, ToJSON, FromJSON)
68
69instance Serialize PeerId where
70 put = putByteString . getPeerId
71 get = PeerId <$> getBytes 20
72
73instance URLShow PeerId where
74 urlShow = BC.unpack . getPeerId
75
76-- | Format peer id in human readable form.
77ppPeerId :: PeerId -> Doc
78ppPeerId = 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--
94byteStringPadded :: ByteString -- ^ bytestring to be padded.
95 -> Int -- ^ size of result builder.
96 -> Char -- ^ character used for padding.
97 -> BS.Builder
98byteStringPadded 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--
116azureusStyle :: 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.
120azureusStyle 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--
137shadowStyle :: Char -- ^ Client ID.
138 -> ByteString -- ^ Version number.
139 -> ByteString -- ^ Random number.
140 -> PeerId -- ^ Shadow style encoded peer ID.
141shadowStyle 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.
148defaultClientId :: ByteString
149defaultClientId = "HS"
150
151-- | Gives exactly 4 bytes long version number for any version of the
152-- package. Version is taken from .cabal.
153defaultVersionNumber :: ByteString
154defaultVersionNumber = 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--
174timestamp :: IO ByteString
175timestamp = (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.
182entropy :: IO ByteString
183entropy = 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--
195genPeerId :: IO PeerId
196genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp
197
198{-----------------------------------------------------------------------
199-- Decoding
200-----------------------------------------------------------------------}
201
202parseImpl :: ByteString -> ClientImpl
203parseImpl = 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--
271clientInfo :: PeerId -> ClientInfo
272clientInfo 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 #-}
36module 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
86import Control.Applicative
87import Control.Lens
88import Data.Aeson
89import Data.Aeson.TH
90import Data.BEncode
91import Data.Bits
92import Data.ByteString (ByteString)
93import qualified Data.ByteString as B
94import qualified Data.ByteString.Char8 as BC
95import qualified Data.ByteString.Lazy as BL
96import qualified Data.ByteString.Lazy.Builder as B
97import Data.Char
98import Data.List as L
99import Data.Word
100import Data.Foldable (foldMap)
101import Data.Monoid ((<>))
102import Data.Serialize
103import Data.URLEncoded
104import Data.Version (Version(Version), versionBranch)
105import Data.Time.Clock (getCurrentTime)
106import Data.Time.Format (formatTime)
107import Text.PrettyPrint (text, Doc, (<+>))
108import System.Locale (defaultTimeLocale)
109import System.Entropy (getEntropy)
110import Network hiding (accept)
111import 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
119version :: Version
120version = Version [0, 10, 0, 0] []
121
122{-----------------------------------------------------------------------
123 Peer identification
124-----------------------------------------------------------------------}
125
126-- | Peer identifier is exactly 20 bytes long bytestring.
127newtype PeerId = PeerId { getPeerId :: ByteString }
128 deriving (Show, Eq, Ord, BEncodable, ToJSON, FromJSON)
129
130instance Serialize PeerId where
131 put = putByteString . getPeerId
132 get = PeerId <$> getBytes 20
133
134instance URLShow PeerId where
135 urlShow = BC.unpack . getPeerId
136
137-- | Format peer id in human readable form.
138ppPeerId :: PeerId -> Doc
139ppPeerId = 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--
154azureusStyle :: 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.
158azureusStyle 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--
175shadowStyle :: Char -- ^ Client ID.
176 -> ByteString -- ^ Version number.
177 -> ByteString -- ^ Random number.
178 -> PeerId -- ^ Shadow style encoded peer ID.
179shadowStyle 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.
186defaultClientId :: ByteString
187defaultClientId = "HS"
188
189-- | Gives exactly 4 bytes long version number for any version of the
190-- package. Version is taken from .cabal.
191defaultVersionNumber :: ByteString
192defaultVersionNumber = 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--
208timestamp :: IO ByteString
209timestamp = (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.
216entropy :: IO ByteString
217entropy = 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--
229genPeerId :: IO PeerId
230genPeerId = 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--
242byteStringPadded :: ByteString -- ^ bytestring to be padded.
243 -> Int -- ^ size of result builder.
244 -> Char -- ^ character used for padding.
245 -> B.Builder
246byteStringPadded 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.
258data 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
320parseImpl :: ByteString -> ClientImpl
321parseImpl = 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.
386ppClientImpl :: ClientImpl -> Doc
387ppClientImpl = text . tail . show
388
389-- | Used to represent not recognized implementation
390unknownImpl :: ClientImpl
391unknownImpl = IUnknown
392
393-- TODO use Data.Version
394
395-- | Raw version of client, normally extracted from peer id.
396type ClientVersion = ByteString
397
398-- | Format client implementation version in human readable form.
399ppClientVersion :: ClientVersion -> Doc
400ppClientVersion = text . BC.unpack
401
402unknownVersion :: ClientVersion
403unknownVersion = "0000"
404
405
406-- | All useful infomation that can be obtained from a peer
407-- identifier.
408data ClientInfo = ClientInfo {
409 ciImpl :: ClientImpl
410 , ciVersion :: ClientVersion
411 } deriving (Show, Eq, Ord)
412
413-- | Format client implementation in human readable form.
414ppClientInfo :: ClientInfo -> Doc
415ppClientInfo ClientInfo {..} =
416 ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion
417
418
419-- | Unrecognized client implementation.
420unknownClient :: ClientInfo
421unknownClient = 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--
427clientInfo :: PeerId -> ClientInfo
428clientInfo 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
439mkEnumTyDef :: NM -> String
440mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd
441
442mkPars :: NM -> String
443mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)
444
445type NM = [(String, String)]
446nameMap :: NM
447nameMap =
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-----------------------------------------------------------------------}
514deriving instance ToJSON PortNumber
515deriving instance FromJSON PortNumber
516
517instance BEncodable PortNumber where
518 toBEncode = toBEncode . fromEnum
519 fromBEncode b = toEnum <$> fromBEncode b
520
521instance 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.
532data 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
540instance 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
554instance Serialize PeerAddr where
555 put PeerAddr {..} = put peerID >> put peerPort
556 {-# INLINE put #-}
557 get = PeerAddr Nothing <$> get <*> get
558 {-# INLINE get #-}
559
560getCompactPeerList :: Get [PeerAddr]
561getCompactPeerList = 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--
568peerSockAddr :: PeerAddr -> SockAddr
569peerSockAddr = 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.
582connectToPeer :: PeerAddr -> IO Socket
583connectToPeer 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.
589ppPeer :: PeerAddr -> Doc
590ppPeer 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--
611data 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
620instance 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--
637startProgress :: Integer -> Progress
638startProgress = Progress 0 0
639
640-- | Used when the client download some data from /any/ peer.
641downloadedProgress :: Int -> Progress -> Progress
642downloadedProgress (fromIntegral -> amount)
643 = (left -~ amount)
644 . (downloaded +~ amount)
645{-# INLINE downloadedProgress #-}
646
647-- | Used when the client upload some data to /any/ peer.
648uploadedProgress :: Int -> Progress -> Progress
649uploadedProgress (fromIntegral -> amount) = uploaded +~ amount
650{-# INLINE uploadedProgress #-}
651
652-- | Used when leecher join client session.
653enqueuedProgress :: Integer -> Progress -> Progress
654enqueuedProgress amount = left +~ amount
655{-# INLINE enqueuedProgress #-}
656
657-- | Used when leecher leave client session.
658-- (e.g. user deletes not completed torrent)
659dequeuedProgress :: Integer -> Progress -> Progress
660dequeuedProgress amount = left -~ amount
661{-# INLINE dequeuedProgress #-}
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 18:39:45 +0000