Opera peer id encoding style

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 =
 -- UPnP(!) Bit Torrent !???
 -- 'U' - UPnP NAT Bit Torrent
  | IBitLord
+ | IOpera
 
  | IAres
  | 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
   f "ZT" = IZipTorrent
   f _    = IUnknown
 
+-- TODO use regexps
+
 -- | Tries to extract meaningful information from peer ID bytes. If
 -- peer id uses unknown coding style then client info returned is
 -- 'def'.
@@ -289,7 +291,13 @@ clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
         'M' -> ClientInfo <$> pure IMainline <*> getMainlineVersion
         'e' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion
         'F' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion
-        c   -> ClientInfo <$> pure (getShadowImpl c) <*> getShadowVersion
+        c   -> do
+          c1 <- w2c <$> lookAhead getWord8
+          if c1 == 'P'
+            then do
+                 _ <- getWord8
+                 ClientInfo <$> pure IOpera            <*> getOperaVersion
+            else ClientInfo <$> pure (getShadowImpl c) <*> getShadowVersion
 
     getMainlineVersion = do
       str <- BC.unpack <$> getByteString 7
@@ -316,6 +324,10 @@ clientInfo pid = either (const def) id $ runGet getCI (getPeerId pid)
       y <- getWord8
       return $ Version [fromIntegral x, fromIntegral y] []
 
+    getOperaVersion = do
+      str <- BC.unpack <$> getByteString 4
+      return $ Version [fromMaybe 0 $ readMaybe str] []
+
     getShadowImpl 'A' = IABC
     getShadowImpl 'O' = IOspreyPermaseed
     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
     it "decode bitcomet style peer id" $ do
       clientInfo "exbc01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
       clientInfo "FUTB01xxxxxxxxxxxxxx" `shouldBe` "BitComet-48.49"
-      clientInfo "exbc01LORDxxxxxxxxxx" `shouldBe` "BitLord-48.49"
\ No newline at end of file
+      clientInfo "exbc01LORDxxxxxxxxxx" `shouldBe` "BitLord-48.49"
+
+    it "decode opera style peer id" $ do
+      clientInfo "OP0123xxxxxxxxxxxxxx" `shouldBe` "Opera-123"