Add spec for client info extraction from azureus encoded peer id

3 files changed, 26 insertions, 0 deletions

diff --git a/bittorrent.cabal b/bittorrent.cabal
index 831f8729..846b5b16 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -144,6 +144,7 @@ test-suite spec
   other-modules:       Data.Torrent.MagnetSpec
                        Data.Torrent.InfoHashSpec
                        Data.Torrent.MetainfoSpec
+                       Data.Torrent.ClientSpec
   build-depends:       base == 4.*
                      , bytestring
                      , directory
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index 1ae55913..8883656b 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -49,6 +49,7 @@ import Data.List as L
 import Data.Maybe       (fromMaybe)
 import Data.Monoid
 import Data.Serialize as S
+import Data.String
 import Data.Time.Clock  (getCurrentTime)
 import Data.Time.Format (formatTime)
 import Data.URLEncoded
@@ -74,6 +75,14 @@ instance Serialize PeerId where
 instance URLShow PeerId where
   urlShow = BC.unpack . getPeerId
 
+instance IsString PeerId where
+  fromString str
+      | BS.length bs == 20 = PeerId bs
+      |      otherwise     = error $ "Peer id should be 20 bytes long: "
+                                  ++ show str
+    where
+      bs = fromString str
+
 -- | Format peer id in human readable form.
 ppPeerId :: PeerId -> Doc
 ppPeerId = text . BC.unpack . getPeerId
diff --git a/tests/Data/Torrent/ClientSpec.hs b/tests/Data/Torrent/ClientSpec.hs
new file mode 100644
index 00000000..f02a3b1f
--- /dev/null
+++ b/tests/Data/Torrent/ClientSpec.hs
@@ -0,0 +1,16 @@
+module Data.Torrent.ClientSpec (spec) where
+
+import Data.Version
+import Test.Hspec
+
+import Data.Torrent.Client
+import Network.BitTorrent.Core.PeerId
+
+spec :: Spec
+spec = do
+  describe "client info" $ do
+    it "decode azureus encoded peer id" $ do
+      clientInfo "-AZ2060-xxxxxxxxxxxx" `shouldBe`
+        ClientInfo IAzureus (ClientVersion (Version [2060] []))
+      clientInfo "-BS0000-xxxxxxxxxxxx" `shouldBe`
+        ClientInfo IBTSlave (ClientVersion (Version [0] []))