From 0d45d13454644224d6eb461225ef938b84adab6a Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Sat, 23 Nov 2013 04:54:37 +0400
Subject: Decode shadow style de peer Ids

---
 src/Data/Torrent/Client.hs            | 12 ++++++++++++
 src/Network/BitTorrent/Core/PeerId.hs | 23 +++++++++++++++++++++--
 tests/Data/Torrent/ClientSpec.hs      |  9 +++++----
 3 files changed, 38 insertions(+), 6 deletions(-)

diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index 079b63c1..1b24105f 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -50,7 +50,19 @@ import Paths_bittorrent (version)
 --
 data ClientImpl =
    IUnknown
+
  | IMainline
+
+ | IABC
+ | IOspreyPermaseed
+ | IBTQueue
+ | ITribler
+ | IShadow
+ | IBitTornado
+
+-- UPnP(!) Bit Torrent !???
+-- 'U' - UPnP NAT Bit Torrent
+
  | IAres
  | IArctic
  | IAvicora
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index 75a4d7a0..5962a6e5 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -47,7 +47,7 @@ import Data.Default
 import Data.Foldable    (foldMap)
 import Data.List as L
 import Data.List.Split as L
-import Data.Maybe       (fromMaybe)
+import Data.Maybe       (fromMaybe, catMaybes)
 import Data.Monoid
 import Data.Serialize as S
 import Data.String
@@ -287,7 +287,7 @@ clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
       case leading of
         '-' -> ClientInfo <$> getAzureusImpl <*> getAzureusVersion
         'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion
-        _   -> pure def
+        c   -> ClientInfo <$> pure (getShadowImpl c) <*> getShadowVersion
 
     getMainlineVersion = do
       str <- BC.unpack <$> getByteString 7
@@ -298,3 +298,22 @@ clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
     getAzureusVersion = mkVer     <$> getByteString 4
       where
         mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
+
+    getShadowImpl 'A' = IABC
+    getShadowImpl 'O' = IOspreyPermaseed
+    getShadowImpl 'Q' = IBTQueue
+    getShadowImpl 'R' = ITribler
+    getShadowImpl 'S' = IShadow
+    getShadowImpl 'T' = IBitTornado
+    getShadowImpl  _  = IUnknown
+
+    decodeShadowVerNr :: Char -> Maybe Int
+    decodeShadowVerNr c
+      | '0' < c && c <= '9' = Just  (fromEnum c - fromEnum '0')
+      | 'A' < c && c <= 'Z' = Just ((fromEnum c - fromEnum 'A') + 10)
+      | 'a' < c && c <= 'z' = Just ((fromEnum c - fromEnum 'a') + 36)
+      |        otherwise    = Nothing
+
+    getShadowVersion = do
+      str <- BC.unpack <$> getByteString 5
+      return $ Version (catMaybes $ L.map decodeShadowVerNr str) []
diff --git a/tests/Data/Torrent/ClientSpec.hs b/tests/Data/Torrent/ClientSpec.hs
index 94335ae9..c4c08798 100644
--- a/tests/Data/Torrent/ClientSpec.hs
+++ b/tests/Data/Torrent/ClientSpec.hs
@@ -1,9 +1,6 @@
+-- | see <http://bittorrent.org/beps/bep_0020.html>
 module Data.Torrent.ClientSpec (spec) where
-
-import Data.Version
 import Test.Hspec
-
-import Data.Torrent.Client
 import Network.BitTorrent.Core.PeerId
 
 spec :: Spec
@@ -16,3 +13,7 @@ spec = do
     it "decode azureus encoded peer id" $ do
       clientInfo "-AZ2060-xxxxxxxxxxxx" `shouldBe` "Azureus-2060"
       clientInfo "-BS0000-xxxxxxxxxxxx" `shouldBe` "BTSlave-0"
+
+    it "decode Shad0w style peer id" $ do
+      clientInfo "S58B-----xxxxxxxxxxx" `shouldBe` "Shadow-5.8.11"
+      clientInfo "T58B-----xxxxxxxxxxx" `shouldBe` "BitTornado-5.8.11"
-- 
cgit v1.2.3