From 3d076eb8b041e4e556a12a85ba5cf2d1b82ccee6 Mon Sep 17 00:00:00 2001
From: Jaseem Abid <jaseemabid@gmail.com>
Date: Sun, 29 Mar 2015 17:54:58 +0530
Subject: [PATCH] Handle error cases from the tracker

Tracker might reply that the requested torrent is unavailable. Sample
response at `data/debian-7.8.0-amd64-CD-1.iso.error`.

Renamed `getPeerResponse` to `mkPeerResp` and changed it singture to
match other `mk*` functions like `mkMetaInfo`.

Added test cases

New checks made the code one more level deep. Will need a refactor with
the Either Monad.
---
 data/debian-7.8.0-amd64-CD-1.iso.error |  1 +
 src/FuncTorrent.hs                     |  2 +-
 src/FuncTorrent/Peer.hs                | 51 +++++++++++++-------------
 src/Main.hs                            | 23 +++++++-----
 test/Test.hs                           | 44 ++++++++++++++--------
 5 files changed, 70 insertions(+), 51 deletions(-)
 create mode 100644 data/debian-7.8.0-amd64-CD-1.iso.error

diff --git a/data/debian-7.8.0-amd64-CD-1.iso.error b/data/debian-7.8.0-amd64-CD-1.iso.error
new file mode 100644
index 0000000..c19b09a
--- /dev/null
+++ b/data/debian-7.8.0-amd64-CD-1.iso.error
@@ -0,0 +1 @@
+d14:failure reason17:torrent not founde
\ No newline at end of file
diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs
index c05be76..e5f9b5c 100644
--- a/src/FuncTorrent.hs
+++ b/src/FuncTorrent.hs
@@ -9,7 +9,6 @@ module FuncTorrent
      connect,
      decode,
      encode,
-     getPeerResponse,
      handShakeMsg,
      info,
      infoHash,
@@ -19,6 +18,7 @@ module FuncTorrent
      logStop,
      mkInfo,
      mkMetaInfo,
+     mkPeerResp,
      name,
      prepareRequest,
      urlEncodeHash
diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index f9fdbc3..d3c9b11 100644
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -1,7 +1,8 @@
+{-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Peer
     (Peer(..),
      PeerResp(..),
-     getPeerResponse,
+     mkPeerResp,
      handShakeMsg
     ) where
 
@@ -14,7 +15,7 @@ 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, decode)
+import FuncTorrent.Bencode (BVal(..), InfoDict)
 import FuncTorrent.Tracker (infoHash)
 import FuncTorrent.Utils (splitN)
 
@@ -34,29 +35,29 @@ data PeerResp = PeerResp { interval :: Maybe Integer
 toInt :: String -> Integer
 toInt = read
 
-getPeerResponse :: ByteString -> PeerResp
-getPeerResponse body = case decode body of
-                        Right (Bdict peerM) ->
-                          let (Just (Bint i)) = lookup "interval" peerM
-                              (Bstr peersBS) = peerM ! "peers"
-                              pl = map (\peer -> let (ip', port') = splitAt 4 peer
-                                                 in Peer (toIPNum ip') (toPortNum port'))
-                                   (splitN 6 peersBS)
-                          in PeerResp { interval = Just i
-                                      , peers = pl
-                                      , complete = Nothing
-                                      , incomplete = Nothing
-                                      }
-                          where toPortNum = read . ("0x" ++) . unpack . B16.encode
-                                toIPNum = intercalate "." .
-                                          map (show . toInt . ("0x" ++) . unpack) .
-                                          splitN 2 . B16.encode
-
-                        _ -> PeerResp { interval = Nothing
-                                      , peers = []
-                                      , complete = Nothing
-                                      , incomplete = Nothing
-                                      }
+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
diff --git a/src/Main.hs b/src/Main.hs
index d081265..7757331 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,7 +2,7 @@
 module Main where
 
 import Prelude hiding (length, readFile, writeFile)
-import Data.ByteString.Char8 (ByteString, readFile, writeFile, length)
+import Data.ByteString.Char8 (ByteString, readFile, writeFile, length, unpack)
 import System.Environment (getArgs)
 import System.Exit (exitSuccess)
 import System.Directory (doesFileExist)
@@ -11,7 +11,7 @@ import Text.ParserCombinators.Parsec (ParseError)
 import FuncTorrent.Bencode (decode, BVal(..))
 import FuncTorrent.Logger (initLogger, logMessage, logStop)
 import FuncTorrent.Metainfo (announce, lengthInBytes, mkMetaInfo, info, name)
-import FuncTorrent.Peer (peers, getPeerResponse, handShakeMsg)
+import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg)
 import FuncTorrent.Tracker (connect, prepareRequest)
 
 logError :: ParseError -> (String -> IO ()) -> IO ()
