Move things around

- `infoHash` is part of metainfo, not tracker alone. Peers need this for
handshake

- Rename PeerResp to TrackerResponse and move to Tracker.hs

- Remove unwanted overhead like `type Port = Integer`

- Some more docs, haddock is showing them nicely

- Update tests

diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs
index 2841c13d60adea1f3fa2b776e3e2b92780506595..b942f5e4008a2bebd7b26e5574f0d3899fad5aad 100644 (file)
--- a/src/FuncTorrent.hs
+++ b/src/FuncTorrent.hs
@@ -4,7 +4,7 @@ module FuncTorrent
      InfoDict,
      Metainfo,
      Peer,
-     PeerResp(..),
+     TrackerResponse(..),
      announceList,
      connect,
      decode,
@@ -18,7 +18,7 @@ module FuncTorrent
      logStop,
      mkInfo,
      mkMetaInfo,
-     mkPeerResp,
+     mkTrackerResponse,
      name,
      prepareRequest,
      urlEncodeHash

diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs
index 4a95a70a9f980209cd7e5bf9300e0d900cc3a939..61699a3319e33f6c7a375eec9bf55c9c769f698f 100644 (file)
--- a/src/FuncTorrent/Metainfo.hs
+++ b/src/FuncTorrent/Metainfo.hs
@@ -1,16 +1,18 @@
 module FuncTorrent.Metainfo
     (Info(..),
      Metainfo(..),
-     mkMetaInfo,
-     mkInfo
+     infoHash,
+     mkInfo,
+     mkMetaInfo
     ) where
 
 import Prelude hiding (lookup)
 import Data.ByteString.Char8 (ByteString, unpack)
 import Data.Map as M ((!), lookup)
+import Crypto.Hash.SHA1 (hash)
 import Data.Maybe (maybeToList)
 
