7 files changed, 82 insertions, 25 deletions

diff --git a/network-bittorrent.cabal b/network-bittorrent.cabal
index 903c7ae7..399b0c7c 100644
--- a/network-bittorrent.cabal
+++ b/network-bittorrent.cabal
@@ -18,6 +18,7 @@ source-repository head
 
 library
   exposed-modules:     Data.Torrent
+                     , Data.Torrent.InfoHash
                      , Network.Torrent
                      , Network.Torrent.PeerID
                      , Network.Torrent.Tracker
@@ -101,6 +102,7 @@ test-suite encoding
                      , test-framework
                      , test-framework-quickcheck2
                      , QuickCheck
+                     , network    >= 2.4.0.13
                      , network-bittorrent >= 0.1.0.0
 
   ghc-options:         -Wall -fno-warn-orphans
diff --git a/src/Data/Torrent.hs b/src/Data/Torrent.hs
index 128c1c7c..57831acf 100644
--- a/src/Data/Torrent.hs
+++ b/src/Data/Torrent.hs
@@ -2,7 +2,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 -- | This module provides torrent metainfo serialization.
 module Data.Torrent
-       ( Torrent(..), TorrentInfo(..), TorrentFile(..)
+       ( module Data.Torrent.InfoHash
+       , Torrent(..), TorrentInfo(..), TorrentFile(..)
        , fromFile
        ) where
 
@@ -13,8 +14,8 @@ import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC (pack, unpack)
 import           Data.Text (Text)
-import Crypto.Hash.SHA1
 import Data.BEncode
+import Data.Torrent.InfoHash
 import Network.URI
 
 type Time = Text
@@ -22,7 +23,7 @@ type Time = Text
 -- TODO comment fields
 -- TODO more convenient form of torrent info.
 data Torrent = Torrent {
-      tInfoHash     :: ByteString
+      tInfoHash     :: InfoHash
     , tAnnounce     ::       URI
     , tAnnounceList :: Maybe [[URI]]
     , tComment      :: Maybe Text
@@ -148,4 +149,4 @@ instance BEncodable TorrentFile where
 
 
 fromFile :: FilePath -> IO (Result Torrent)
-fromFile path = (fromBEncode <=< decode) <$> B.readFile path
+fromFile filepath = (fromBEncode <=< decode) <$> B.readFile filepath
diff --git a/src/Data/Torrent/InfoHash.hs b/src/Data/Torrent/InfoHash.hs
new file mode 100644
index 00000000..448e9a5a
--- /dev/null
+++ b/src/Data/Torrent/InfoHash.hs
@@ -0,0 +1,41 @@
+module Data.Torrent.InfoHash
+       ( InfoHash (getInfoHash)
+
+         -- ^ Construction
+       , hash, hashlazy
+
+         -- ^ Extra
+       , ppHex
+       ) where
+
+import Control.Applicative
+import Data.Foldable
+import           Data.ByteString (ByteString)
+import qualified Data.ByteString as B
+import qualified Data.ByteString.Char8 as BC
+import qualified Data.ByteString.Builder as B
+import qualified Data.ByteString.Builder.Prim as B
+import qualified Data.ByteString.Lazy as Lazy
+import Data.Serialize
+import qualified Crypto.Hash.SHA1 as C
+
+-- | Exactly 20 bytes long SHA1 hash.
+newtype InfoHash = InfoHash { getInfoHash :: ByteString }
+                   deriving (Eq, Ord)
+
+instance Show InfoHash where
+  show = BC.unpack . ppHex
+
+instance Serialize InfoHash where
+  put = putByteString . getInfoHash
+  get = InfoHash <$> getBytes 20
+
+hash :: ByteString -> InfoHash
+hash = InfoHash . C.hash
+
+hashlazy :: Lazy.ByteString -> InfoHash
+hashlazy = InfoHash . C.hashlazy
+
+ppHex :: InfoHash -> ByteString
+ppHex = Lazy.toStrict . B.toLazyByteString .
+        foldMap (B.primFixed B.word8HexFixed) . B.unpack . getInfoHash
diff --git a/src/Network/Torrent/PeerWire/Handshake.hs b/src/Network/Torrent/PeerWire/Handshake.hs
index 7bdb7fef..ab255c14 100644
--- a/src/Network/Torrent/PeerWire/Handshake.hs
+++ b/src/Network/Torrent/PeerWire/Handshake.hs
@@ -9,7 +9,7 @@ import Data.Word
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import Data.Serialize
-
+import Data.Torrent.InfoHash
 import Network.Torrent.PeerID
 
 -- | In order to establish the connection between peers we should send 'Handshake'
@@ -18,7 +18,7 @@ import Network.Torrent.PeerID
 data Handshake = Handshake {
     hsProtocol    :: ByteString  -- ^ Identifier of the protocol.
   , hsReserved    :: Word64      -- ^ Reserved bytes, rarely used.
-  , hsInfoHash    :: ByteString  -- ^ Hash from the metainfo file.
+  , hsInfoHash    :: InfoHash    -- ^ Hash from the metainfo file.
     -- This /should be/ same hash that is transmitted in tracker requests.
   , hsPeerID      :: PeerID      -- ^ Peer id of the initiator.
     -- This is /usually the same peer id that is transmitted in tracker requests.
@@ -29,14 +29,14 @@ instance Serialize Handshake where
     putWord8 (fromIntegral (B.length (hsProtocol hs)))
     putByteString (hsProtocol hs)
     putWord64be   (hsReserved hs)
-    putByteString (hsInfoHash hs)
+    put (hsInfoHash hs)
     put (hsPeerID hs)
 
   get = do
     len  <- getWord8
     Handshake <$> getBytes (fromIntegral len)
               <*> getWord64be
-              <*> getBytes 20
+              <*> get
               <*> get
 
 -- | Default protocol string "BitTorrent protocol" as is.
@@ -48,7 +48,5 @@ defaultReserved :: Word64
 defaultReserved = 0
 
 -- | Length of info hash and peer id is unchecked, so it /should/ be equal 20.
-defaultHandshake :: ByteString -- ^ Info hash string.
-                 -> PeerID
-                 -> Handshake
+defaultHandshake :: InfoHash -> PeerID -> Handshake
 defaultHandshake hash pid = Handshake defaultProtocol defaultReserved hash pid
\ No newline at end of file
diff --git a/src/Network/Torrent/Tracker.hs b/src/Network/Torrent/Tracker.hs
index 72fbcb44..796db66a 100644
--- a/src/Network/Torrent/Tracker.hs
+++ b/src/Network/Torrent/Tracker.hs
@@ -22,6 +22,7 @@ import           Data.ByteString.Char8 as BC
 import           Data.Text as T
 import Data.Serialize.Get hiding (Result)
 import Data.URLEncoded as URL
+import Data.Torrent
 
 import Network
 import Network.Socket
@@ -31,8 +32,6 @@ import Network.Torrent.PeerID
 
 import Numeric
 
-type Hash = ByteString
-
 data Peer = Peer {
       peerID   :: Maybe PeerID
     , peerIP   :: HostAddress
@@ -46,7 +45,7 @@ data Event = Started   -- ^ For first request.
 
 data TRequest = TRequest { -- TODO peer here -- TODO detach announce
      reqAnnounce   :: URI         -- ^ Announce url of the torrent.
-   , reqInfoHash   :: Hash        -- ^ Hash of info part of the torrent.
+   , reqInfoHash   :: InfoHash    -- ^ Hash of info part of the torrent.
    , reqPeerID     :: PeerID      -- ^ Id of the peer doing request. ()
    , reqPort       :: PortNumber  -- ^ Port to listen to for connection from other peers.
    , reqUploaded   :: Int         -- ^ # of bytes that the peer has uploaded in the swarm.
@@ -155,7 +154,7 @@ instance URLEncode TRequest where
 
 encodeRequest :: TRequest -> URI
 encodeRequest req = URL.urlEncode req `addToURI` reqAnnounce req
-                    `addHash` BC.unpack (reqInfoHash req)
+                    `addHash` BC.unpack (getInfoHash (reqInfoHash req))
   where
     addHash :: URI -> String -> URI
     addHash uri s = uri { uriQuery = uriQuery uri ++  "&info_hash=" ++ rfc1738Encode s }
@@ -176,7 +175,7 @@ encodeRequest req = URL.urlEncode req `addToURI` reqAnnounce req
 defaultPorts :: [PortNumber]
 defaultPorts = [6881..6889]
 
-defaultRequest :: URI -> Hash -> PeerID -> TRequest
+defaultRequest :: URI -> InfoHash -> PeerID -> TRequest
 defaultRequest announce hash pid =
   TRequest {
     reqAnnounce = announce
diff --git a/tests/encoding.hs b/tests/encoding.hs
index b820dc26..e1a8b63e 100644
--- a/tests/encoding.hs
+++ b/tests/encoding.hs
@@ -11,7 +11,9 @@ import Test.Framework (defaultMain)
 import Test.Framework.Providers.QuickCheck2 (testProperty)
 import Test.QuickCheck
 
+import Data.Torrent
 import Network.Torrent
+import Network.URI
 
 positive :: Gen Int
 positive = fromIntegral <$> (arbitrary :: Gen Word32)
@@ -45,16 +47,30 @@ instance Arbitrary PeerID where
                            <*> arbitrary
                            <*> arbitrary
 
+instance Arbitrary InfoHash where
+  arbitrary = (hash . B.pack) <$> vectorOf 20 arbitrary
+
 instance Arbitrary Handshake where
-  arbitrary = defaultHandshake
-                <$> (B.pack <$> (vectorOf 20 arbitrary))
-                <*> arbitrary
+  arbitrary = defaultHandshake <$> arbitrary <*> arbitrary
 
 data T a = T
 
 prop_encoding :: (Serialize a, Eq a) => T a -> [a] -> Bool
 prop_encoding _ msgs = decode (encode msgs) == Right msgs
 
+test_scrape_url :: Bool
+test_scrape_url = check `all` tests
+  where
+    check (iu, ou) = (parseURI iu >>= (`scrapeURL` []) >>= return . show) == ou
+    tests =
+      [ ("http://example.com/announce"        , Just "http://example.com/scrape")
+      , ("http://example.com/x/announce"      , Just "http://example.com/x/scrape")
+      , ("http://example.com/announce.php"    , Just "http://example.com/scrape.php")
+      , ("http://example.com/a"               , Nothing)
+      , ("http://example.com/announce?x2%0644", Just "http://example.com/scrape?x2%0644")
+      , ("http://example.com/announce?x=2/4"  , Nothing)
+      , ("http://example.com/x%064announce"   , Nothing)
+      ]
 
 main :: IO ()
 main = do
@@ -67,4 +83,7 @@ main = do
 
        , testProperty "Handshake encode <-> decode" $
             prop_encoding (T :: T Handshake)
+
+       , testProperty "Scrape URL" $
+            test_scrape_url
        ]
\ No newline at end of file
diff --git a/tests/info-hash.hs b/tests/info-hash.hs
index 07c01c9c..1638a205 100644
--- a/tests/info-hash.hs
+++ b/tests/info-hash.hs
@@ -1,23 +1,20 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main (main) where
 
-import Data.Foldable
 import           Data.ByteString (ByteString)
 import qualified Data.ByteString as B
 import qualified Data.ByteString.Char8 as BC
 import qualified Data.ByteString.Lazy as L
-import qualified Data.ByteString.Builder as B
-import qualified Data.ByteString.Builder.Prim as B
+
 import Data.Torrent
+import Data.Torrent.InfoHash
+
 import System.Environment
 import System.Exit
 
 checkInfo :: ByteString
 checkInfo = "0221caf96aa3cb94f0f58d458e78b0fc344ad8bf"
 
-ppHex :: B.ByteString -> B.ByteString
-ppHex = L.toStrict . B.toLazyByteString . foldMap (B.primFixed B.word8HexFixed) . B.unpack
-
 torrentFileName :: String
 torrentFileName = "tests/dapper-dvd-amd64.iso.torrent"