@@ -53,16 +53,21 @@ main = do
                   (Bdict d') = d
 
               logMsg "Trying to fetch peers: "
-              body <- connect (announce m) (prepareRequest d' peerId len)
-
-              -- TODO: Write to ~/.functorrent/caches
-              writeFile (name (info m) ++ ".cache") body
-
-              let peerResponse = show $ peers $ getPeerResponse body
-              logMsg $ "Peers List : " ++ peerResponse
+              response <- connect (announce m) (prepareRequest d' peerId len)
 
               let hsMsgLen = show $ length $ handShakeMsg d' peerId
               logMsg $ "Hand-shake message length : " ++ hsMsgLen
 
+              -- TODO: Write to ~/.functorrent/caches
+              writeFile (name (info m) ++ ".cache") response
+
+              case decode response of
+                Right trackerInfo ->
+                    case mkPeerResp trackerInfo of
+                      Right peerResp ->
+                          logMsg $ "Peers List : " ++ (show . peers $ peerResp)
+                      Left e -> logMsg $ "Error" ++ unpack e
+                Left e -> logError e logMsg
+
       Left e -> logError e logMsg
     logStop logR
diff --git a/test/Test.hs b/test/Test.hs
index 1976441..fd3a7ef 100644
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -2,23 +2,14 @@
 module Main where
 
 import Prelude hiding (readFile)
-import Data.ByteString.Char8 (readFile)
+import Data.ByteString.Char8 (ByteString, readFile)
 import Data.Map.Strict (fromList)
 
 import Test.Tasty
 import Test.Tasty.HUnit
 
 import FuncTorrent.Bencode (decode, BVal(..))
-import FuncTorrent.Peer (Peer(..), PeerResp(..), getPeerResponse)
-
--- Initial response from tracker
-response :: PeerResp
-response = PeerResp {
-             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,
-             incomplete = Nothing
-           }
+import FuncTorrent.Peer (Peer(..), PeerResp(..), mkPeerResp)
 
 -- Parsed .torrent file
 file :: BVal
@@ -43,13 +34,34 @@ testFile = testCase "Should parse regular torrent files" $ do
                  Right expected -> expected @?= file
                  Left _ -> error "Failed parsing test file"
 
-testResponse :: TestTree
-testResponse = testCase "Should parse tracker response" $ do
-               str <- readFile "./data/debian-7.8.0-amd64-CD-1.iso.cache"
-               response @?= getPeerResponse str
+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
+                    Left _ -> error "Failed parsing test file"
+                  where
+                    expectation :: Either a PeerResp
+                    expectation = Right PeerResp {
+                                    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,
+                                    incomplete = Nothing
+                                }
+
+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
+                    Left _ -> error "Failed parsing test file"
+                  where
+                    expectation :: Either ByteString a
+                    expectation = Left "torrent not found"
+
 
 unitTests :: TestTree
-unitTests = testGroup "Unit tests" [testFile, testResponse]
+unitTests = testGroup "Unit tests" [testFile, testResponse1, testResponse2]
 
 tests :: TestTree
 tests = testGroup "Tests" [unitTests]
-- 
2.45.2