1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
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
|
