bittorrent 0.0.0.2 → 0.0.0.3
raw patch · 17 files changed
+465/−121 lines, 17 filesdep +pretty-classdep +splitdep ~time
Dependencies added: pretty-class, split
Dependency ranges changed: time
Files
- ChangeLog +7/−0
- bittorrent.cabal +12/−7
- src/Data/Torrent.hs +25/−19
- src/Data/Torrent/Block.hs +11/−16
- src/Data/Torrent/Client.hs +57/−28
- src/Data/Torrent/InfoHash.hs +6/−7
- src/Data/Torrent/Layout.hs +7/−10
- src/Data/Torrent/Magnet.hs +5/−0
- src/Data/Torrent/Piece.hs +9/−10
- src/Data/Torrent/Progress.hs +25/−1
- src/Data/Torrent/Tree.hs +2/−0
- src/Network/BitTorrent/Core/PeerAddr.hs +15/−13
- src/Network/BitTorrent/Core/PeerId.hs +80/−10
- tests/Data/Torrent/ClientSpec.hs +33/−0
- tests/Data/Torrent/InfoHashSpec.hs +36/−0
- tests/Data/Torrent/MagnetSpec.hs +45/−0
- tests/Data/Torrent/MetainfoSpec.hs +90/−0
ChangeLog view
@@ -1,3 +1,10 @@+2013-11-25 Sam Truzjan <pxqr.sta@gmail.com>++ * Version 0.0.0.3+ * use Pretty class from pretty-class package;+ * Data.Torrent.Client.hs:+ * /tests/: fixed;+ 2013-11-21 Sam Truzjan <pxqr.sta@gmail.com> Version 0.0.0.2
bittorrent.cabal view
@@ -1,5 +1,5 @@ name: bittorrent-version: 0.0.0.2+version: 0.0.0.3 license: BSD3 license-file: LICENSE author: Sam Truzjan@@ -33,7 +33,7 @@ type: git location: git://github.com/cobit/bittorrent.git branch: master- tag: v0.0.0.2+ tag: v0.0.0.3 library default-language: Haskell2010@@ -55,13 +55,11 @@ , Network.BitTorrent.Core.PeerAddr -- , System.IO.MMap.Fixed -- , System.Torrent.Storage- -- Network.BitTorrent -- , Network.BitTorrent.Extension- -- , Network.BitTorrent.Peer -- , Network.BitTorrent.Tracker--- , Network.BitTorrent.Tracker.Protocol+-- , Network.BitTorrent.Tracker.Message -- , Network.BitTorrent.Tracker.HTTP -- , Network.BitTorrent.Tracker.UDP -- , Network.BitTorrent.Exchange@@ -69,12 +67,13 @@ -- , Network.BitTorrent.DHT -- , Network.BitTorrent.DHT.Protocol -- , Network.BitTorrent.Sessions--- other-modules: Network.BitTorrent.Sessions.Types--- Paths_bittorrent+-- Network.BitTorrent.Sessions.Types+ other-modules: Paths_bittorrent build-depends: base == 4.* , bits-extras , pretty+ , pretty-class -- Control , deepseq@@ -100,6 +99,7 @@ , data-default , IntervalMap , intset+ , split , text >= 0.11.0 , unordered-containers , vector@@ -143,10 +143,15 @@ type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Spec.hs+ other-modules: Data.Torrent.MagnetSpec+ Data.Torrent.InfoHashSpec+ Data.Torrent.MetainfoSpec+ Data.Torrent.ClientSpec build-depends: base == 4.* , bytestring , directory , filepath+ , time , aeson , cereal
src/Data/Torrent.hs view
@@ -26,7 +26,7 @@ module Data.Torrent ( -- * Info dictionary InfoDict (..)- , ppInfoDict+ , infoDictionary -- ** Lenses , infohash@@ -36,7 +36,6 @@ -- * Torrent file , Torrent(..)- , ppTorrent -- ** Lenses , announce@@ -66,12 +65,10 @@ ) where import Prelude hiding (sum)- import Control.Applicative import Control.DeepSeq import Control.Exception import Control.Lens- import Data.Aeson.Types (ToJSON(..), FromJSON(..), Value(..), withText) import Data.Aeson.TH import Data.BEncode as BE@@ -88,6 +85,7 @@ import Data.Typeable import Network.URI import Text.PrettyPrint as PP+import Text.PrettyPrint.Class import System.FilePath import Data.Torrent.InfoHash as IH@@ -134,6 +132,13 @@ hash = Hashable.hash . idInfoHash {-# INLINE hash #-} +-- | Smart constructor: add a info hash to info dictionary.+infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict+infoDictionary li pinfo private = InfoDict ih li pinfo private+ where+ ih = IH.hashlazy $ encode $ InfoDict fake_ih li pinfo private+ fake_ih = InfoHash ""+ getPrivate :: Get Bool getPrivate = (Just True ==) <$>? "private" @@ -156,18 +161,16 @@ ih = IH.hashlazy (encode dict) ppPrivacy :: Bool -> Doc-ppPrivacy privacy =- "Privacy: " <> if privacy then "private" else "public"+ppPrivacy privacy = "Privacy: " <> if privacy then "private" else "public" -ppAdditionalInfo :: InfoDict -> Doc-ppAdditionalInfo layout = PP.empty+--ppAdditionalInfo :: InfoDict -> Doc+--ppAdditionalInfo layout = PP.empty --- | Format info dictionary in human-readable form.-ppInfoDict :: InfoDict -> Doc-ppInfoDict InfoDict {..} =- ppLayoutInfo idLayoutInfo $$- ppPieceInfo idPieceInfo $$- ppPrivacy idPrivate+instance Pretty InfoDict where+ pretty InfoDict {..} =+ pretty idLayoutInfo $$+ pretty idPieceInfo $$+ ppPrivacy idPrivate {----------------------------------------------------------------------- -- Torrent info@@ -251,6 +254,9 @@ fromBEncode b = decodingError $ "url <" ++ show b ++ ">" {-# INLINE fromBEncode #-} +--pico2uni :: Pico -> Uni+--pico2uni = undefined+ -- TODO move to bencoding instance BEncode POSIXTime where toBEncode pt = toBEncode (floor pt :: Integer)@@ -290,13 +296,13 @@ _ <:>? Nothing = PP.empty name <:>? (Just d) = name <:> d -ppTorrent :: Torrent -> Doc-ppTorrent Torrent {..} =- "InfoHash: " <> ppInfoHash (idInfoHash tInfoDict)+instance Pretty Torrent where+ pretty Torrent {..} =+ "InfoHash: " <> pretty (idInfoHash tInfoDict) $$ hang "General" 4 generalInfo $$ hang "Tracker" 4 trackers- $$ ppInfoDict tInfoDict- where+ $$ pretty tInfoDict+ where trackers = case tAnnounceList of Nothing -> text (show tAnnounce) Just xxs -> vcat $ L.map ppTier $ L.zip [1..] xxs
src/Data/Torrent/Block.hs view
@@ -9,6 +9,7 @@ -- {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-} module Data.Torrent.Block ( -- * Piece attributes PieceIx@@ -22,31 +23,26 @@ -- * Block index , BlockIx(..)- , ppBlockIx , blockIxRange -- * Block data , Block(..)- , ppBlock , blockIx , blockSize , blockRange ) where import Control.Applicative- import Data.Aeson.TH import qualified Data.ByteString.Lazy as Lazy import Data.Char import Data.List as L- import Data.Binary as B import Data.Binary.Get as B import Data.Binary.Put as B import Data.Serialize as S- import Text.PrettyPrint-+import Text.PrettyPrint.Class {----------------------------------------------------------------------- -- Piece attributes@@ -147,12 +143,11 @@ putIntB ixOffset putIntB ixLength --- | Format block index in human readable form.-ppBlockIx :: BlockIx -> Doc-ppBlockIx BlockIx {..} =- "piece = " <> int ixPiece <> "," <+>- "offset = " <> int ixOffset <> "," <+>- "length = " <> int ixLength+instance Pretty BlockIx where+ pretty BlockIx {..} =+ "piece = " <> int ixPiece <> "," <+>+ "offset = " <> int ixOffset <> "," <+>+ "length = " <> int ixLength -- | Get location of payload bytes in the torrent content. blockIxRange :: (Num a, Integral a) => PieceSize -> BlockIx -> (a, a)@@ -178,10 +173,10 @@ , blkData :: !payload } deriving (Show, Eq) --- | Format block in human readable form. Payload is ommitted.-ppBlock :: Block Lazy.ByteString -> Doc-ppBlock = ppBlockIx . blockIx-{-# INLINE ppBlock #-}+-- | Payload is ommitted.+instance Pretty (Block Lazy.ByteString) where+ pretty = pretty . blockIx+ {-# INLINE pretty #-} -- | Get size of block /payload/ in bytes. blockSize :: Block Lazy.ByteString -> BlockSize
src/Data/Torrent/Client.hs view
@@ -21,17 +21,8 @@ -- done using 'Network.BitTorrent.Extension'! -- module Data.Torrent.Client- ( -- * Client implementation- ClientImpl (..)- , ppClientImpl-- -- * Client version- , ClientVersion (..)- , ppClientVersion-- -- * Client information+ ( ClientImpl (..) , ClientInfo (..)- , ppClientInfo , libClientInfo ) where @@ -40,10 +31,15 @@ import Data.ByteString.Char8 as BC import Data.Default import Data.List as L+import Data.List.Split as L+import Data.Maybe import Data.Monoid+import Data.String import Data.Text as T import Data.Version import Text.PrettyPrint hiding ((<>))+import Text.PrettyPrint.Class+import Text.Read (readMaybe) import Paths_bittorrent (version) @@ -54,6 +50,22 @@ -- data ClientImpl = IUnknown++ | IMainline++ | IABC+ | IOspreyPermaseed+ | IBTQueue+ | ITribler+ | IShadow+ | IBitTornado++-- UPnP(!) Bit Torrent !???+-- 'U' - UPnP NAT Bit Torrent+ | IBitLord+ | IOpera+ | IMLdonkey+ | IAres | IArctic | IAvicora@@ -117,45 +129,62 @@ -- | Used to represent a not recognized implementation instance Default ClientImpl where def = IUnknown+ {-# INLINE def #-} --- | Format client implementation info in human-readable form.-ppClientImpl :: ClientImpl -> Doc-ppClientImpl = text . L.tail . show+instance IsString ClientImpl where+ fromString str+ | Just impl <- L.lookup str alist = impl+ | otherwise = error $ "fromString: not recognized " ++ str+ where+ alist = L.map mk [minBound..maxBound]+ mk x = (L.tail $ show x, x) --- | Version of client software, normally extracted from peer id.-newtype ClientVersion = ClientVersion { getClientVersion :: Version }- deriving (Show, Eq, Ord)+instance Pretty ClientImpl where+ pretty = text . L.tail . show -- | Just the '0' version.-instance Default ClientVersion where- def = ClientVersion $ Version [0] []+instance Default Version where+ def = Version [0] []+ {-# INLINE def #-} --- | Format client implementation version in human-readable form.-ppClientVersion :: ClientVersion -> Doc-ppClientVersion = text . showVersion . getClientVersion+instance IsString Version where+ fromString str+ | Just nums <- chunkNums str = Version nums []+ | otherwise = error $ "fromString: invalid version string " ++ str+ where+ chunkNums = sequence . L.map readMaybe . L.linesBy ('.' ==) +instance Pretty Version where+ pretty = text . showVersion+ -- | The all sensible infomation that can be obtained from a peer -- identifier or torrent /createdBy/ field. data ClientInfo = ClientInfo { ciImpl :: ClientImpl- , ciVersion :: ClientVersion+ , ciVersion :: Version } deriving (Show, Eq, Ord) -- | Unrecognized client implementation. instance Default ClientInfo where def = ClientInfo def def+ {-# INLINE def #-} --- | Format client info in human-readable form.-ppClientInfo :: ClientInfo -> Doc-ppClientInfo ClientInfo {..} =- ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion+instance IsString ClientInfo where+ fromString str+ | _ : ver <- _ver = ClientInfo (fromString impl) (fromString ver)+ | otherwise = error $ "fromString: invalid client info string" ++ str+ where+ (impl, _ver) = L.span ((/=) '-') str +instance Pretty ClientInfo where+ pretty ClientInfo {..} = pretty ciImpl <+> "version" <+> pretty ciVersion+ -- | Client info of this (the bittorrent library) package. Normally, -- applications should introduce its own idenitifiers, otherwise they -- can use 'libClientInfo' value. -- libClientInfo :: ClientInfo-libClientInfo = ClientInfo IlibHSbittorrent (ClientVersion version)+libClientInfo = ClientInfo IlibHSbittorrent version {----------------------------------------------------------------------- -- For torrent file@@ -164,7 +193,7 @@ renderImpl :: ClientImpl -> Text renderImpl = T.pack . L.tail . show -renderVersion :: ClientVersion -> Text+renderVersion :: Version -> Text renderVersion = undefined renderClientInfo :: ClientInfo -> Text
src/Data/Torrent/InfoHash.hs view
@@ -19,11 +19,9 @@ -- * Rendering , longHex , shortHex- , ppInfoHash , addHashToURI - , Data.Torrent.InfoHash.hash , Data.Torrent.InfoHash.hashlazy ) where@@ -52,6 +50,7 @@ import Numeric import Text.ParserCombinators.ReadP as P import Text.PrettyPrint+import Text.PrettyPrint.Class -- | Exactly 20 bytes long SHA1 hash of the info part of torrent file.@@ -60,7 +59,7 @@ -- | for hex encoded strings instance Show InfoHash where- show = render . ppInfoHash+ show = render . pretty -- | for hex encoded strings instance Read InfoHash where@@ -106,6 +105,10 @@ instance URLShow InfoHash where urlShow = show +-- | base16 encoded.+instance Pretty InfoHash where+ pretty = text . BC.unpack . ppHex . getInfoHash+ -- | Tries both base16 and base32 while decoding info hash. textToInfoHash :: Text -> Maybe InfoHash textToInfoHash text@@ -126,10 +129,6 @@ -- | The same as 'longHex', but 7 character long. shortHex :: InfoHash -> Text shortHex = T.take 7 . longHex---- | Pretty print info hash in hexadecimal format.-ppInfoHash :: InfoHash -> Doc-ppInfoHash = text . BC.unpack . ppHex . getInfoHash ppHex :: BS.ByteString -> BS.ByteString ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed
src/Data/Torrent/Layout.hs view
@@ -24,7 +24,6 @@ -- * Single file info , FileInfo (..)- , ppFileInfo -- ** Lens , fileLength@@ -33,7 +32,6 @@ -- * File layout , LayoutInfo (..)- , ppLayoutInfo , joinFilePath -- ** Lens@@ -78,6 +76,7 @@ import Data.Text.Encoding as T import Data.Typeable import Text.PrettyPrint as PP+import Text.PrettyPrint.Class import System.FilePath import System.Posix.Types @@ -175,13 +174,12 @@ fromBEncode = fromDict getFileInfoSingle {-# INLINE fromBEncode #-} --- | Format 'FileInfo' in human-readable form.-ppFileInfo :: FileInfo ByteString -> Doc-ppFileInfo FileInfo {..} =+instance Pretty (FileInfo BS.ByteString) where+ pretty FileInfo {..} = "Path: " <> text (T.unpack (T.decodeUtf8 fiName)) $$ "Size: " <> text (show fiLength) $$ maybe PP.empty ppMD5 fiMD5Sum- where+ where ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5)) -- | Join file path.@@ -242,10 +240,9 @@ toBEncode = toDict . (`putLayoutInfo` endDict) fromBEncode = fromDict getLayoutInfo --- | Format 'LayoutInfo' in human readable form.-ppLayoutInfo :: LayoutInfo -> Doc-ppLayoutInfo SingleFile {..} = ppFileInfo liFile-ppLayoutInfo MultiFile {..} = vcat $ L.map (ppFileInfo . joinFilePath) liFiles+instance Pretty LayoutInfo where+ pretty SingleFile {..} = pretty liFile+ pretty MultiFile {..} = vcat $ L.map (pretty . joinFilePath) liFiles -- | Test if this is single file torrent. isSingleFile :: LayoutInfo -> Bool
src/Data/Torrent/Magnet.hs view
@@ -43,6 +43,8 @@ import Data.Text.Encoding as T import Network.URI import Text.Read+import Text.PrettyPrint as PP+import Text.PrettyPrint.Class import Data.Torrent import Data.Torrent.InfoHash@@ -147,6 +149,9 @@ instance URLEncode Magnet where urlEncode = toQuery {-# INLINE urlEncode #-}++instance Pretty Magnet where+ pretty = PP.text . renderMagnet -- | Set exact topic only, other params are empty. nullMagnet :: InfoHash -> Magnet
src/Data/Torrent/Piece.hs view
@@ -21,13 +21,12 @@ -- * Piece data , Piece (..)- , ppPiece , pieceSize , isPiece -- * Piece control+ , HashArray (..) , PieceInfo (..)- , ppPieceInfo , pieceCount -- * Lens@@ -61,6 +60,7 @@ import Data.Text.Encoding as T import Data.Typeable import Text.PrettyPrint+import Text.PrettyPrint.Class import Data.Torrent.Block @@ -121,10 +121,9 @@ instance NFData (Piece a) --- | Format piece in human readable form. Payload bytes are omitted.-ppPiece :: Piece a -> Doc-ppPiece Piece {..}- = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex)+-- | Payload bytes are omitted.+instance Pretty (Piece a) where+ pretty Piece {..} = "Piece" <+> braces ("index" <+> "=" <+> int pieceIndex) -- | Get size of piece in bytes. pieceSize :: Piece BL.ByteString -> PieceSize@@ -140,6 +139,7 @@ -- Piece control -----------------------------------------------------------------------} +-- | A flat array of SHA1 sums of each piece. newtype HashArray = HashArray { unHashArray :: ByteString } deriving (Show, Read, Eq, BEncode) @@ -192,10 +192,9 @@ toBEncode = toDict . (`putPieceInfo` endDict) fromBEncode = fromDict getPieceInfo --- | Format piece info in human readable form. Hashes are omitted.-ppPieceInfo :: PieceInfo -> Doc-ppPieceInfo PieceInfo {..} =- "Piece size: " <> int piPieceLength+-- | Hashes are omitted.+instance Pretty PieceInfo where+ pretty PieceInfo {..} = "Piece size: " <> int piPieceLength hashsize :: Int hashsize = 20
src/Data/Torrent/Progress.hs view
@@ -34,14 +34,17 @@ ) where import Control.Applicative-import Control.Lens+import Control.Lens hiding ((%=)) import Data.Aeson.TH import Data.Default import Data.List as L import Data.Monoid import Data.Serialize as S import Data.Ratio+import Data.URLEncoded import Data.Word+import Text.PrettyPrint as PP+import Text.PrettyPrint.Class -- | Progress data is considered as dynamic within one client@@ -58,6 +61,7 @@ $(makeLenses ''Progress) $(deriveJSON L.tail ''Progress) +-- | UDP tracker compatible encoding. instance Serialize Progress where put Progress {..} = do putWord64be $ fromIntegral _downloaded@@ -73,6 +77,7 @@ def = Progress 0 0 0 {-# INLINE def #-} +-- | Can be used to aggregate total progress. instance Monoid Progress where mempty = def {-# INLINE mempty #-}@@ -83,6 +88,25 @@ , _uploaded = ua + ub } {-# INLINE mappend #-}++instance URLShow Word64 where+ urlShow = show+ {-# INLINE urlShow #-}++-- | HTTP Tracker protocol compatible encoding.+instance URLEncode Progress where+ urlEncode Progress {..} = mconcat+ [ s "uploaded" %= _uploaded+ , s "left" %= _left+ , s "downloaded" %= _downloaded+ ]+ where s :: String -> String; s = id; {-# INLINE s #-}++instance Pretty Progress where+ pretty Progress {..} =+ "/\\" <+> PP.text (show _uploaded) $$+ "\\/" <+> PP.text (show _downloaded) $$+ "left" <+> PP.text (show _left) -- | Initial progress is used when there are no session before. --
src/Data/Torrent/Tree.hs view
@@ -55,6 +55,8 @@ --decompress :: DirTree () -> [FileInfo ()] --decompress = undefined +-- TODO pretty print+ -- | Lookup file by path. lookup :: [FilePath] -> DirTree a -> Maybe (DirTree a) lookup [] t = Just t
src/Network/BitTorrent/Core/PeerAddr.hs view
@@ -16,10 +16,9 @@ module Network.BitTorrent.Core.PeerAddr ( -- * Peer address PeerAddr(..)- , getCompactPeerList+ , defaultPorts , peerSockAddr , connectToPeer- , ppPeer ) where import Control.Applicative@@ -34,6 +33,7 @@ import Data.Word import Network.Socket import Text.PrettyPrint+import Text.PrettyPrint.Class import Data.Torrent.Client import Network.BitTorrent.Core.PeerId@@ -80,16 +80,26 @@ -- | The tracker "compact peer list" compatible encoding. The -- 'peerId' is always 'Nothing'.+--+-- For more info see: <http://www.bittorrent.org/beps/bep_0023.html>+-- instance Serialize PeerAddr where put PeerAddr {..} = put peerID >> put peerPort {-# INLINE put #-} get = PeerAddr Nothing <$> get <*> get {-# INLINE get #-} --- | For more info see: <http://www.bittorrent.org/beps/bep_0023.html>-getCompactPeerList :: S.Get [PeerAddr]-getCompactPeerList = many get+instance Pretty PeerAddr where+ pretty p @ PeerAddr {..}+ | Just pid <- peerID = pretty (clientInfo pid) <+> "at" <+> paddr+ | otherwise = paddr+ where+ paddr = text (show (peerSockAddr p)) +-- | Ports typically reserved for bittorrent P2P listener.+defaultPorts :: [PortNumber]+defaultPorts = [6881..6889]+ -- TODO make platform independent, clarify htonl -- | Convert peer info from tracker response to socket address. Used@@ -114,11 +124,3 @@ sock <- socket AF_INET Stream Network.Socket.defaultProtocol connect sock (peerSockAddr p) return sock---- | Pretty print peer address in human readable form.-ppPeer :: PeerAddr -> Doc-ppPeer p @ PeerAddr {..}- | Just pid <- peerID = ppClientInfo (clientInfo pid) <+> "at" <+> paddr- | otherwise = paddr- where- paddr = text (show (peerSockAddr p))
src/Network/BitTorrent/Core/PeerId.hs view
@@ -16,7 +16,6 @@ module Network.BitTorrent.Core.PeerId ( -- * PeerId PeerId (getPeerId)- , ppPeerId -- * Generation , genPeerId@@ -40,15 +39,18 @@ 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.Maybe (fromMaybe)+import Data.List.Split as L+import Data.Maybe (fromMaybe, catMaybes) import Data.Monoid import Data.Serialize as S+import Data.String import Data.Time.Clock (getCurrentTime) import Data.Time.Format (formatTime) import Data.URLEncoded@@ -56,6 +58,7 @@ import System.Entropy (getEntropy) import System.Locale (defaultTimeLocale) import Text.PrettyPrint hiding ((<>))+import Text.PrettyPrint.Class import Text.Read (readMaybe) import Paths_bittorrent (version) @@ -74,10 +77,17 @@ instance URLShow PeerId where urlShow = BC.unpack . getPeerId --- | Format peer id in human readable form.-ppPeerId :: PeerId -> Doc-ppPeerId = text . 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 +instance Pretty PeerId where+ pretty = text . BC.unpack . getPeerId+ {----------------------------------------------------------------------- -- Encoding -----------------------------------------------------------------------}@@ -237,6 +247,7 @@ f "MO" = IMonoTorrent f "MP" = IMooPolice f "MR" = IMiro+ f "ML" = IMLdonkey f "MT" = IMoonlightTorrent f "NX" = INetTransport f "PD" = IPando@@ -265,15 +276,74 @@ 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'. -- 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+ 'e' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion+ 'F' -> ClientInfo <$> getBitCometImpl <*> getBitCometVersion+ 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+ 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 = ClientVersion $ Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []+ mkVer bs = Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []++ getBitCometImpl = do+ bs <- getByteString 3+ lookAhead $ do+ _ <- getByteString 2+ lr <- getByteString 4+ return $+ if lr == "LORD" then IBitLord else+ if bs == "UTB" then IBitComet else+ if bs == "xbc" then IBitComet else def++ getBitCometVersion = do+ x <- getWord8+ 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+ 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) []
+ tests/Data/Torrent/ClientSpec.hs view
@@ -0,0 +1,33 @@+-- | see <http://bittorrent.org/beps/bep_0020.html>+module Data.Torrent.ClientSpec (spec) where+import Test.Hspec+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"++ it "decode Shad0w style peer id" $ do+ clientInfo "S58B-----xxxxxxxxxxx" `shouldBe` "Shadow-5.8.11"+ clientInfo "T58B-----xxxxxxxxxxx" `shouldBe` "BitTornado-5.8.11"++ 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"++ it "decode opera style peer id" $ do+ clientInfo "OP0123xxxxxxxxxxxxxx" `shouldBe` "Opera-123"++ it "decode ML donkey style peer id" $ do+ clientInfo "-ML2.7.2-xxxxxxxxxxx" `shouldBe` "MLdonkey-0"++-- TODO XBT, Bits on Wheels, Queen Bee, BitTyrant, TorrenTopia,+-- BitSpirit, Rufus, G3 Torrent, FlashGet
+ tests/Data/Torrent/InfoHashSpec.hs view
@@ -0,0 +1,36 @@+{-# OPTIONS -fno-warn-orphans #-}+module Data.Torrent.InfoHashSpec (spec) where++import Control.Applicative+import System.FilePath+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()++import Data.Torrent+import Data.Torrent.InfoHash as IH+++instance Arbitrary InfoHash where+ arbitrary = IH.hash <$> arbitrary++type TestPair = (FilePath, String)++-- TODO add a few more torrents here+torrentList :: [TestPair]+torrentList =+ [ ( "res" </> "dapper-dvd-amd64.iso.torrent"+ , "0221caf96aa3cb94f0f58d458e78b0fc344ad8bf")+ ]++infohashSpec :: (FilePath, String) -> Spec+infohashSpec (filepath, expectedHash) = do+ it ("should match " ++ filepath) $ do+ torrent <- fromFile filepath+ let actualHash = show $ idInfoHash $ tInfoDict torrent+ actualHash `shouldBe` expectedHash++spec :: Spec+spec = do+ describe "info hash" $ do+ mapM_ infohashSpec torrentList
+ tests/Data/Torrent/MagnetSpec.hs view
@@ -0,0 +1,45 @@+{-# OPTIONS -fno-warn-orphans #-}+module Data.Torrent.MagnetSpec (spec) where++import Control.Applicative+import Data.Maybe+import Data.Monoid+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()+import Network.URI++import Data.Torrent.InfoHash+import Data.Torrent.Magnet+import Data.Torrent.InfoHashSpec ()+++instance Arbitrary URIAuth where+ arbitrary = URIAuth <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary URI where+ arbitrary+ = pure $ fromJust $ parseURI "http://ietf.org/1737.txt?a=1&b=h#123"++instance Arbitrary Magnet where+ arbitrary = Magnet <$> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary+ <*> arbitrary <*> arbitrary <*> pure mempty++magnetEncoding :: Magnet -> Bool+magnetEncoding m = parseMagnet (renderMagnet m) == Just m++spec :: Spec+spec = do+ describe "Magnet" $ do+ it "properly encoded" $ property $ magnetEncoding++ it "parse base32" $ do+ let magnet = "magnet:?xt=urn:btih:CT76LXJDDCH5LS2TUHKH6EUJ3NYKX4Y6"+ let ih = InfoHash "\DC4\255\229\221#\CAN\143\213\203S\161\212\DEL\DC2\137\219p\171\243\RS"+ parseMagnet magnet `shouldBe` Just (nullMagnet ih)++ it "parse base16" $ do+ let magnet = "magnet:?xt=urn:btih:0123456789abcdef0123456789abcdef01234567"+ let ih = InfoHash "\SOH#Eg\137\171\205\239\SOH#Eg\137\171\205\239\SOH#Eg"+ parseMagnet magnet `shouldBe` Just (nullMagnet ih)
+ tests/Data/Torrent/MetainfoSpec.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE TypeSynonymInstances #-}+{-# OPTIONS -fno-warn-orphans #-}+module Data.Torrent.MetainfoSpec (spec) where++import Control.Applicative+import Data.ByteString as BS+import Data.ByteString.Lazy as BL+import Data.BEncode+import Data.Maybe+import Data.Time+import Network.URI+import Test.Hspec+import Test.QuickCheck+import Test.QuickCheck.Instances ()++import Data.Torrent.Piece+import Data.Torrent.Layout+import Data.Torrent+++{-----------------------------------------------------------------------+-- Common+-----------------------------------------------------------------------}++data T a = T++prop_properBEncode :: Show a => BEncode a => Eq a+ => T a -> a -> IO ()+prop_properBEncode _ expected = actual `shouldBe` Right expected+ where+ actual = decode $ BL.toStrict $ encode expected++instance Arbitrary URI where+ arbitrary = pure $ fromJust+ $ parseURI "http://exsample.com:80/123365_asd"++{-----------------------------------------------------------------------+-- Instances+-----------------------------------------------------------------------}++instance Arbitrary FileSize where+ arbitrary = fromIntegral <$> (arbitrary :: Gen Int)++instance Arbitrary a => Arbitrary (FileInfo a) where+ arbitrary = FileInfo <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary LayoutInfo where+ arbitrary = oneof+ [ SingleFile <$> arbitrary+ , MultiFile <$> arbitrary <*> arbitrary+ ]++instance Arbitrary HashArray where+ arbitrary = HashArray <$> arbitrary++instance Arbitrary PieceInfo where+ arbitrary = PieceInfo <$> arbitrary <*> arbitrary++instance Arbitrary InfoDict where+ arbitrary = infoDictionary <$> arbitrary <*> arbitrary <*> arbitrary++pico :: Gen (Maybe NominalDiffTime)+pico = oneof+ [ pure Nothing+ , (Just . fromIntegral) <$> (arbitrary :: Gen Int)+ ]++instance Arbitrary Torrent where+ arbitrary = Torrent <$> arbitrary+ <*> arbitrary <*> arbitrary <*> arbitrary+ <*> pico <*> arbitrary <*> arbitrary+ <*> arbitrary <*> pure Nothing <*> arbitrary++{-----------------------------------------------------------------------+-- Spec+-----------------------------------------------------------------------}++spec :: Spec+spec = do+ describe "FileInfo" $ do+ it "properly bencoded" $ property $+ prop_properBEncode (T :: T (FileInfo BS.ByteString))++ describe "LayoutInfo" $ do+ it "properly bencoded" $ property $+ prop_properBEncode (T :: T LayoutInfo)++ describe "Torrent" $ do+ it "property bencoded" $ property $+ prop_properBEncode (T :: T Torrent)