summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Data/Torrent/Client.hs1
-rw-r--r--src/Network/BitTorrent/Core/PeerId.hs14
-rw-r--r--tests/Data/Torrent/ClientSpec.hs5
3 files changed, 18 insertions, 2 deletions
diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index 7b178d41..10671a44 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -63,6 +63,7 @@ data ClientImpl =
63-- UPnP(!) Bit Torrent !??? 63-- UPnP(!) Bit Torrent !???
64-- 'U' - UPnP NAT Bit Torrent 64-- 'U' - UPnP NAT Bit Torrent
65 | IBitLord 65 | IBitLord
66 | IOpera
66 67
67 | IAres 68 | IAres
68 | IArctic 69 | IArctic
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index b8dd17e2..3e6fac24 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -275,6 +275,8 @@ parseImpl = f . BC.unpack
275 f "ZT" = IZipTorrent 275 f "ZT" = IZipTorrent
276 f _ = IUnknown 276 f _ = IUnknown
277 277
278-- TODO use regexps
279
278-- | Tries to extract meaningful information from peer ID bytes. If 280-- | Tries to extract meaningful information from peer ID bytes. If
279-- peer id uses unknown coding style then client info returned is 281-- peer id uses unknown coding style then client info returned is
280-- 'def'. 282-- 'def'.
@@ -289,7 +291,13 @@ clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
289 'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion 291 'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion
290 'e' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion 292 'e' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion
291 'F' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion 293 'F' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion
292 c -> ClientInfo <$> pure (getShadowImpl c) <*> getShadowVersion 294 c -> do
295 c1 <- w2c <$> lookAhead getWord8
296 if c1 == 'P'
297 then do
298 _ <- getWord8
299 ClientInfo <$> pure IOpera <*> getOperaVersion
300 else ClientInfo <$> pure (getShadowImpl c) <*> getShadowVersion
293 301
294 getMainlineVersion = do 302 getMainlineVersion = do
295 str <- BC.unpack <$> getByteString 7 303 str <- BC.unpack <$> getByteString 7
@@ -316,6 +324,10 @@ clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
316 y <- getWord8 324 y <- getWord8
317 return $ Version [fromIntegral x, fromIntegral y] [] 325 return $ Version [fromIntegral x, fromIntegral y] []
318 326
327 getOperaVersion = do
328 str <- BC.unpack <$> getByteString 4
329 return $ Version [fromMaybe 0 $ readMaybe str] []
330
319 getShadowImpl 'A' = IABC 331 getShadowImpl 'A' = IABC
320 getShadowImpl 'O' = IOspreyPermaseed 332 getShadowImpl 'O' = IOspreyPermaseed
321 getShadowImpl 'Q' = IBTQueue 333 getShadowImpl 'Q' = IBTQueue
diff --git a/tests/Data/Torrent/ClientSpec.hs b/tests/Data/Torrent/ClientSpec.hs
index 8b3e7342..f1fa2c03 100644
--- a/tests/Data/Torrent/ClientSpec.hs
+++ b/tests/Data/Torrent/ClientSpec.hs
@@ -21,4 +21,7 @@ spec = do
21 it "decode bitcomet style peer id" $ do 21 it "decode bitcomet style peer id" $ do
22 clientInfo "exbc01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49" 22 clientInfo "exbc01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
23 clientInfo "FUTB01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49" 23 clientInfo "FUTB01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
24 clientInfo "exbc01LORDxxxxxxxxxx" `shouldBe` "BitLord-48.49" \ No newline at end of file 24 clientInfo "exbc01LORDxxxxxxxxxx" `shouldBe` "BitLord-48.49"
25
26 it "decode opera style peer id" $ do
27 clientInfo "OP0123xxxxxxxxxxxxxx" `shouldBe` "Opera-123"