~ Group AnnounceQuery progress fields to Progress.

1 files changed, 85 insertions, 3 deletions

diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index a4d026dc..d951a1cd 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -28,6 +28,7 @@
 --     capabilities (such as supported enchancements), this should be
 --     done using 'Network.BitTorrent.Extension'!
 --
+{-# LANGUAGE ViewPatterns               #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving         #-}
 {-# LANGUAGE TemplateHaskell            #-}
@@ -56,6 +57,19 @@ module Network.BitTorrent.Peer
        , connectToPeer
        , ppPeer
 
+         -- * Peer progress
+       , Progress (..)
+       , left
+       , uploaded
+       , downloaded
+
+       , startProgress
+
+       , downloadedProgress
+       , enqueuedProgress
+       , uploadedProgress
+       , dequeuedProgress
+
          -- * Client version detection
          -- ** Info
        , ClientInfo(..), clientInfo, ppClientInfo, unknownClient
@@ -70,18 +84,19 @@ module Network.BitTorrent.Peer
 
 
 import Control.Applicative
+import Control.Lens
 import Data.Aeson
 import Data.Aeson.TH
 import Data.BEncode
 import Data.Bits
-import Data.Char
-import Data.List as L
-import Data.Word
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Lazy.Builder as B
+import Data.Char
+import Data.List as L
+import Data.Word
 import Data.Foldable    (foldMap)
 import Data.Monoid      ((<>))
 import Data.Serialize
@@ -577,3 +592,70 @@ ppPeer p @ PeerAddr {..} = case peerID of
     Nothing  -> paddr
   where
     paddr = text (show (peerSockAddr p))
+
+{-----------------------------------------------------------------------
+  Progress
+-----------------------------------------------------------------------}
+
+-- 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)
+
+-- | 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
+
+-- | 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 #-}