From cdd1782b0d55ed0119ac905904437ab8209f7cf2 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Wed, 20 Nov 2013 22:01:34 +0400 Subject: Refactor Network.BitTorrent.Peer module --- src/Data/Torrent/Client.hs | 233 +++++++++++++++++++++++++++++++++++++++++++ src/Data/Torrent/Progress.hs | 95 ++++++++++++++++++ 2 files changed, 328 insertions(+) create mode 100644 src/Data/Torrent/Client.hs create mode 100644 src/Data/Torrent/Progress.hs (limited to 'src/Data/Torrent') diff --git a/src/Data/Torrent/Client.hs b/src/Data/Torrent/Client.hs new file mode 100644 index 00000000..b6649e04 --- /dev/null +++ b/src/Data/Torrent/Client.hs @@ -0,0 +1,233 @@ +-- | +-- 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 frienly form: this is useful for debugging and +-- logging. For more information see: +-- 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 + ( ClientImpl (..) + , ppClientImpl + + , ClientVersion (..) + , ppClientVersion + + , 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) + + +-- | All known client versions. +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 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 + +-- | Raw version of client, normally extracted from peer id. +newtype ClientVersion = ClientVersion { getClientVersion :: Version } + deriving (Show, Eq, Ord) + +instance Default ClientVersion where + def = ClientVersion $ Version [0] [] + +-- | Format client implementation version in human readable form. +ppClientVersion :: ClientVersion -> Doc +ppClientVersion = text . showVersion . getClientVersion + +-- | All useful infomation that can be obtained from a peer +-- identifier. +data ClientInfo = ClientInfo { + ciImpl :: ClientImpl + , ciVersion :: ClientVersion + } deriving (Show, Eq, Ord) + +-- | Unrecognized client implementation. +instance Default ClientInfo where + def = ClientInfo def def + +-- | Format client implementation in human readable form. +ppClientInfo :: ClientInfo -> Doc +ppClientInfo ClientInfo {..} = + ppClientImpl ciImpl <+> "version" <+> ppClientVersion ciVersion + +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") + ] +-} diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs new file mode 100644 index 00000000..c1515cf0 --- /dev/null +++ b/src/Data/Torrent/Progress.hs @@ -0,0 +1,95 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} +module Data.Torrent.Progress + ( -- * Peer progress + Progress (..) + , left + , uploaded + , downloaded + + , startProgress + + , downloadedProgress + , enqueuedProgress + , uploadedProgress + , dequeuedProgress + + ) where + +import Control.Applicative +import Control.Lens +import Data.Aeson.TH +import Data.List as L +import Data.Default +import Data.Serialize as S + + +-- TODO: Use Word64? +-- TODO: Use atomic bits? + +-- | 'Progress' contains upload/download/left stats about +-- current client state and used to notify the tracker. +-- +-- 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'. +-- +data Progress = Progress + { _downloaded :: !Integer -- ^ Total amount of bytes downloaded; + , _left :: !Integer -- ^ Total amount of bytes left; + , _uploaded :: !Integer -- ^ 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 #-} + +-- TODO Monoid instance + +-- | 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 +{-# 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 +~ amount +{-# INLINE enqueuedProgress #-} + +-- | Used when leecher leave client session. +-- (e.g. user deletes not completed torrent) +dequeuedProgress :: Integer -> Progress -> Progress +dequeuedProgress amount = left -~ amount +{-# INLINE dequeuedProgress #-} -- cgit v1.2.3