Refactor tracker messages

1 files changed, 17 insertions, 1 deletions

diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index c42af248..18a9cd7d 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -34,13 +34,14 @@ module Data.Torrent.Progress
        ) where
 
 import Control.Applicative
-import Control.Lens
+import Control.Lens hiding ((%=))
 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.URLEncoded
 import Data.Word
 
 
@@ -58,6 +59,7 @@ data Progress = Progress
 $(makeLenses ''Progress)
 $(deriveJSON L.tail ''Progress)
 
+-- | UDP tracker compatible encoding.
 instance Serialize Progress where
   put Progress {..} = do
     putWord64be $ fromIntegral _downloaded
@@ -73,6 +75,7 @@ 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 #-}
@@ -84,6 +87,19 @@ instance Monoid Progress where
     }
   {-# INLINE mappend #-}
 
+instance URLShow Word64 where
+  urlShow = show
+  {-# INLINE urlShow #-}
+
+-- | HTTP Tracker protocol compatible encoding.
+instance URLEncode Progress where
+  urlEncode Progress {..} = mconcat
+    [ s "uploaded"   %=  _uploaded
+    , s "left"       %=  _left
+    , s "downloaded" %=  _downloaded
+    ]
+    where s :: String -> String;  s = id; {-# INLINE s #-}
+
 -- | Initial progress is used when there are no session before.
 --
 -- Please note that tracker might penalize client some way if the do