-import FuncTorrent.Bencode (BVal(..), bstrToString)
+import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString)
 
 -- only single file mode supported for the time being.
 data Info = Info { pieceLength :: !Integer
@@ -79,3 +81,9 @@ getAnnounceList (Just (Blist l)) = map (\s -> case s of
                                                _ -> "") l
 
 getAnnounceList (Just (Bdict _)) = []
+
+-- | Info hash is urlencoded 20 byte SHA1 hash of the value of the info key from
+-- the Metainfo file. Note that the value will be a bencoded dictionary, given
+-- the definition of the info key above. TODO: `Metainfo -> ByteString`
+infoHash :: InfoDict -> ByteString
+infoHash m = hash . encode $ (m ! "info")

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index d3c9b117893fe64e546af2b47ff40e0313c655b4..96c66b0c020f57a44d1153686f6134f3bda92aba 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -1,69 +1,27 @@
 {-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Peer
     (Peer(..),
-     PeerResp(..),
-     mkPeerResp,
      handShakeMsg
     ) where
 
 import Prelude hiding (lookup, concat, replicate, splitAt)
-import Data.ByteString.Char8 (ByteString, pack, unpack, concat, replicate, splitAt)
+
+import Data.ByteString.Char8 (ByteString, pack, concat, replicate)
 import Data.ByteString.Lazy (toChunks)
 import Data.Int (Int8)
-import Data.List (intercalate)
-import Data.Map as M ((!), lookup)
 import qualified Data.Binary as Bin (encode)
-import qualified Data.ByteString.Base16 as B16 (encode)
-
-import FuncTorrent.Bencode (BVal(..), InfoDict)
-import FuncTorrent.Tracker (infoHash)
-import FuncTorrent.Utils (splitN)
 
+import FuncTorrent.Bencode (InfoDict)
+import FuncTorrent.Metainfo (infoHash)
 
-type Address = String
-type Port = Integer
-
-data Peer = Peer Address Port
+-- | Peer is a IP address, port tuple
+data Peer = Peer String Integer
             deriving (Show, Eq)
 
-data PeerResp = PeerResp { interval :: Maybe Integer
-                         , peers :: [Peer]
-                         , complete :: Maybe Integer
-                         , incomplete :: Maybe Integer
-                         } deriving (Show, Eq)
-
-toInt :: String -> Integer
-toInt = read
-
-mkPeerResp :: BVal -> Either ByteString PeerResp
-mkPeerResp resp =
-    case lookup "failure reason" body of
-      Just (Bstr err) -> Left err
-      Just _ -> Left "Unknown failure"
-      Nothing ->
-          let (Just (Bint i)) = lookup "interval" body
-              (Bstr peersBS) = body ! "peers"
-              pl = map (\peer -> let (ip', port') = splitAt 4 peer
-                                 in Peer (toIPNum ip') (toPortNum port'))
-                   (splitN 6 peersBS)
-          in Right PeerResp {
-                   interval = Just i
-                 , peers = pl
-                 , complete = Nothing
-                 , incomplete = Nothing
-                 }
-    where
-      (Bdict body) = resp
-      toPortNum = read . ("0x" ++) . unpack . B16.encode
-      toIPNum = intercalate "." .
-                map (show . toInt . ("0x" ++) . unpack) .
-                    splitN 2 . B16.encode
-
-
 handShakeMsg :: InfoDict -> String -> ByteString
-handShakeMsg m peer_id = let pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8)
-                             pstr = pack "BitTorrent protocol"
-                             reserved = replicate 8 '\0'
-                             infoH = infoHash m
-                             peerID = pack peer_id
-                         in concat [pstrlen, pstr, reserved, infoH, peerID]
+handShakeMsg m peer_id = concat [pstrlen, pstr, reserved, infoH, peerID]
+    where pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8)
+          pstr = pack "BitTorrent protocol"
+          reserved = replicate 8 '\0'
+          infoH = infoHash m
+          peerID = pack peer_id

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 3644781b4adfa47d5b523824daece3a698c02907..8d2b3ec7ce38196578155180beb8b2881b80066b 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -1,27 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Tracker
-    (connect,
-     infoHash,
+    (TrackerResponse(..),
+     connect,
+     mkTrackerResponse,
      prepareRequest,
      urlEncodeHash
     ) where
 
-import Prelude hiding (lookup)
-import Crypto.Hash.SHA1 (hash)
-import Data.ByteString.Char8 (ByteString,  unpack)
+import Prelude hiding (lookup, concat, replicate, splitAt)
+import Data.ByteString.Char8 (ByteString, unpack, splitAt)
 import Data.Char (chr)
 import Data.List (intercalate)
+import Data.Map as M (lookup)
 import Data.Maybe (fromJust)
-import Data.Map ((!))
 import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
 import Network.HTTP.Base (urlEncode)
 import Network.URI (parseURI)
 import qualified Data.ByteString.Base16 as B16 (encode)
 
-import FuncTorrent.Bencode (InfoDict, encode)
+import FuncTorrent.Bencode (BVal(..), InfoDict)
+import FuncTorrent.Metainfo (infoHash)
+import FuncTorrent.Peer (Peer(..))
 import FuncTorrent.Utils (splitN)
 
+
+-- | Tracker response
+data TrackerResponse = TrackerResponse {
+      interval :: Maybe Integer
+    , peers :: [Peer]
+    , complete :: Maybe Integer
+    , incomplete :: Maybe Integer
+    } deriving (Show, Eq)
+
 type Url = String
 
+-- | Deserialize tracker response
+mkTrackerResponse :: BVal -> Either ByteString TrackerResponse
+mkTrackerResponse resp =
+    case lookup "failure reason" body of
+      Just (Bstr err) -> Left err
+      Just _ -> Left "Unknown failure"
+      Nothing ->
+          let (Just (Bint i)) = lookup "interval" body
+              (Just (Bstr peersBS)) = lookup "peers" body
+              pl = map makePeer (splitN 6 peersBS)
+          in Right TrackerResponse {
+                   interval = Just i
+                 , peers = pl
+                 , complete = Nothing
+                 , incomplete = Nothing
+                 }
+    where
+      (Bdict body) = resp
+
+      toInt :: String -> Integer
+      toInt = read
+
+      toPort :: ByteString -> Integer
+      toPort = read . ("0x" ++) . unpack . B16.encode
+
+      toIP :: ByteString -> String
+      toIP = intercalate "." .
+             map (show . toInt . ("0x" ++) . unpack) .
+                 splitN 2 . B16.encode
+
+      makePeer :: ByteString -> Peer
+      makePeer peer = Peer (toIP ip') (toPort port')
+          where (ip', port') = splitAt 4 peer
+
+
 -- | urlEncodeHash
 --
 -- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a"
@@ -36,9 +83,6 @@ urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
 
         nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
 
-infoHash :: InfoDict -> ByteString
-infoHash m = hash . encode $ (m ! "info")
-
 prepareRequest :: InfoDict -> String -> Integer -> String
 prepareRequest d peer_id len =
   let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)),

diff --git a/src/Main.hs b/src/Main.hs
index b7888e0ca6dca5598b042c3279a91259c49d1816..3537e48865c4d08d3a91f9f7908e01bd8554b7be 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -11,8 +11,8 @@ import Text.ParserCombinators.Parsec (ParseError)
 import FuncTorrent.Bencode (decode, BVal(..))
 import FuncTorrent.Logger (initLogger, logMessage, logStop)
 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
