From 923abc9ee7576f2d3e1b7e2b2d5a32ed5d2f21c9 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Sat, 23 Nov 2013 02:04:07 +0400 Subject: Add spec for client info extraction from azureus encoded peer id --- bittorrent.cabal | 1 + src/Network/BitTorrent/Core/PeerId.hs | 9 +++++++++ tests/Data/Torrent/ClientSpec.hs | 16 ++++++++++++++++ 3 files changed, 26 insertions(+) create mode 100644 tests/Data/Torrent/ClientSpec.hs 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] [])) -- cgit v1.2.3