Get rid of the urlencoded package

* It uses slow String's instead of Text.
* It does not allow to encode infohash and peer ids properly.
* It does not provide API for query string parsing.

So it is better to use http-types package.

4 files changed, 35 insertions, 17 deletions

diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index e4b17c2b..d6227b6f 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -78,6 +78,7 @@ import           Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BC (pack, unpack)
 import qualified Data.ByteString.Lazy  as BL
 import           Data.Char as Char
+import           Data.Default
 import           Data.Hashable   as Hashable
 import qualified Data.List as L
 import           Data.Maybe
@@ -143,8 +144,7 @@ instance Hashable InfoDict where
 infoDictionary :: LayoutInfo -> PieceInfo -> Bool -> InfoDict
 infoDictionary li pinfo private = InfoDict ih li pinfo private
   where
-    ih = hashLazyIH $ encode $ InfoDict fake_ih li pinfo private
-    fake_ih = "0123456789012345678901234567890123456789"
+    ih = hashLazyIH $ encode $ InfoDict def li pinfo private
 
 getPrivate :: Get Bool
 getPrivate = (Just True ==) <$>? "private"
diff --git a/src/Data/Torrent/Progress.hs b/src/Data/Torrent/Progress.hs
index d0aa75c6..1a4a68e2 100644
--- a/src/Data/Torrent/Progress.hs
+++ b/src/Data/Torrent/Progress.hs
@@ -12,6 +12,7 @@
 --
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE ViewPatterns    #-}
+{-# OPTIONS -fno-warn-orphans #-}
 module Data.Torrent.Progress
        ( -- * Progress
          Progress (..)
@@ -36,13 +37,15 @@ module Data.Torrent.Progress
 import Control.Applicative
 import Control.Lens hiding ((%=))
 import Data.Aeson.TH
+import Data.ByteString.Lazy.Builder  as BS
+import Data.ByteString.Lazy.Builder.ASCII as BS
 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
+import Network.HTTP.Types.QueryLike
 import Text.PrettyPrint as PP
 import Text.PrettyPrint.Class
 
@@ -89,18 +92,19 @@ instance Monoid Progress where
     }
   {-# INLINE mappend #-}
 
-instance URLShow Word64 where
-  urlShow = show
-  {-# INLINE urlShow #-}
+instance QueryValueLike Builder where
+  toQueryValue = toQueryValue . BS.toLazyByteString
+
+instance QueryValueLike Word64 where
+  toQueryValue = toQueryValue . BS.word64Dec
 
 -- | HTTP Tracker protocol compatible encoding.
-instance URLEncode Progress where
-  urlEncode Progress {..} = mconcat
-    [ s "uploaded"   %=  _uploaded
-    , s "left"       %=  _left
-    , s "downloaded" %=  _downloaded
+instance QueryLike Progress where
+  toQuery Progress {..} =
+    [ ("uploaded"  , toQueryValue _uploaded)
+    , ("left"      , toQueryValue _left)
+    , ("downloaded", toQueryValue _downloaded)
     ]
-    where s :: String -> String;  s = id; {-# INLINE s #-}
 
 instance Pretty Progress where
   pretty Progress {..} =
diff --git a/src/Network/BitTorrent/Core/PeerId.hs b/src/Network/BitTorrent/Core/PeerId.hs
index a2b03e92..f5a40f29 100644
--- a/src/Network/BitTorrent/Core/PeerId.hs
+++ b/src/Network/BitTorrent/Core/PeerId.hs
@@ -46,12 +46,14 @@ import Data.List as L
 import Data.List.Split as L
 import Data.Maybe       (fromMaybe, catMaybes)
 import Data.Monoid
+import Data.Hashable
 import Data.Serialize as S
 import Data.String
 import Data.Time.Clock  (getCurrentTime)
 import Data.Time.Format (formatTime)
 import Data.URLEncoded
 import Data.Version     (Version(Version), versionBranch)
+import Network.HTTP.Types.QueryLike
 import System.Entropy   (getEntropy)
 import System.Locale    (defaultTimeLocale)
 import Text.PrettyPrint hiding ((<>))
@@ -70,12 +72,17 @@ newtype PeerId = PeerId { getPeerId :: ByteString }
 peerIdLen :: Int
 peerIdLen = 20
 
+instance Hashable PeerId where
+  hash = hash . getPeerId
+  {-# INLINE hash #-}
+
 instance Serialize PeerId where
   put = putByteString . getPeerId
   get = PeerId <$> getBytes peerIdLen
 
-instance URLShow PeerId where
-  urlShow = BC.unpack . getPeerId
+instance QueryValueLike PeerId where
+  toQueryValue (PeerId pid) = Just pid
+  {-# INLINE toQueryValue #-}
 
 instance IsString PeerId where
   fromString str
diff --git a/src/Network/BitTorrent/Tracker/Message.hs b/src/Network/BitTorrent/Tracker/Message.hs
index 59ef2027..e5d8b25a 100644
--- a/src/Network/BitTorrent/Tracker/Message.hs
+++ b/src/Network/BitTorrent/Tracker/Message.hs
@@ -66,6 +66,7 @@ import Data.Typeable
 import Data.URLEncoded as URL
 import Data.Word
 import Network
+import Network.HTTP.Types.QueryLike
 import Network.HTTP.Types.URI hiding (urlEncode)
 import Network.Socket
 import Network.URI
@@ -173,15 +174,21 @@ instance URLShow Word32 where
 -- | HTTP tracker protocol compatible encoding.
 instance URLEncode AnnounceQuery where
   urlEncode AnnounceQuery {..} = mconcat
-      [ s "peer_id"    %=  reqPeerId
-      , s "port"       %=  reqPort
-      , urlEncode reqProgress
+      [ -- s "peer_id"    %=  reqPeerId
+        s "port"       %=  reqPort
+--      , urlEncode reqProgress
       , s "ip"         %=? reqIP
       , s "numwant"    %=? reqNumWant
       , s "event"      %=? reqEvent
       ]
     where s :: String -> String;  s = id; {-# INLINE s #-}
 
+instance QueryLike AnnounceQuery where
+  toQuery AnnounceQuery {..} =
+    [ ("info_hash", toQueryValue reqInfoHash)
+    , ("peer_id"  , toQueryValue reqPeerId)
+    ]
+
 -- | UDP tracker protocol compatible encoding.
 instance Serialize AnnounceQuery where
   put AnnounceQuery {..} = do