Add mainline client implementation id

3 files changed, 22 insertions, 4 deletions

diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs
index 0fd6722b..079b63c1 100644
--- a/src/Data/Torrent/Client.hs
+++ b/src/Data/Torrent/Client.hs
@@ -50,6 +50,7 @@ import Paths_bittorrent (version)
 --
 data ClientImpl =
    IUnknown
+ | IMainline
  | IAres
  | IArctic
  | IAvicora
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index 6aebe8d4..75a4d7a0 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -39,12 +39,14 @@ import Control.Applicative
 import Data.Aeson
 import Data.BEncode as BE
 import Data.ByteString as BS
+import Data.ByteString.Internal as BS
 import Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Builder as BS
 import Data.Default
 import Data.Foldable    (foldMap)
 import Data.List as L
+import Data.List.Split as L
 import Data.Maybe       (fromMaybe)
 import Data.Monoid
 import Data.Serialize as S
@@ -279,9 +281,20 @@ parseImpl = f . BC.unpack
 --
 clientInfo :: PeerId -> ClientInfo
 clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
-  where -- TODO other styles
-    getCI = getWord8 >> ClientInfo <$> getClientImpl <*> getClientVersion
-    getClientImpl    = parseImpl   <$> getByteString 2
-    getClientVersion = mkVer       <$> getByteString 4
+  where
+    getCI    = do
+      leading <- BS.w2c <$> getWord8
+      case leading of
+        '-' -> ClientInfo <$> getAzureusImpl <*> getAzureusVersion
+        'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion
+        _   -> pure def
+
+    getMainlineVersion = do
+      str <- BC.unpack <$> getByteString 7
+      let mnums = L.filter (not . L.null) $ L.linesBy ('-' ==) str
+      return $ Version (fromMaybe [] $ sequence $ L.map readMaybe mnums) []
+
+    getAzureusImpl    = parseImpl <$> getByteString 2
+    getAzureusVersion = mkVer     <$> getByteString 4
       where
         mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []
diff --git a/tests/Data/Torrent/ClientSpec.hs b/tests/Data/Torrent/ClientSpec.hs
index 890ee95e..94335ae9 100644
--- a/tests/Data/Torrent/ClientSpec.hs
+++ b/tests/Data/Torrent/ClientSpec.hs
@@ -9,6 +9,10 @@ import Network.BitTorrent.Core.PeerId
 spec :: Spec
 spec = do
   describe "client info" $ do
+    it "decode mainline encoded peer id" $ do
+      clientInfo "M4-3-6--xxxxxxxxxxxx" `shouldBe` "Mainline-4.3.6"
+      clientInfo "M4-20-8-xxxxxxxxxxxx" `shouldBe` "Mainline-4.20.8"
+
     it "decode azureus encoded peer id" $ do
       clientInfo "-AZ2060-xxxxxxxxxxxx" `shouldBe` "Azureus-2060"
       clientInfo "-BS0000-xxxxxxxxxxxx" `shouldBe` "BTSlave-0"