From 9c7227c5c0cac81351684ccfa2f49d6b97bedf03 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Tue, 8 Apr 2014 05:37:34 +0400 Subject: Hide progress module --- bittorrent.cabal | 6 +- src/Data/Torrent/Progress.hs | 155 ---------------------- src/Network/BitTorrent/Internal/Progress.hs | 154 +++++++++++++++++++++ src/Network/BitTorrent/Tracker/Message.hs | 3 +- src/Network/BitTorrent/Tracker/RPC.hs | 2 +- tests/Data/Torrent/ProgressSpec.hs | 13 -- tests/Network/BitTorrent/Internal/ProgressSpec.hs | 13 ++ tests/Network/BitTorrent/Tracker/MessageSpec.hs | 2 +- tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs | 2 +- 9 files changed, 175 insertions(+), 175 deletions(-) delete mode 100644 src/Data/Torrent/Progress.hs create mode 100644 src/Network/BitTorrent/Internal/Progress.hs delete mode 100644 tests/Data/Torrent/ProgressSpec.hs create mode 100644 tests/Network/BitTorrent/Internal/ProgressSpec.hs diff --git a/bittorrent.cabal b/bittorrent.cabal index 0ceec550..d8cf0a01 100644 --- a/bittorrent.cabal +++ b/bittorrent.cabal @@ -49,7 +49,7 @@ library , RecordWildCards hs-source-dirs: src exposed-modules: Data.Torrent - Data.Torrent.Progress + Network.BitTorrent Network.BitTorrent.Address Network.BitTorrent.Client @@ -84,12 +84,14 @@ library if flag(testing) exposed-modules: Network.BitTorrent.Internal.Cache + Network.BitTorrent.Internal.Progress Network.BitTorrent.Internal.Types System.Torrent.FileMap System.Torrent.Tree else other-modules: Network.BitTorrent.Internal.Cache + Network.BitTorrent.Internal.Progress Network.BitTorrent.Internal.Types System.Torrent.FileMap System.Torrent.Tree @@ -185,7 +187,6 @@ test-suite spec Config Data.TorrentSpec - Data.Torrent.ProgressSpec Network.BitTorrent.Client.HandleSpec Network.BitTorrent.CoreSpec Network.BitTorrent.DHTSpec @@ -196,6 +197,7 @@ test-suite spec Network.BitTorrent.DHT.SessionSpec Network.BitTorrent.DHT.TokenSpec Network.BitTorrent.Internal.CacheSpec + Network.BitTorrent.Internal.ProgressSpec Network.BitTorrent.Tracker.TestData Network.BitTorrent.Tracker.ListSpec Network.BitTorrent.Tracker.MessageSpec diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs deleted file mode 100644 index 4719020a..00000000 --- a/src/Data/Torrent/Progress.hs +++ /dev/null @@ -1,155 +0,0 @@ --- | --- 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 #-} -{-# OPTIONS -fno-warn-orphans #-} -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 hiding ((%=)) -import Data.ByteString.Lazy.Builder as BS -import Data.ByteString.Lazy.Builder.ASCII as BS -import Data.Default -import Data.List as L -import Data.Monoid -import Data.Serialize as S -import Data.Ratio -import Data.Word -import Network.HTTP.Types.QueryLike -import Text.PrettyPrint as PP -import Text.PrettyPrint.Class - - --- | 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) - --- | UDP tracker compatible encoding. -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 #-} - --- | Can be used to aggregate total progress. -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 #-} - -instance QueryValueLike Builder where - toQueryValue = toQueryValue . BS.toLazyByteString - -instance QueryValueLike Word64 where - toQueryValue = toQueryValue . BS.word64Dec - --- | HTTP Tracker protocol compatible encoding. -instance QueryLike Progress where - toQuery Progress {..} = - [ ("uploaded" , toQueryValue _uploaded) - , ("left" , toQueryValue _left) - , ("downloaded", toQueryValue _downloaded) - ] - -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. --- --- 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 diff --git a/src/Network/BitTorrent/Internal/Progress.hs b/src/Network/BitTorrent/Internal/Progress.hs new file mode 100644 index 00000000..9aff9935 --- /dev/null +++ b/src/Network/BitTorrent/Internal/Progress.hs @@ -0,0 +1,154 @@ +-- | +-- 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 #-} +{-# OPTIONS -fno-warn-orphans #-} +module Network.BitTorrent.Internal.Progress + ( -- * Progress + Progress (..) + + -- * Lens + , left + , uploaded + , downloaded + + -- * Construction + , startProgress + , downloadedProgress + , enqueuedProgress + , uploadedProgress + , dequeuedProgress + + -- * Query + , canDownload + , canUpload + ) where + +import Control.Applicative +import Control.Lens hiding ((%=)) +import Data.ByteString.Lazy.Builder as BS +import Data.ByteString.Lazy.Builder.ASCII as BS +import Data.Default +import Data.Monoid +import Data.Serialize as S +import Data.Ratio +import Data.Word +import Network.HTTP.Types.QueryLike +import Text.PrettyPrint as PP +import Text.PrettyPrint.Class + + +-- | 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) + +-- | UDP tracker compatible encoding. +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 #-} + +-- | Can be used to aggregate total progress. +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 #-} + +instance QueryValueLike Builder where + toQueryValue = toQueryValue . BS.toLazyByteString + +instance QueryValueLike Word64 where + toQueryValue = toQueryValue . BS.word64Dec + +-- | HTTP Tracker protocol compatible encoding. +instance QueryLike Progress where + toQuery Progress {..} = + [ ("uploaded" , toQueryValue _uploaded) + , ("left" , toQueryValue _left) + , ("downloaded", toQueryValue _downloaded) + ] + +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. +-- +-- 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 diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs index d251d0ad..e4a41045 100644 --- a/src/Network/BitTorrent/Tracker/Message.hs +++ b/src/Network/BitTorrent/Tracker/Message.hs @@ -125,9 +125,8 @@ import System.Entropy import Text.Read (readMaybe) import Data.Torrent -import Data.Torrent.Progress import Network.BitTorrent.Address - +import Network.BitTorrent.Internal.Progress {----------------------------------------------------------------------- -- Events diff --git a/src/Network/BitTorrent/Tracker/RPC.hs b/src/Network/BitTorrent/Tracker/RPC.hs index ecb1001c..6fd22b25 100644 --- a/src/Network/BitTorrent/Tracker/RPC.hs +++ b/src/Network/BitTorrent/Tracker/RPC.hs @@ -37,8 +37,8 @@ import Network.URI import Network.Socket (HostAddress) import Data.Torrent -import Data.Torrent.Progress import Network.BitTorrent.Address +import Network.BitTorrent.Internal.Progress import Network.BitTorrent.Tracker.Message import qualified Network.BitTorrent.Tracker.RPC.HTTP as HTTP import qualified Network.BitTorrent.Tracker.RPC.UDP as UDP diff --git a/tests/Data/Torrent/ProgressSpec.hs b/tests/Data/Torrent/ProgressSpec.hs deleted file mode 100644 index 32efbd7a..00000000 --- a/tests/Data/Torrent/ProgressSpec.hs +++ /dev/null @@ -1,13 +0,0 @@ -{-# OPTIONS -fno-warn-orphans #-} -module Data.Torrent.ProgressSpec (spec) where -import Control.Applicative -import Test.Hspec -import Test.QuickCheck -import Data.Torrent.Progress - - -instance Arbitrary Progress where - arbitrary = Progress <$> arbitrary <*> arbitrary <*> arbitrary - -spec :: Spec -spec = return () diff --git a/tests/Network/BitTorrent/Internal/ProgressSpec.hs b/tests/Network/BitTorrent/Internal/ProgressSpec.hs new file mode 100644 index 00000000..acbfd84c --- /dev/null +++ b/tests/Network/BitTorrent/Internal/ProgressSpec.hs @@ -0,0 +1,13 @@ +{-# OPTIONS -fno-warn-orphans #-} +module Network.BitTorrent.Internal.ProgressSpec (spec) where +import Control.Applicative +import Test.Hspec +import Test.QuickCheck +import Network.BitTorrent.Internal.Progress + + +instance Arbitrary Progress where + arbitrary = Progress <$> arbitrary <*> arbitrary <*> arbitrary + +spec :: Spec +spec = return () diff --git a/tests/Network/BitTorrent/Tracker/MessageSpec.hs b/tests/Network/BitTorrent/Tracker/MessageSpec.hs index 92fd8d79..29854d58 100644 --- a/tests/Network/BitTorrent/Tracker/MessageSpec.hs +++ b/tests/Network/BitTorrent/Tracker/MessageSpec.hs @@ -17,7 +17,7 @@ import Test.Hspec import Test.QuickCheck import Data.TorrentSpec () -import Data.Torrent.ProgressSpec () +import Network.BitTorrent.Internal.ProgressSpec () import Network.BitTorrent.Address () import Network.BitTorrent.Address () diff --git a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs index 65f58911..e928f917 100644 --- a/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs +++ b/tests/Network/BitTorrent/Tracker/RPC/HTTPSpec.hs @@ -5,7 +5,7 @@ import Data.Default import Data.List as L import Test.Hspec -import Data.Torrent.Progress +import Network.BitTorrent.Internal.Progress import Network.BitTorrent.Tracker.Message as Message import Network.BitTorrent.Tracker.RPC.HTTP -- cgit v1.2.3