2 files changed, 19 insertions, 5 deletions

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