From 6634363e46211ebb65bae32d4e6cccd940f401c1 Mon Sep 17 00:00:00 2001
From: Sam Truzjan <pxqr.sta@gmail.com>
Date: Thu, 21 Nov 2013 22:19:23 +0400
Subject: Refactor tracker messages

---
 src/Data/Torrent/Progress.hs | 18 +++++++++++++++++-
 1 file changed, 17 insertions(+), 1 deletion(-)

(limited to 'src/Data')

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
-- 
cgit v1.2.3