bittorrent 0.0.0.1 → 0.0.0.2
raw patch · 12 files changed
+960/−24 lines, 12 filesdep ~cryptohash
Dependency ranges changed: cryptohash
Files
- ChangeLog +14/−0
- bittorrent.cabal +11/−5
- changelog +0/−1
- src/Data/Torrent.hs +56/−1
- src/Data/Torrent/Client.hs +249/−0
- src/Data/Torrent/InfoHash.hs +24/−8
- src/Data/Torrent/Layout.hs +44/−6
- src/Data/Torrent/Magnet.hs +28/−1
- src/Data/Torrent/Piece.hs +2/−2
- src/Data/Torrent/Progress.hs +129/−0
- src/Network/BitTorrent/Core/PeerAddr.hs +124/−0
- src/Network/BitTorrent/Core/PeerId.hs +279/−0
+ ChangeLog view
@@ -0,0 +1,14 @@+2013-11-21 Sam Truzjan <pxqr.sta@gmail.com>++ Version 0.0.0.2++ * InfoHash.hs: added rendering to Text.+ * Torrent.hs: added pretty printing and content type.+ * Magnet.hs: added constructors from Torrent datatype.+ * New: added Data.Torrent.Client, Data.Torrent.Progress,+ Network.Bittorrent.Core.PeerId, Network.BitTorrent.PeerAddr+ modules.++2013-11-01 Sam Truzjan <pxqr.sta@gmail.com>++ Initial version: 0.0.0.1
bittorrent.cabal view
@@ -1,5 +1,5 @@ name: bittorrent-version: 0.0.0.1+version: 0.0.0.2 license: BSD3 license-file: LICENSE author: Sam Truzjan@@ -23,7 +23,7 @@ extra-source-files: res/dapper-dvd-amd64.iso.torrent res/pkg.torrent , README.md- , changelog+ , ChangeLog source-repository head type: git@@ -33,7 +33,7 @@ type: git location: git://github.com/cobit/bittorrent.git branch: master- tag: v0.0.0.1+ tag: v0.0.0.2 library default-language: Haskell2010@@ -44,17 +44,21 @@ exposed-modules: Data.Torrent -- , Data.Torrent.Bitfield , Data.Torrent.Block+ , Data.Torrent.Client , Data.Torrent.InfoHash , Data.Torrent.Layout , Data.Torrent.Magnet , Data.Torrent.Piece+ , Data.Torrent.Progress , Data.Torrent.Tree-+ , Network.BitTorrent.Core.PeerId+ , 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@@ -66,6 +70,8 @@ -- , Network.BitTorrent.DHT.Protocol -- , Network.BitTorrent.Sessions -- other-modules: Network.BitTorrent.Sessions.Types+-- Paths_bittorrent+ build-depends: base == 4.* , bits-extras , pretty@@ -99,7 +105,7 @@ , vector -- Hashing- , cryptohash+ , cryptohash == 0.10.* , hashable -- Codecs & Serialization
− changelog
@@ -1,1 +0,0 @@-* 0.0.0.1: Initial version.
src/Data/Torrent.hs view
@@ -26,6 +26,7 @@ module Data.Torrent ( -- * Info dictionary InfoDict (..)+ , ppInfoDict -- ** Lenses , infohash@@ -35,6 +36,7 @@ -- * Torrent file , Torrent(..)+ , ppTorrent -- ** Lenses , announce@@ -51,6 +53,9 @@ -- * Construction , nullTorrent + -- * Mime types+ , typeTorrent+ -- * File paths , torrentExt , isTorrentPath@@ -82,6 +87,7 @@ import Data.Time.Clock.POSIX import Data.Typeable import Network.URI+import Text.PrettyPrint as PP import System.FilePath import Data.Torrent.InfoHash as IH@@ -149,6 +155,20 @@ where ih = IH.hashlazy (encode dict) +ppPrivacy :: Bool -> Doc+ppPrivacy privacy =+ "Privacy: " <> if privacy then "private" else "public"++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+ {----------------------------------------------------------------------- -- Torrent info -----------------------------------------------------------------------}@@ -263,13 +283,47 @@ <*>? "publisher-url" <*>? "signature" +(<:>) :: Doc -> Doc -> Doc+name <:> v = name <> ":" <+> v++(<:>?) :: Doc -> Maybe Doc -> Doc+_ <:>? Nothing = PP.empty+name <:>? (Just d) = name <:> d++ppTorrent :: Torrent -> Doc+ppTorrent Torrent {..} =+ "InfoHash: " <> ppInfoHash (idInfoHash tInfoDict)+ $$ hang "General" 4 generalInfo+ $$ hang "Tracker" 4 trackers+ $$ ppInfoDict tInfoDict+ where+ trackers = case tAnnounceList of+ Nothing -> text (show tAnnounce)+ Just xxs -> vcat $ L.map ppTier $ L.zip [1..] xxs+ where+ ppTier (n, xs) = "Tier #" <> int n <:> vcat (L.map (text . show) xs)++ generalInfo =+ "Comment" <:>? ((text . T.unpack) <$> tComment) $$+ "Created by" <:>? ((text . T.unpack) <$> tCreatedBy) $$+ "Created on" <:>? ((text . show . posixSecondsToUTCTime)+ <$> tCreationDate) $$+ "Encoding" <:>? ((text . T.unpack) <$> tEncoding) $$+ "Publisher" <:>? ((text . show) <$> tPublisher) $$+ "Publisher URL" <:>? ((text . show) <$> tPublisherURL) $$+ "Signature" <:>? ((text . show) <$> tSignature)+ -- | A simple torrent contains only required fields. nullTorrent :: URI -> InfoDict -> Torrent nullTorrent ann info = Torrent ann Nothing Nothing Nothing Nothing Nothing info Nothing Nothing Nothing --- | Extension usually used for torrent metafiles.+-- | Mime type of torrent files.+typeTorrent :: BS.ByteString+typeTorrent = "application/x-bittorrent"++-- | Extension usually used for torrent files. torrentExt :: String torrentExt = "torrent" @@ -285,5 +339,6 @@ Right !t -> return t Left msg -> throwIO $ userError $ msg ++ " while reading torrent file" +-- | Encode and write a .torrent file. toFile :: FilePath -> Torrent -> IO () toFile filepath = BL.writeFile filepath . encode
+ src/Data/Torrent/Client.hs view
@@ -0,0 +1,249 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- 'ClientInfo' is used to identify the client implementation and+-- version which also contained in 'Peer'. For exsample first 6+-- bytes of peer id of this this library are @-HS0100-@ while for+-- mainline we have @M4-3-6--@. We could extract this info and+-- print in human-friendly form: this is useful for debugging and+-- logging.+--+-- For more information see:+-- <http://bittorrent.org/beps/bep_0020.html>+--+--+-- NOTE: Do _not_ use this information to control client+-- capabilities (such as supported enchancements), this should be+-- done using 'Network.BitTorrent.Extension'!+--+module Data.Torrent.Client+ ( -- * Client implementation+ ClientImpl (..)+ , ppClientImpl++ -- * Client version+ , ClientVersion (..)+ , ppClientVersion++ -- * Client information+ , ClientInfo (..)+ , ppClientInfo+ , libClientInfo+ ) where++import Control.Applicative+import Data.ByteString as BS+import Data.ByteString.Char8 as BC+import Data.Default+import Data.List as L+import Data.Monoid+import Data.Text as T+import Data.Version+import Text.PrettyPrint hiding ((<>))+import Paths_bittorrent (version)+++-- | List of registered client versions + IlibHSbittorrent (this+-- package) + Unknown (for not recognized software). All names are+-- prefixed by "I" because some of them starts from lowercase letter+-- but that is not a valid Haskell constructor name.+--+data ClientImpl =+ IUnknown+ | IAres+ | IArctic+ | IAvicora+ | IBitPump+ | IAzureus+ | IBitBuddy+ | IBitComet+ | IBitflu+ | IBTG+ | IBitRocket+ | IBTSlave+ | IBittorrentX+ | IEnhancedCTorrent+ | ICTorrent+ | IDelugeTorrent+ | IPropagateDataClient+ | IEBit+ | IElectricSheep+ | IFoxTorrent+ | IGSTorrent+ | IHalite+ | IlibHSbittorrent+ | IHydranode+ | IKGet+ | IKTorrent+ | ILH_ABC+ | ILphant+ | ILibtorrent+ | ILibTorrent+ | ILimeWire+ | IMonoTorrent+ | IMooPolice+ | IMiro+ | IMoonlightTorrent+ | INetTransport+ | IPando+ | IqBittorrent+ | IQQDownload+ | IQt4TorrentExample+ | IRetriever+ | IShareaza+ | ISwiftbit+ | ISwarmScope+ | ISymTorrent+ | Isharktorrent+ | ITorrentDotNET+ | ITransmission+ | ITorrentstorm+ | ITuoTu+ | IuLeecher+ | IuTorrent+ | IVagaa+ | IBitLet+ | IFireTorrent+ | IXunlei+ | IXanTorrent+ | IXtorrent+ | IZipTorrent+ deriving (Show, Eq, Ord, Enum, Bounded)++-- | Used to represent a not recognized implementation+instance Default ClientImpl where+ def = IUnknown++-- | Format client implementation info in human-readable form.+ppClientImpl :: ClientImpl -> Doc+ppClientImpl = text . L.tail . show++-- | Version of client software, normally extracted from peer id.+newtype ClientVersion = ClientVersion { getClientVersion :: Version }+ deriving (Show, Eq, Ord)++-- | Just the '0' version.+instance Default ClientVersion where+ def = ClientVersion $ Version [0] []++-- | Format client implementation version in human-readable form.+ppClientVersion :: ClientVersion -> Doc+ppClientVersion = text . showVersion . getClientVersion++-- | The all sensible infomation that can be obtained from a peer+-- identifier or torrent /createdBy/ field.+data ClientInfo = ClientInfo {+ ciImpl :: ClientImpl+ , ciVersion :: ClientVersion+ } deriving (Show, Eq, Ord)++-- | Unrecognized client implementation.+instance Default ClientInfo where+ def = ClientInfo def def++-- | Format client info in human-readable form.+ppClientInfo :: ClientInfo -> Doc+ppClientInfo ClientInfo {..} =+ ppClientImpl ciImpl <+> "version" <+> ppClientVersion 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)++{-----------------------------------------------------------------------+-- For torrent file+-----------------------------------------------------------------------}++renderImpl :: ClientImpl -> Text+renderImpl = T.pack . L.tail . show++renderVersion :: ClientVersion -> Text+renderVersion = undefined++renderClientInfo :: ClientInfo -> Text+renderClientInfo ClientInfo {..} = renderImpl ciImpl <> "/" <> renderVersion ciVersion++parseClientInfo :: Text -> ClientImpl+parseClientInfo t = undefined++{-+-- code used for generation; remove it later on++mkEnumTyDef :: NM -> String+mkEnumTyDef = unlines . map (" | I" ++) . nub . map snd++mkPars :: NM -> String+mkPars = unlines . map (\(code, impl) -> " f \"" ++ code ++ "\" = " ++ "I" ++ impl)++type NM = [(String, String)]+nameMap :: NM+nameMap =+ [ ("AG", "Ares")+ , ("A~", "Ares")+ , ("AR", "Arctic")+ , ("AV", "Avicora")+ , ("AX", "BitPump")+ , ("AZ", "Azureus")+ , ("BB", "BitBuddy")+ , ("BC", "BitComet")+ , ("BF", "Bitflu")+ , ("BG", "BTG")+ , ("BR", "BitRocket")+ , ("BS", "BTSlave")+ , ("BX", "BittorrentX")+ , ("CD", "EnhancedCTorrent")+ , ("CT", "CTorrent")+ , ("DE", "DelugeTorrent")+ , ("DP", "PropagateDataClient")+ , ("EB", "EBit")+ , ("ES", "ElectricSheep")+ , ("FT", "FoxTorrent")+ , ("GS", "GSTorrent")+ , ("HL", "Halite")+ , ("HS", "libHSnetwork_bittorrent")+ , ("HN", "Hydranode")+ , ("KG", "KGet")+ , ("KT", "KTorrent")+ , ("LH", "LH_ABC")+ , ("LP", "Lphant")+ , ("LT", "Libtorrent")+ , ("lt", "LibTorrent")+ , ("LW", "LimeWire")+ , ("MO", "MonoTorrent")+ , ("MP", "MooPolice")+ , ("MR", "Miro")+ , ("MT", "MoonlightTorrent")+ , ("NX", "NetTransport")+ , ("PD", "Pando")+ , ("qB", "qBittorrent")+ , ("QD", "QQDownload")+ , ("QT", "Qt4TorrentExample")+ , ("RT", "Retriever")+ , ("S~", "Shareaza")+ , ("SB", "Swiftbit")+ , ("SS", "SwarmScope")+ , ("ST", "SymTorrent")+ , ("st", "sharktorrent")+ , ("SZ", "Shareaza")+ , ("TN", "TorrentDotNET")+ , ("TR", "Transmission")+ , ("TS", "Torrentstorm")+ , ("TT", "TuoTu")+ , ("UL", "uLeecher")+ , ("UT", "uTorrent")+ , ("VG", "Vagaa")+ , ("WT", "BitLet")+ , ("WY", "FireTorrent")+ , ("XL", "Xunlei")+ , ("XT", "XanTorrent")+ , ("XX", "Xtorrent")+ , ("ZT", "ZipTorrent")+ ]+-}
src/Data/Torrent/InfoHash.hs view
@@ -12,10 +12,18 @@ module Data.Torrent.InfoHash ( -- * Info hash InfoHash(..)++ -- * Parsing , textToInfoHash- , addHashToURI++ -- * Rendering+ , longHex+ , shortHex , ppInfoHash + , addHashToURI++ , Data.Torrent.InfoHash.hash , Data.Torrent.InfoHash.hashlazy ) where@@ -38,7 +46,7 @@ import Data.URLEncoded as URL import Data.Serialize import Data.String-import Data.Text+import Data.Text as T import Data.Text.Encoding as T import Network.URI import Numeric@@ -111,13 +119,13 @@ hashLen = BS.length hashStr hashStr = T.encodeUtf8 text --- | Hash strict bytestring using SHA1 algorithm.-hash :: BS.ByteString -> InfoHash-hash = InfoHash . C.hash+-- | Hex encode infohash to text, full length.+longHex :: InfoHash -> Text+longHex = T.decodeUtf8 . Base16.encode . getInfoHash --- | Hash lazy bytestring using SHA1 algorithm.-hashlazy :: BL.ByteString -> InfoHash-hashlazy = InfoHash . C.hashlazy+-- | 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@@ -125,6 +133,14 @@ ppHex :: BS.ByteString -> BS.ByteString ppHex = BL.toStrict . B.toLazyByteString . B.byteStringHexFixed++-- | Hash strict bytestring using SHA1 algorithm.+hash :: BS.ByteString -> InfoHash+hash = InfoHash . C.hash++-- | Hash lazy bytestring using SHA1 algorithm.+hashlazy :: BL.ByteString -> InfoHash+hashlazy = InfoHash . C.hashlazy -- | Add query info hash parameter to uri. --
src/Data/Torrent/Layout.hs view
@@ -12,6 +12,9 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS -fno-warn-orphans #-} module Data.Torrent.Layout@@ -21,6 +24,7 @@ -- * Single file info , FileInfo (..)+ , ppFileInfo -- ** Lens , fileLength@@ -29,6 +33,8 @@ -- * File layout , LayoutInfo (..)+ , ppLayoutInfo+ , joinFilePath -- ** Lens , singleFile@@ -39,7 +45,8 @@ , isSingleFile , isMultiFile - -- ** Folds+ -- ** Query+ , suggestedName , contentLength , fileCount , blockCount@@ -64,13 +71,18 @@ import Data.BEncode.Types import Data.ByteString as BS import Data.ByteString.Char8 as BC-import Data.Char+import Data.Char as Char+import Data.Foldable as F import Data.List as L+import Data.Text as T+import Data.Text.Encoding as T import Data.Typeable+import Text.PrettyPrint as PP import System.FilePath import System.Posix.Types import Data.Torrent.Block+import Data.Torrent.InfoHash {-----------------------------------------------------------------------@@ -110,9 +122,11 @@ -- -- > ["dir1", "dir2", "file.ext"] --- } deriving (Show, Read, Eq, Typeable)+ } deriving (Show, Read, Eq, Typeable+ , Functor, Foldable+ ) -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''FileInfo)+$(deriveJSON (L.map Char.toLower . L.dropWhile isLower) ''FileInfo) makeLensesFor [ ("fiLength", "fileLength")@@ -161,6 +175,19 @@ fromBEncode = fromDict getFileInfoSingle {-# INLINE fromBEncode #-} +-- | Format 'FileInfo' in human-readable form.+ppFileInfo :: FileInfo ByteString -> Doc+ppFileInfo FileInfo {..} =+ "Path: " <> text (T.unpack (T.decodeUtf8 fiName))+ $$ "Size: " <> text (show fiLength)+ $$ maybe PP.empty ppMD5 fiMD5Sum+ where+ ppMD5 md5 = "MD5 : " <> text (show (InfoHash md5))++-- | Join file path.+joinFilePath :: FileInfo [ByteString] -> FileInfo ByteString+joinFilePath = fmap (BS.intercalate "/")+ {----------------------------------------------------------------------- -- Original torrent file layout info -----------------------------------------------------------------------}@@ -185,7 +212,7 @@ , liDirName :: !ByteString } deriving (Show, Read, Eq, Typeable) -$(deriveJSON (L.map toLower . L.dropWhile isLower) ''LayoutInfo)+$(deriveJSON (L.map Char.toLower . L.dropWhile isLower) ''LayoutInfo) makeLensesFor [ ("liFile" , "singleFile" )@@ -215,6 +242,11 @@ 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+ -- | Test if this is single file torrent. isSingleFile :: LayoutInfo -> Bool isSingleFile SingleFile {} = True@@ -227,10 +259,16 @@ isMultiFile _ = False {-# INLINE isMultiFile #-} +-- | Get name of the torrent based on the root path piece.+suggestedName :: LayoutInfo -> ByteString+suggestedName (SingleFile FileInfo {..}) = fiName+suggestedName MultiFile {..} = liDirName+{-# INLINE suggestedName #-}+ -- | Find sum of sizes of the all torrent files. contentLength :: LayoutInfo -> FileSize contentLength SingleFile { liFile = FileInfo {..} } = fiLength-contentLength MultiFile { liFiles = tfs } = sum (L.map fiLength tfs)+contentLength MultiFile { liFiles = tfs } = L.sum (L.map fiLength tfs) -- | Get number of all files in torrent. fileCount :: LayoutInfo -> Int
src/Data/Torrent/Magnet.hs view
@@ -13,10 +13,17 @@ -- Bittorrent specific info: -- <http://www.bittorrent.org/beps/bep_0009.html> --+{-# LANGUAGE NamedFieldPuns #-} module Data.Torrent.Magnet ( -- * Magnet Magnet(..)++ -- * Construction , nullMagnet+ , simpleMagnet+ , detailedMagnet++ -- * Conversion , parseMagnet , renderMagnet @@ -33,11 +40,13 @@ import Data.URLEncoded as URL import Data.String import Data.Text as T+import Data.Text.Encoding as T import Network.URI import Text.Read +import Data.Torrent import Data.Torrent.InfoHash-+import Data.Torrent.Layout {----------------------------------------------------------------------- -- URN@@ -151,6 +160,24 @@ , exactSource = Nothing , tracker = Nothing , supplement = M.empty+ }++-- | A simple magnet link including infohash ('xt' param) and display+-- name ('dn' param).+--+simpleMagnet :: Torrent -> Magnet+simpleMagnet Torrent {tInfoDict = InfoDict {..}}+ = (nullMagnet idInfoHash)+ { displayName = Just $ T.decodeUtf8 $ suggestedName idLayoutInfo+ }++-- | Like 'simpleMagnet' but also include exactLength ('xl' param) and+-- tracker ('tr' param).+detailedMagnet :: Torrent -> Magnet+detailedMagnet t @ Torrent {tInfoDict = InfoDict {..}, tAnnounce}+ = (simpleMagnet t)+ { exactLength = Just $ fromIntegral $ contentLength idLayoutInfo+ , tracker = Just tAnnounce } fromQuery :: URLEncoded -> Either String Magnet
src/Data/Torrent/Piece.hs view
@@ -194,8 +194,8 @@ -- | Format piece info in human readable form. Hashes are omitted. ppPieceInfo :: PieceInfo -> Doc-ppPieceInfo PieceInfo { piPieceLength = len } =- "PieceInfo" <+> braces ("length" <+> "=" <+> int len)+ppPieceInfo PieceInfo {..} =+ "Piece size: " <> int piPieceLength hashsize :: Int hashsize = 20
+ src/Data/Torrent/Progress.hs view
@@ -0,0 +1,129 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- 'Progress' used to track amount downloaded\/left\/upload bytes+-- either on per client or per torrent basis. This value is used to+-- notify the tracker and usually shown to the user. To aggregate+-- total progress you can use the Monoid instance.+--+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE ViewPatterns #-}+module Data.Torrent.Progress+ ( -- * Progress+ Progress (..)++ -- * Lens+ , left+ , uploaded+ , downloaded++ -- * Construction+ , startProgress+ , downloadedProgress+ , enqueuedProgress+ , uploadedProgress+ , dequeuedProgress++ -- * Query+ , canDownload+ , canUpload+ ) where++import Control.Applicative+import Control.Lens+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.Word+++-- | Progress data is considered as dynamic within one client+-- session. This data also should be shared across client application+-- sessions (e.g. files), otherwise use 'startProgress' to get initial+-- 'Progress' value.+--+data Progress = Progress+ { _downloaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes downloaded;+ , _left :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes left;+ , _uploaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes uploaded.+ } deriving (Show, Read, Eq)++$(makeLenses ''Progress)+$(deriveJSON L.tail ''Progress)++instance Serialize Progress where+ put Progress {..} = do+ putWord64be $ fromIntegral _downloaded+ putWord64be $ fromIntegral _left+ putWord64be $ fromIntegral _uploaded++ get = Progress+ <$> (fromIntegral <$> getWord64be)+ <*> (fromIntegral <$> getWord64be)+ <*> (fromIntegral <$> getWord64be)++instance Default Progress where+ def = Progress 0 0 0+ {-# INLINE def #-}++instance Monoid Progress where+ mempty = def+ {-# INLINE mempty #-}++ mappend (Progress da la ua) (Progress db lb ub) = Progress+ { _downloaded = da + db+ , _left = la + lb+ , _uploaded = ua + ub+ }+ {-# INLINE mappend #-}++-- | Initial progress is used when there are no session before.+--+-- Please note that tracker might penalize client some way if the do+-- not accumulate progress. If possible and save 'Progress' between+-- client sessions to avoid that.+--+startProgress :: Integer -> Progress+startProgress = Progress 0 0 . fromIntegral+{-# INLINE startProgress #-}++-- | Used when the client download some data from /any/ peer.+downloadedProgress :: Int -> Progress -> Progress+downloadedProgress (fromIntegral -> amount)+ = (left -~ amount)+ . (downloaded +~ amount)+{-# INLINE downloadedProgress #-}++-- | Used when the client upload some data to /any/ peer.+uploadedProgress :: Int -> Progress -> Progress+uploadedProgress (fromIntegral -> amount) = uploaded +~ amount+{-# INLINE uploadedProgress #-}++-- | Used when leecher join client session.+enqueuedProgress :: Integer -> Progress -> Progress+enqueuedProgress amount = left +~ fromIntegral amount+{-# INLINE enqueuedProgress #-}++-- | Used when leecher leave client session.+-- (e.g. user deletes not completed torrent)+dequeuedProgress :: Integer -> Progress -> Progress+dequeuedProgress amount = left -~ fromIntegral amount+{-# INLINE dequeuedProgress #-}++ri2rw64 :: Ratio Int -> Ratio Word64+ri2rw64 x = fromIntegral (numerator x) % fromIntegral (denominator x)++-- | Check global /download/ limit by uploaded \/ downloaded ratio.+canDownload :: Ratio Int -> Progress -> Bool+canDownload limit Progress {..} = _uploaded % _downloaded > ri2rw64 limit++-- | Check global /upload/ limit by downloaded \/ uploaded ratio.+canUpload :: Ratio Int -> Progress -> Bool+canUpload limit Progress {..} = _downloaded % _uploaded > ri2rw64 limit
+ src/Network/BitTorrent/Core/PeerAddr.hs view
@@ -0,0 +1,124 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- 'PeerAddr' is used to represent peer address. Currently it's+-- just peer IP and peer port but this might change in future.+--+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS -fno-warn-orphans #-} -- for PortNumber instances+module Network.BitTorrent.Core.PeerAddr+ ( -- * Peer address+ PeerAddr(..)+ , getCompactPeerList+ , peerSockAddr+ , connectToPeer+ , ppPeer+ ) where++import Control.Applicative+import Data.Aeson (ToJSON, FromJSON)+import Data.Aeson.TH+import Data.BEncode as BS+import Data.Bits+import Data.Char+import Data.List as L+import Data.Serialize as S+import Data.Typeable+import Data.Word+import Network.Socket+import Text.PrettyPrint++import Data.Torrent.Client+import Network.BitTorrent.Core.PeerId+++deriving instance ToJSON PortNumber+deriving instance FromJSON PortNumber++instance BEncode PortNumber where+ toBEncode = toBEncode . fromEnum+ fromBEncode b = toEnum <$> fromBEncode b++instance Serialize PortNumber where+ get = fromIntegral <$> getWord16be+ {-# INLINE get #-}+ put = putWord16be . fromIntegral+ {-# INLINE put #-}++-- TODO check semantic of ord and eq instances+-- TODO use SockAddr instead of peerIP and peerPort++-- | Peer address info normally extracted from peer list or peer+-- compact list encoding.+data PeerAddr = PeerAddr {+ peerID :: !(Maybe PeerId)+ , peerIP :: {-# UNPACK #-} !HostAddress+ , peerPort :: {-# UNPACK #-} !PortNumber+ } deriving (Show, Eq, Ord, Typeable)++$(deriveJSON (L.map toLower . L.dropWhile isLower) ''PeerAddr)++-- | The tracker "announce query" compatible encoding.+instance BEncode PeerAddr where+ toBEncode (PeerAddr pid pip pport) = toDict $+ "peer id" .=? pid+ .: "ip" .=! pip+ .: "port" .=! pport+ .: endDict++ fromBEncode = fromDict $ do+ PeerAddr <$>? "peer id"+ <*>! "ip"+ <*>! "port"++-- | The tracker "compact peer list" compatible encoding. The+-- 'peerId' is always 'Nothing'.+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++-- TODO make platform independent, clarify htonl++-- | Convert peer info from tracker response to socket address. Used+-- for establish connection between peers.+--+peerSockAddr :: PeerAddr -> SockAddr+peerSockAddr = SockAddrInet <$> (g . peerPort) <*> (htonl . peerIP)+ where+ htonl :: Word32 -> Word32+ htonl d =+ ((d .&. 0xff) `shiftL` 24) .|.+ (((d `shiftR` 8 ) .&. 0xff) `shiftL` 16) .|.+ (((d `shiftR` 16) .&. 0xff) `shiftL` 8) .|.+ ((d `shiftR` 24) .&. 0xff)++ g :: PortNumber -> PortNumber+ g = id++-- | Tries to connect to peer using reasonable default parameters.+connectToPeer :: PeerAddr -> IO Socket+connectToPeer p = do+ 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
@@ -0,0 +1,279 @@+-- |+-- Copyright : (c) Sam Truzjan 2013+-- License : BSD3+-- Maintainer : pxqr.sta@gmail.com+-- Stability : experimental+-- Portability : portable+--+-- 'PeerID' represent self assigned peer identificator. Ideally each+-- host in the network should have unique peer id to avoid+-- collisions, therefore for peer ID generation we use good entropy+-- source. (FIX not really) Peer ID is sent in /tracker request/,+-- sent and received in /peer handshakes/ and used in /distributed+-- hash table/ queries.+--+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module Network.BitTorrent.Core.PeerId+ ( -- * PeerId+ PeerId (getPeerId)+ , ppPeerId++ -- * Generation+ , genPeerId+ , timestamp+ , entropy++ -- * Encoding+ , azureusStyle+ , shadowStyle++ -- * Decoding+ , clientInfo++ -- ** Extra+ , byteStringPadded+ , defaultClientId+ , defaultVersionNumber+ ) where++import Control.Applicative+import Data.Aeson+import Data.BEncode as BE+import Data.ByteString 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.Monoid+import Data.Serialize as S+import Data.Time.Clock (getCurrentTime)+import Data.Time.Format (formatTime)+import Data.URLEncoded+import Data.Version (Version(Version), versionBranch)+import System.Entropy (getEntropy)+import System.Locale (defaultTimeLocale)+import Text.PrettyPrint hiding ((<>))+import Text.Read (readMaybe)+import Paths_bittorrent (version)++import Data.Torrent.Client++-- TODO use unpacked form (length is known statically)++-- | Peer identifier is exactly 20 bytes long bytestring.+newtype PeerId = PeerId { getPeerId :: ByteString }+ deriving (Show, Eq, Ord, BEncode, ToJSON, FromJSON)++instance Serialize PeerId where+ put = putByteString . getPeerId+ get = PeerId <$> getBytes 20++instance URLShow PeerId where+ urlShow = BC.unpack . getPeerId++-- | Format peer id in human readable form.+ppPeerId :: PeerId -> Doc+ppPeerId = text . BC.unpack . getPeerId++{-----------------------------------------------------------------------+-- Encoding+-----------------------------------------------------------------------}++-- | Pad bytestring so it's becomes exactly request length. Conversion+-- is done like so:+--+-- * length < size: Complete bytestring by given charaters.+--+-- * length = size: Output bytestring as is.+--+-- * length > size: Drop last (length - size) charaters from a+-- given bytestring.+--+byteStringPadded :: ByteString -- ^ bytestring to be padded.+ -> Int -- ^ size of result builder.+ -> Char -- ^ character used for padding.+ -> BS.Builder+byteStringPadded bs s c =+ BS.byteString (BS.take s bs) <>+ BS.byteString (BC.replicate padLen c)+ where+ padLen = s - min (BS.length bs) s++-- | Azureus-style encoding have the following layout:+--+-- * 1 byte : '-'+--+-- * 2 bytes: client id+--+-- * 4 bytes: version number+--+-- * 1 byte : '-'+--+-- * 12 bytes: random number+--+azureusStyle :: ByteString -- ^ 2 character client ID, padded with 'H'.+ -> ByteString -- ^ Version number, padded with 'X'.+ -> ByteString -- ^ Random number, padded with '0'.+ -> PeerId -- ^ Azureus-style encoded peer ID.+azureusStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $+ BS.char8 '-' <>+ byteStringPadded cid 2 'H' <>+ byteStringPadded ver 4 'X' <>+ BS.char8 '-' <>+ byteStringPadded rnd 12 '0'++-- | Shadow-style encoding have the following layout:+--+-- * 1 byte : client id.+--+-- * 0-4 bytes: version number. If less than 4 then padded with+-- '-' char.+--+-- * 15 bytes : random number. If length is less than 15 then+-- padded with '0' char.+--+shadowStyle :: Char -- ^ Client ID.+ -> ByteString -- ^ Version number.+ -> ByteString -- ^ Random number.+ -> PeerId -- ^ Shadow style encoded peer ID.+shadowStyle cid ver rnd = PeerId $ BL.toStrict $ BS.toLazyByteString $+ BS.char8 cid <>+ byteStringPadded ver 4 '-' <>+ byteStringPadded rnd 15 '0'+++-- | "HS" - 2 bytes long client identifier.+defaultClientId :: ByteString+defaultClientId = "HS"++-- | Gives exactly 4 bytes long version number for any version of the+-- package. Version is taken from .cabal.+defaultVersionNumber :: ByteString+defaultVersionNumber = BS.take 4 $ BC.pack $ foldMap show $+ versionBranch version++{-----------------------------------------------------------------------+-- Generation+-----------------------------------------------------------------------}++-- | Gives 15 characters long decimal timestamp such that:+--+-- * 6 bytes : first 6 characters from picoseconds obtained with %q.+--+-- * 1 bytes : character '.' for readability.+--+-- * 9..* bytes: number of whole seconds since the Unix epoch+-- (!)REVERSED.+--+-- Can be used both with shadow and azureus style encoding. This+-- format is used to make the ID's readable(for debugging) and more+-- or less random.+--+timestamp :: IO ByteString+timestamp = (BC.pack . format) <$> getCurrentTime+ where+ format t = L.take 6 (formatTime defaultTimeLocale "%q" t) ++ "." +++ L.take 9 (L.reverse (formatTime defaultTimeLocale "%s" t))++-- | Gives 15 character long random bytestring. This is more robust+-- method for generation of random part of peer ID than timestamp.+entropy :: IO ByteString+entropy = getEntropy 15++-- NOTE: entropy generates incorrrect peer id++-- | Here we use Azureus-style encoding with the following args:+--+-- * 'HS' for the client id.+--+-- * Version of the package for the version number+--+-- * UTC time day ++ day time for the random number.+--+genPeerId :: IO PeerId+genPeerId = azureusStyle defaultClientId defaultVersionNumber <$> timestamp++{-----------------------------------------------------------------------+-- Decoding+-----------------------------------------------------------------------}++parseImpl :: ByteString -> ClientImpl+parseImpl = f . BC.unpack+ where+ f "AG" = IAres+ f "A~" = IAres+ f "AR" = IArctic+ f "AV" = IAvicora+ f "AX" = IBitPump+ f "AZ" = IAzureus+ f "BB" = IBitBuddy+ f "BC" = IBitComet+ f "BF" = IBitflu+ f "BG" = IBTG+ f "BR" = IBitRocket+ f "BS" = IBTSlave+ f "BX" = IBittorrentX+ f "CD" = IEnhancedCTorrent+ f "CT" = ICTorrent+ f "DE" = IDelugeTorrent+ f "DP" = IPropagateDataClient+ f "EB" = IEBit+ f "ES" = IElectricSheep+ f "FT" = IFoxTorrent+ f "GS" = IGSTorrent+ f "HL" = IHalite+ f "HS" = IlibHSbittorrent+ f "HN" = IHydranode+ f "KG" = IKGet+ f "KT" = IKTorrent+ f "LH" = ILH_ABC+ f "LP" = ILphant+ f "LT" = ILibtorrent+ f "lt" = ILibTorrent+ f "LW" = ILimeWire+ f "MO" = IMonoTorrent+ f "MP" = IMooPolice+ f "MR" = IMiro+ f "MT" = IMoonlightTorrent+ f "NX" = INetTransport+ f "PD" = IPando+ f "qB" = IqBittorrent+ f "QD" = IQQDownload+ f "QT" = IQt4TorrentExample+ f "RT" = IRetriever+ f "S~" = IShareaza+ f "SB" = ISwiftbit+ f "SS" = ISwarmScope+ f "ST" = ISymTorrent+ f "st" = Isharktorrent+ f "SZ" = IShareaza+ f "TN" = ITorrentDotNET+ f "TR" = ITransmission+ f "TS" = ITorrentstorm+ f "TT" = ITuoTu+ f "UL" = IuLeecher+ f "UT" = IuTorrent+ f "VG" = IVagaa+ f "WT" = IBitLet+ f "WY" = IFireTorrent+ f "XL" = IXunlei+ f "XT" = IXanTorrent+ f "XX" = IXtorrent+ f "ZT" = IZipTorrent+ f _ = IUnknown++-- | 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+ mkVer bs = ClientVersion $ Version [fromMaybe 0 $ readMaybe $ BC.unpack bs] []