summaryrefslogtreecommitdiff
path: root/bittorrent/src/Network/BitTorrent/Internal/Progress.hs
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-09-28 13:43:29 -0400
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:27:53 -0500
commit11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch)
tree5716463275c2d3e902889db619908ded2a73971c /bittorrent/src/Network/BitTorrent/Internal/Progress.hs
parentadd2c76bced51fde5e9917e7449ef52be70faf87 (diff)
Factor out some new libraries
word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search
Diffstat (limited to 'bittorrent/src/Network/BitTorrent/Internal/Progress.hs')
-rw-r--r--bittorrent/src/Network/BitTorrent/Internal/Progress.hs154
1 files changed, 0 insertions, 154 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Internal/Progress.hs b/bittorrent/src/Network/BitTorrent/Internal/Progress.hs
deleted file mode 100644
index 6ac889e2..00000000
--- a/bittorrent/src/Network/BitTorrent/Internal/Progress.hs
+++ /dev/null
@@ -1,154 +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 Network.BitTorrent.Internal.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.Monoid
43import Data.Serialize as S
44import Data.Ratio
45import Data.Word
46import Network.HTTP.Types.QueryLike
47import Text.PrettyPrint as PP
48import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
49
50
51-- | Progress data is considered as dynamic within one client
52-- session. This data also should be shared across client application
53-- sessions (e.g. files), otherwise use 'startProgress' to get initial
54-- 'Progress' value.
55--
56data Progress = Progress
57 { _downloaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes downloaded;
58 , _left :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes left;
59 , _uploaded :: {-# UNPACK #-} !Word64 -- ^ Total amount of bytes uploaded.
60 } deriving (Show, Read, Eq)
61
62$(makeLenses ''Progress)
63
64-- | UDP tracker compatible encoding.
65instance Serialize Progress where
66 put Progress {..} = do
67 putWord64be $ fromIntegral _downloaded
68 putWord64be $ fromIntegral _left
69 putWord64be $ fromIntegral _uploaded
70
71 get = Progress
72 <$> (fromIntegral <$> getWord64be)
73 <*> (fromIntegral <$> getWord64be)
74 <*> (fromIntegral <$> getWord64be)
75
76instance Default Progress where
77 def = Progress 0 0 0
78 {-# INLINE def #-}
79
80-- | Can be used to aggregate total progress.
81instance Monoid Progress where
82 mempty = def
83 {-# INLINE mempty #-}
84
85 mappend (Progress da la ua) (Progress db lb ub) = Progress
86 { _downloaded = da + db
87 , _left = la + lb
88 , _uploaded = ua + ub
89 }
90 {-# INLINE mappend #-}
91
92instance QueryValueLike Builder where
93 toQueryValue = toQueryValue . BS.toLazyByteString
94
95instance QueryValueLike Word64 where
96 toQueryValue = toQueryValue . BS.word64Dec
97
98-- | HTTP Tracker protocol compatible encoding.
99instance QueryLike Progress where
100 toQuery Progress {..} =
101 [ ("uploaded" , toQueryValue _uploaded)
102 , ("left" , toQueryValue _left)
103 , ("downloaded", toQueryValue _downloaded)
104 ]
105
106instance Pretty Progress where
107 pPrint Progress {..} =
108 "/\\" <+> PP.text (show _uploaded) $$
109 "\\/" <+> PP.text (show _downloaded) $$
110 "left" <+> PP.text (show _left)
111
112-- | Initial progress is used when there are no session before.
113--
114-- Please note that tracker might penalize client some way if the do
115-- not accumulate progress. If possible and save 'Progress' between
116-- client sessions to avoid that.
117--
118startProgress :: Integer -> Progress
119startProgress = Progress 0 0 . fromIntegral
120{-# INLINE startProgress #-}
121
122-- | Used when the client download some data from /any/ peer.
123downloadedProgress :: Int -> Progress -> Progress
124downloadedProgress (fromIntegral -> amount)
125 = (left -~ amount)
126 . (downloaded +~ amount)
127{-# INLINE downloadedProgress #-}
128
129-- | Used when the client upload some data to /any/ peer.
130uploadedProgress :: Int -> Progress -> Progress
131uploadedProgress (fromIntegral -> amount) = uploaded +~ amount
132{-# INLINE uploadedProgress #-}
133
134-- | Used when leecher join client session.
135enqueuedProgress :: Integer -> Progress -> Progress
136enqueuedProgress amount = left +~ fromIntegral amount
137{-# INLINE enqueuedProgress #-}
138
139-- | Used when leecher leave client session.
140-- (e.g. user deletes not completed torrent)
141dequeuedProgress :: Integer -> Progress -> Progress
142dequeuedProgress amount = left -~ fromIntegral amount
143{-# INLINE dequeuedProgress #-}
144
145ri2rw64 :: Ratio Int -> Ratio Word64
146ri2rw64 x = fromIntegral (numerator x) % fromIntegral (denominator x)
147
148-- | Check global /download/ limit by uploaded \/ downloaded ratio.
149canDownload :: Ratio Int -> Progress -> Bool
150canDownload limit Progress {..} = _uploaded % _downloaded > ri2rw64 limit
151
152-- | Check global /upload/ limit by downloaded \/ uploaded ratio.
153canUpload :: Ratio Int -> Progress -> Bool
154canUpload limit Progress {..} = _downloaded % _uploaded > ri2rw64 limit