summaryrefslogtreecommitdiff
path: root/src/Data/Torrent/Progress.hs
diff options
context:
space:
mode:
authorSam Truzjan <pxqr.sta@gmail.com>2014-04-26 07:42:57 +0400
committerSam Truzjan <pxqr.sta@gmail.com>2014-04-26 07:42:57 +0400
commita7fda9d39ed82cb9d3ad0c28e76e88e59539a492 (patch)
tree925183a691bbb57ca5f7140614e1fdbc610b3b1e /src/Data/Torrent/Progress.hs
parent4587ffd5406162bb06a6549ffd2ff277e0a93916 (diff)
parent85bf8475bbbce79b1bedde641192fa945614283d (diff)
Merge branch 'tidy' into dev
Diffstat (limited to 'src/Data/Torrent/Progress.hs')
-rw-r--r--src/Data/Torrent/Progress.hs155
1 files changed, 0 insertions, 155 deletions
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 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- 'Progress' used to track amount downloaded\/left\/upload bytes
9-- either on per client or per torrent basis. This value is used to
10-- notify the tracker and usually shown to the user. To aggregate
11-- total progress you can use the Monoid instance.
12--
13{-# LANGUAGE TemplateHaskell #-}
14{-# LANGUAGE ViewPatterns #-}
15{-# OPTIONS -fno-warn-orphans #-}
16module Data.Torrent.Progress
17 ( -- * Progress
18 Progress (..)
19
20 -- * Lens
21 , left
22 , uploaded
23 , downloaded
24
25 -- * Construction
26 , startProgress
27 , downloadedProgress
28 , enqueuedProgress
29 , uploadedProgress
30 , dequeuedProgress
31
32 -- * Query
33 , canDownload
34 , canUpload
35 ) where
36
37import Control.Applicative
38import Control.Lens hiding ((%=))
39import Data.ByteString.Lazy.Builder as BS
40import Data.ByteString.Lazy.Builder.ASCII as BS
41import Data.Default
42import Data.List as L
43import Data.Monoid
44import Data.Serialize as S
45import Data.Ratio
46import Data.Word
47import Network.HTTP.Types.QueryLike
48import Text.PrettyPrint as PP
49import Text.PrettyPrint.Class
50
51
52-- | Progress data is considered as dynamic within one client
53-- session. This data also should be shared across client application
54-- sessions (e.g. files), otherwise use 'startProgress' to get initial
55-- 'Progress' value.
56--
57data Progress = Progress
58 { _downloaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes downloaded;
59 , _left :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes left;
60 , _uploaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes uploaded.
61 } deriving (Show, Read, Eq)
62
63$(makeLenses ''Progress)
64
65-- | UDP tracker compatible encoding.
66instance Serialize Progress where
67 put Progress {..} = do
68 putWord64be $ fromIntegral _downloaded
69 putWord64be $ fromIntegral _left
70 putWord64be $ fromIntegral _uploaded
71
72 get = Progress
73 <$> (fromIntegral <$> getWord64be)
74 <*> (fromIntegral <$> getWord64be)
75 <*> (fromIntegral <$> getWord64be)
76
77instance Default Progress where
78 def = Progress 0 0 0
79 {-# INLINE def #-}
80
81-- | Can be used to aggregate total progress.
82instance Monoid Progress where
83 mempty = def
84 {-# INLINE mempty #-}
85
86 mappend (Progress da la ua) (Progress db lb ub) = Progress
87 { _downloaded = da + db
88 , _left = la + lb
89 , _uploaded = ua + ub
90 }
91 {-# INLINE mappend #-}
92
93instance QueryValueLike Builder where
94 toQueryValue = toQueryValue . BS.toLazyByteString
95
96instance QueryValueLike Word64 where
97 toQueryValue = toQueryValue . BS.word64Dec
98
99-- | HTTP Tracker protocol compatible encoding.
100instance QueryLike Progress where
101 toQuery Progress {..} =
102 [ ("uploaded" , toQueryValue _uploaded)
103 , ("left" , toQueryValue _left)
104 , ("downloaded", toQueryValue _downloaded)
105 ]
106
107instance Pretty Progress where
108 pretty Progress {..} =
109 "/\\" <+> PP.text (show _uploaded) $$
110 "\\/" <+> PP.text (show _downloaded) $$
111 "left" <+> PP.text (show _left)
112
113-- | Initial progress is used when there are no session before.
114--
115-- Please note that tracker might penalize client some way if the do
116-- not accumulate progress. If possible and save 'Progress' between
117-- client sessions to avoid that.
118--
119startProgress :: Integer -> Progress
120startProgress = Progress 0 0 . fromIntegral
121{-# INLINE startProgress #-}
122
123-- | Used when the client download some data from /any/ peer.
124downloadedProgress :: Int -> Progress -> Progress
125downloadedProgress (fromIntegral -> amount)
126 = (left -~ amount)
127 . (downloaded +~ amount)
128{-# INLINE downloadedProgress #-}
129
130-- | Used when the client upload some data to /any/ peer.
131uploadedProgress :: Int -> Progress -> Progress
132uploadedProgress (fromIntegral -> amount) = uploaded +~ amount
133{-# INLINE uploadedProgress #-}
134
135-- | Used when leecher join client session.
136enqueuedProgress :: Integer -> Progress -> Progress
137enqueuedProgress amount = left +~ fromIntegral amount
138{-# INLINE enqueuedProgress #-}
139
140-- | Used when leecher leave client session.
141-- (e.g. user deletes not completed torrent)
142dequeuedProgress :: Integer -> Progress -> Progress
143dequeuedProgress amount = left -~ fromIntegral amount
144{-# INLINE dequeuedProgress #-}
145
146ri2rw64 :: Ratio Int -> Ratio Word64
147ri2rw64 x = fromIntegral (numerator x) % fromIntegral (denominator x)
148
149-- | Check global /download/ limit by uploaded \/ downloaded ratio.
150canDownload :: Ratio Int -> Progress -> Bool
151canDownload limit Progress {..} = _uploaded % _downloaded > ri2rw64 limit
152
153-- | Check global /upload/ limit by downloaded \/ uploaded ratio.
154canUpload :: Ratio Int -> Progress -> Bool
155canUpload limit Progress {..} = _downloaded % _uploaded > ri2rw64 limit