-import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg)
-import FuncTorrent.Tracker (connect, prepareRequest)
+import FuncTorrent.Peer (handShakeMsg)
+import FuncTorrent.Tracker (connect, prepareRequest, peers, mkTrackerResponse)
 
 logError :: ParseError -> (String -> IO ()) -> IO ()
 logError e logMsg = logMsg $ "parse error: \n" ++ show e
@@ -64,7 +64,7 @@ main = do
 
               case decode response of
                 Right trackerInfo ->
-                    case mkPeerResp trackerInfo of
+                    case mkTrackerResponse trackerInfo of
                       Right peerResp ->
                           logMsg $ "Peers List : " ++ (show . peers $ peerResp)
                       Left e -> logMsg $ "Error" ++ unpack e

diff --git a/test/Test.hs b/test/Test.hs
index 07408db922928e103a23d5e620216f1e7f2801b9..0f93e8ace0c2a81625fdd17d80f06ccc14980523 100644 (file)
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -10,7 +10,8 @@ import Test.Tasty.HUnit
 
 import FuncTorrent.Bencode (decode, BVal(..))
 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
-import FuncTorrent.Peer (Peer(..), PeerResp(..), mkPeerResp)
+import FuncTorrent.Peer (Peer(..))
+import FuncTorrent.Tracker (TrackerResponse(..), peers, mkTrackerResponse)
 
 -- Parsed .torrent file
 file :: BVal
@@ -61,11 +62,11 @@ testResponse1 :: TestTree
 testResponse1 = testCase "Should parse valid tracker response" $ do
                   str <- readFile "./data/debian-7.8.0-amd64-CD-1.iso.cache"
                   case decode str of
-                    Right bval -> expectation @?= mkPeerResp bval
+                    Right bval -> expectation @?= mkTrackerResponse bval
                     Left _ -> error "Failed parsing test file"
                   where
-                    expectation :: Either a PeerResp
-                    expectation = Right PeerResp {
+                    expectation :: Either a TrackerResponse
+                    expectation = Right TrackerResponse {
                                     interval = Just 900,
                                     peers = [Peer "85.25.201.101" 51413, Peer "37.59.28.236" 22222, Peer "76.21.149.43" 51866, Peer "31.183.33.205" 43467, Peer "213.210.120.86" 27480, Peer "213.239.216.205" 6914, Peer "91.192.163.152" 11834, Peer "62.210.240.65" 6999, Peer "84.250.103.161" 6949, Peer "88.195.241.192" 51413, Peer "88.165.61.223" 6881, Peer "86.157.234.243" 59583, Peer "213.41.137.242" 51413, Peer "91.10.84.195" 46941, Peer "64.56.249.183" 7023, Peer "202.62.16.71" 59929, Peer "31.43.126.122" 57816, Peer "68.169.133.72" 50222, Peer "223.135.97.177" 58813, Peer "5.166.93.118" 64459, Peer "200.148.109.141" 51413, Peer "109.226.236.160" 44444, Peer "78.58.139.154" 22818, Peer "188.244.47.186" 39643, Peer "203.86.204.111" 52411, Peer "80.110.40.98" 6918, Peer "68.187.142.217" 58352, Peer "71.115.139.180" 63065, Peer "70.169.35.173" 51413, Peer "185.3.135.186" 10889, Peer "88.198.224.202" 51413, Peer "183.157.65.217" 9179, Peer "87.251.189.150" 46680, Peer "87.114.202.174" 12393, Peer "93.58.5.16" 51411, Peer "89.102.9.69" 10044, Peer "94.159.19.222" 15783, Peer "95.28.49.176" 58794, Peer "217.114.58.135" 6881, Peer "79.141.162.38" 35806, Peer "136.169.50.72" 54927, Peer "187.67.188.151" 51413, Peer "79.111.218.50" 53636, Peer "62.75.137.129" 51413, Peer "14.204.20.156" 11600, Peer "79.141.162.34" 24531, Peer "82.144.192.7" 63208, Peer "212.34.231.10" 20684, Peer "95.225.246.221" 51413, Peer "124.41.237.102" 24874],
                                     complete = Nothing,
@@ -76,7 +77,7 @@ testResponse2 :: TestTree
 testResponse2 = testCase "Should parse invalid tracker response" $ do
                   str <- readFile "./data/debian-7.8.0-amd64-CD-1.iso.error"
                   case decode str of
-                    Right bval -> expectation @?= mkPeerResp bval
+                    Right bval -> expectation @?= mkTrackerResponse bval
                     Left _ -> error "Failed parsing test file"
                   where
                     expectation :: Either ByteString a