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.

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 (file)
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 c05be76a1662febecdbcc435cbba66a87b01b374..e5f9b5c3acc3f070253e9a339fae9ee6f2ad8345 100644 (file)
--- 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 f9fdbc32c45fb6afae5378a6fd425aad68f6ec19..d3c9b117893fe64e546af2b47ff40e0313c655b4 100644 (file)
--- 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 d0812656c5498d30166c6b762c8ba6038a15f77c..77573313b61cc4d8c5a9da80a365321687aa64ca 100644 (file)
--- 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 1976441b358953944e566f4054d29400401583c6..fd3a7efc26d09e8d27ba6a6f95e1a274ac9a3121 100644 (file)
--- 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]