summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal4
-rw-r--r--src/Network/BitTorrent/Core/Fingerprint.hs32
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs2
-rw-r--r--src/Network/BitTorrent/Core/PeerId.hs20
-rw-r--r--src/Network/BitTorrent/Exchange/Message.hs2
-rw-r--r--tests/Data/Torrent/ClientSpec.hs33
-rw-r--r--tests/Network/BitTorrent/Core/FingerprintSpec.hs33
7 files changed, 63 insertions, 63 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index afd9edb0..6743e2e4 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -151,14 +151,14 @@ test-suite spec
151 type: exitcode-stdio-1.0 151 type: exitcode-stdio-1.0
152 hs-source-dirs: tests 152 hs-source-dirs: tests
153 main-is: Spec.hs 153 main-is: Spec.hs
154 other-modules: Data.Torrent.ClientSpec 154 other-modules: Data.Torrent.InfoHashSpec
155 Data.Torrent.InfoHashSpec
156 Data.Torrent.LayoutSpec 155 Data.Torrent.LayoutSpec
157 Data.Torrent.MagnetSpec 156 Data.Torrent.MagnetSpec
158 Data.Torrent.MetainfoSpec 157 Data.Torrent.MetainfoSpec
159 Data.Torrent.ProgressSpec 158 Data.Torrent.ProgressSpec
160 Network.BitTorrent.CoreSpec 159 Network.BitTorrent.CoreSpec
161 Network.BitTorrent.Core.PeerIdSpec 160 Network.BitTorrent.Core.PeerIdSpec
161 Network.BitTorrent.Core.FingerprintSpec
162 Network.BitTorrent.Tracker.MessageSpec 162 Network.BitTorrent.Tracker.MessageSpec
163 Network.BitTorrent.Tracker.RPC.HTTPSpec 163 Network.BitTorrent.Tracker.RPC.HTTPSpec
164 Network.BitTorrent.Tracker.RPC.UDPSpec 164 Network.BitTorrent.Tracker.RPC.UDPSpec
diff --git a/src/Network/BitTorrent/Core/Fingerprint.hs b/src/Network/BitTorrent/Core/Fingerprint.hs
index e2fbb777..a81edd8b 100644
--- a/src/Network/BitTorrent/Core/Fingerprint.hs
+++ b/src/Network/BitTorrent/Core/Fingerprint.hs
@@ -5,7 +5,7 @@
5-- Stability : experimental 5-- Stability : experimental
6-- Portability : portable 6-- Portability : portable
7-- 7--
8-- 'ClientInfo' is used to identify the client implementation and 8-- 'Fingerprint' is used to identify the client implementation and
9-- version which also contained in 'Peer'. For exsample first 6 9-- version which also contained in 'Peer'. For exsample first 6
10-- bytes of peer id of this this library are @-HS0100-@ while for 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 11-- mainline we have @M4-3-6--@. We could extract this info and
@@ -23,8 +23,8 @@
23{-# OPTIONS -fno-warn-orphans #-} 23{-# OPTIONS -fno-warn-orphans #-}
24module Network.BitTorrent.Core.Fingerprint 24module Network.BitTorrent.Core.Fingerprint
25 ( ClientImpl (..) 25 ( ClientImpl (..)
26 , ClientInfo (..) 26 , Fingerprint (..)
27 , libClientInfo 27 , libFingerprint
28 ) where 28 ) where
29 29
30import Data.Default 30import Data.Default
@@ -162,33 +162,33 @@ instance Pretty Version where
162 162
163-- | The all sensible infomation that can be obtained from a peer 163-- | The all sensible infomation that can be obtained from a peer
164-- identifier or torrent /createdBy/ field. 164-- identifier or torrent /createdBy/ field.
165data ClientInfo = ClientInfo { 165data Fingerprint = Fingerprint
166 ciImpl :: ClientImpl 166 { ciImpl :: ClientImpl
167 , ciVersion :: Version 167 , ciVersion :: Version
168 } deriving (Show, Eq, Ord) 168 } deriving (Show, Eq, Ord)
169 169
170-- | Unrecognized client implementation. 170-- | Unrecognized client implementation.
171instance Default ClientInfo where 171instance Default Fingerprint where
172 def = ClientInfo def def 172 def = Fingerprint def def
173 {-# INLINE def #-} 173 {-# INLINE def #-}
174 174
175-- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@ 175-- | Example: @\"BitComet-1.2\" == ClientInfo IBitComet (Version [1, 2] [])@
176instance IsString ClientInfo where 176instance IsString Fingerprint where
177 fromString str 177 fromString str
178 | _ : ver <- _ver = ClientInfo (fromString impl) (fromString ver) 178 | _ : ver <- _ver = Fingerprint (fromString impl) (fromString ver)
179 | otherwise = error $ "fromString: invalid client info string" ++ str 179 | otherwise = error $ "fromString: invalid client info string" ++ str
180 where 180 where
181 (impl, _ver) = L.span ((/=) '-') str 181 (impl, _ver) = L.span ((/=) '-') str
182 182
183instance Pretty ClientInfo where 183instance Pretty Fingerprint where
184 pretty ClientInfo {..} = pretty ciImpl <+> "version" <+> pretty ciVersion 184 pretty Fingerprint {..} = pretty ciImpl <+> "version" <+> pretty ciVersion
185 185
186-- | Client info of this (the bittorrent library) package. Normally, 186-- | Fingerprint of this (the bittorrent library) package. Normally,
187-- applications should introduce its own idenitifiers, otherwise they 187-- applications should introduce its own fingerprints, otherwise they
188-- can use 'libClientInfo' value. 188-- can use 'libFingerprint' value.
189-- 189--
190libClientInfo :: ClientInfo 190libFingerprint :: Fingerprint
191libClientInfo = ClientInfo IlibHSbittorrent version 191libFingerprint = Fingerprint IlibHSbittorrent version
192 192
193{----------------------------------------------------------------------- 193{-----------------------------------------------------------------------
194-- For torrent file 194-- For torrent file
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 81754e5e..5173c4fc 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -89,7 +89,7 @@ instance Serialize PeerAddr where
89 89
90instance Pretty PeerAddr where 90instance Pretty PeerAddr where
91 pretty p @ PeerAddr {..} 91 pretty p @ PeerAddr {..}
92 | Just pid <- peerID = pretty (clientInfo pid) <+> "at" <+> paddr 92 | Just pid <- peerID = pretty (fingerprint pid) <+> "at" <+> paddr
93 | otherwise = paddr 93 | otherwise = paddr
94 where 94 where
95 paddr = text (show (peerSockAddr p)) 95 paddr = text (show (peerSockAddr p))
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index 8deb854a..f30308d4 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -30,7 +30,7 @@ module Network.BitTorrent.Core.PeerId
30 , defaultVersionNumber 30 , defaultVersionNumber
31 31
32 -- * Decoding 32 -- * Decoding
33 , clientInfo 33 , fingerprint
34 ) where 34 ) where
35 35
36import Control.Applicative 36import Control.Applicative
@@ -175,7 +175,7 @@ defaultClientId = "HS"
175-- package. Version is taken from .cabal file. 175-- package. Version is taken from .cabal file.
176defaultVersionNumber :: ByteString 176defaultVersionNumber :: ByteString
177defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $ 177defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $
178 versionBranch $ ciVersion libClientInfo 178 versionBranch $ ciVersion libFingerprint
179 179
180{----------------------------------------------------------------------- 180{-----------------------------------------------------------------------
181-- Generation 181-- Generation
@@ -294,23 +294,23 @@ parseImpl = f . BC.unpack
294-- peer id uses unknown coding style then client info returned is 294-- peer id uses unknown coding style then client info returned is
295-- 'def'. 295-- 'def'.
296-- 296--
297clientInfo :: PeerId -> ClientInfo 297fingerprint :: PeerId -> Fingerprint
298clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid) 298fingerprint pid = either (const def) id $ runGet getCI (getPeerId pid)
299 where 299 where
300 getCI = do 300 getCI = do
301 leading <- BS.w2c <$> getWord8 301 leading <- BS.w2c <$> getWord8
302 case leading of 302 case leading of
303 '-' -> ClientInfo <$> getAzureusImpl <*> getAzureusVersion 303 '-' -> Fingerprint <$> getAzureusImpl <*> getAzureusVersion
304 'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion 304 'M' -> Fingerprint <$> pure IMainline <*> getMainlineVersion
305 'e' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion 305 'e' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
306 'F' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion 306 'F' -> Fingerprint <$> getBitCometImpl <*> getBitCometVersion
307 c -> do 307 c -> do
308 c1 <- w2c <$> lookAhead getWord8 308 c1 <- w2c <$> lookAhead getWord8
309 if c1 == 'P' 309 if c1 == 'P'
310 then do 310 then do
311 _ <- getWord8 311 _ <- getWord8
312 ClientInfo <$> pure IOpera <*> getOperaVersion 312 Fingerprint <$> pure IOpera <*> getOperaVersion
313 else ClientInfo <$> pure (getShadowImpl c) <*> getShadowVersion 313 else Fingerprint <$> pure (getShadowImpl c) <*> getShadowVersion
314 314
315 getMainlineVersion = do 315 getMainlineVersion = do
316 str <- BC.unpack <$> getByteString 7 316 str <- BC.unpack <$> getByteString 7
diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs
index 8a88b761..85ad76d6 100644
--- a/src/Network/BitTorrent/Exchange/Message.hs
+++ b/src/Network/BitTorrent/Exchange/Message.hs
@@ -203,7 +203,7 @@ instance Serialize Handshake where
203 203
204instance Pretty Handshake where 204instance Pretty Handshake where
205 pretty Handshake {..} 205 pretty Handshake {..}
206 = text (BC.unpack hsProtocol) <+> pretty (clientInfo hsPeerId) 206 = text (BC.unpack hsProtocol) <+> pretty (fingerprint hsPeerId)
207 207
208-- | Get handshake message size in bytes from the length of protocol 208-- | Get handshake message size in bytes from the length of protocol
209-- string. 209-- string.
diff --git a/tests/Data/Torrent/ClientSpec.hs b/tests/Data/Torrent/ClientSpec.hs
deleted file mode 100644
index 4bc881c3..00000000
--- a/tests/Data/Torrent/ClientSpec.hs
+++ /dev/null
@@ -1,33 +0,0 @@
1-- | see <http://bittorrent.org/beps/bep_0020.html>
2module Data.Torrent.ClientSpec (spec) where
3import Test.Hspec
4import Network.BitTorrent.Core.PeerId
5
6spec :: Spec
7spec = do
8 describe "client info" $ do
9 it "decode mainline encoded peer id" $ do
10 clientInfo "M4-3-6--xxxxxxxxxxxx" `shouldBe` "Mainline-4.3.6"
11 clientInfo "M4-20-8-xxxxxxxxxxxx" `shouldBe` "Mainline-4.20.8"
12
13 it "decode azureus encoded peer id" $ do
14 clientInfo "-AZ2060-xxxxxxxxxxxx" `shouldBe` "Azureus-2060"
15 clientInfo "-BS0000-xxxxxxxxxxxx" `shouldBe` "BTSlave-0"
16
17 it "decode Shad0w style peer id" $ do
18 clientInfo "S58B-----xxxxxxxxxxx" `shouldBe` "Shadow-5.8.11"
19 clientInfo "T58B-----xxxxxxxxxxx" `shouldBe` "BitTornado-5.8.11"
20
21 it "decode bitcomet style peer id" $ do
22 clientInfo "exbc01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
23 clientInfo "FUTB01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
24 clientInfo "exbc01LORDxxxxxxxxxx" `shouldBe` "BitLord-48.49"
25
26 it "decode opera style peer id" $ do
27 clientInfo "OP0123xxxxxxxxxxxxxx" `shouldBe` "Opera-123"
28
29 it "decode ML donkey style peer id" $ do
30 clientInfo "-ML2.7.2-xxxxxxxxxxx" `shouldBe` "MLdonkey-0"
31
32-- TODO XBT, Bits on Wheels, Queen Bee, BitTyrant, TorrenTopia,
33-- BitSpirit, Rufus, G3 Torrent, FlashGet \ No newline at end of file
diff --git a/tests/Network/BitTorrent/Core/FingerprintSpec.hs b/tests/Network/BitTorrent/Core/FingerprintSpec.hs
new file mode 100644
index 00000000..df62442a
--- /dev/null
+++ b/tests/Network/BitTorrent/Core/FingerprintSpec.hs
@@ -0,0 +1,33 @@
1-- | see <http://bittorrent.org/beps/bep_0020.html>
2module Network.BitTorrent.Core.FingerprintSpec (spec) where
3import Test.Hspec
4import Network.BitTorrent.Core.PeerId
5
6spec :: Spec
7spec = do
8 describe "client info" $ do
9 it "decode mainline encoded peer id" $ do
10 fingerprint "M4-3-6--xxxxxxxxxxxx" `shouldBe` "Mainline-4.3.6"
11 fingerprint "M4-20-8-xxxxxxxxxxxx" `shouldBe` "Mainline-4.20.8"
12
13 it "decode azureus encoded peer id" $ do
14 fingerprint "-AZ2060-xxxxxxxxxxxx" `shouldBe` "Azureus-2060"
15 fingerprint "-BS0000-xxxxxxxxxxxx" `shouldBe` "BTSlave-0"
16
17 it "decode Shad0w style peer id" $ do
18 fingerprint "S58B-----xxxxxxxxxxx" `shouldBe` "Shadow-5.8.11"
19 fingerprint "T58B-----xxxxxxxxxxx" `shouldBe` "BitTornado-5.8.11"
20
21 it "decode bitcomet style peer id" $ do
22 fingerprint "exbc01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
23 fingerprint "FUTB01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
24 fingerprint "exbc01LORDxxxxxxxxxx" `shouldBe` "BitLord-48.49"
25
26 it "decode opera style peer id" $ do
27 fingerprint "OP0123xxxxxxxxxxxxxx" `shouldBe` "Opera-123"
28
29 it "decode ML donkey style peer id" $ do
30 fingerprint "-ML2.7.2-xxxxxxxxxxx" `shouldBe` "MLdonkey-0"
31
32-- TODO XBT, Bits on Wheels, Queen Bee, BitTyrant, TorrenTopia,
33-- BitSpirit, Rufus, G3 Torrent, FlashGet \ No newline at end of file