From: Jaseem Abid <jaseemabid@gmail.com>
Date: Fri, 10 Apr 2015 02:06:35 +0000 (+0530)
Subject: Move things around
X-Git-Url: https://git.rkrishnan.org/pf/content/en/about.html?a=commitdiff_plain;h=56904b7b9799590e5dc4899246157961ae02c543;p=functorrent.git

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 2841c13..b942f5e 100644
--- 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 4a95a70..61699a3 100644
--- 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 d3c9b11..96c66b0 100644
--- 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 3644781..8d2b3ec 100644
--- 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 b7888e0..3537e48 100644
--- 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 07408db..0f93e8a 100644
--- 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