refactoring to make Main simpler

diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs
index cd6473c96878c79e75025eadde601908bc46775b..59fe32f446dac27ed82807b209240408f118f294 100644 (file)
--- a/src/FuncTorrent.hs
+++ b/src/FuncTorrent.hs
@@ -4,7 +4,7 @@ module FuncTorrent
      Metainfo(..),
      Peer,
      TrackerResponse(..),
-     tracker,
+     getTrackerResponse,
      decode,
      encode,
      handShake,
@@ -13,8 +13,7 @@ module FuncTorrent
      logMessage,
      logStop,
      mkInfo,
-     mkMetaInfo,
-     mkTrackerResponse
+     mkMetaInfo
     ) where
 
 import FuncTorrent.Bencode

diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs
index a3313d18cbb5c6338de4a38466719af25ad47258..4eece7d5248a0ff257c1f9e02dd9d2e31b924a9e 100644 (file)
--- a/src/FuncTorrent/Metainfo.hs
+++ b/src/FuncTorrent/Metainfo.hs
@@ -46,7 +46,7 @@ mkInfo (Bdict m) = let (Bint pieceLength') = m ! "piece length"
                                 , md5sum = md5sum'}
 mkInfo _ = Nothing
 
-mkMetaInfo :: BVal   -> Maybe Metainfo
+mkMetaInfo :: BVal   -> Either String Metainfo
 mkMetaInfo (Bdict m)  =
     let (Just info')  = mkInfo $ m ! "info"
         announce'     = lookup "announce" m
@@ -55,18 +55,18 @@ mkMetaInfo (Bdict m)  =
         comment'      = lookup "comment" m
         createdBy'    = lookup "created by" m
         encoding'     = lookup "encoding" m
-    in Just Metainfo {
-             info         = info'
-           , announceList = maybeToList (announce' >>= bstrToString)
-                            ++ getAnnounceList announceList'
-           , creationDate = bValToInteger =<< creationDate'
-           , comment      = bstrToString  =<< comment'
-           , createdBy    = bstrToString  =<< createdBy'
-           , encoding     = bstrToString  =<< encoding'
-           , infoHash     = hash . encode $ (m ! "info")
-        }
+    in Right Metainfo {
+               info         = info'
+             , announceList = maybeToList (announce' >>= bstrToString)
+                              ++ getAnnounceList announceList'
+             , creationDate = bValToInteger =<< creationDate'
+             , comment      = bstrToString  =<< comment'
+             , createdBy    = bstrToString  =<< createdBy'
+             , encoding     = bstrToString  =<< encoding'
+             , infoHash     = hash . encode $ (m ! "info")
+             }
 
-mkMetaInfo _ = Nothing
+mkMetaInfo _ = Left "mkMetaInfo: expect an input dict"
 
 getAnnounceList :: Maybe BVal -> [String]
 getAnnounceList Nothing = []

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index b8166508d20980df85480c8047478388fa265b99..425b5d43ec5172e6dedc5a7b4f009295793c6aff 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -1,9 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Tracker
     (TrackerResponse(..),
-     tracker,
      mkArgs,
-     mkTrackerResponse,
+     getTrackerResponse,
      urlEncodeHash
     ) where
 
@@ -17,7 +16,7 @@ import Data.Map as M (lookup)
 import Network.HTTP.Base (urlEncode)
 import qualified Data.ByteString.Base16 as B16 (encode)
 
-import FuncTorrent.Bencode (BVal(..))
+import FuncTorrent.Bencode (BVal(..), decode)
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 import FuncTorrent.Network (get)
 import FuncTorrent.Peer (Peer(..))
@@ -69,6 +68,13 @@ mkTrackerResponse resp =
 tracker :: Metainfo -> String -> IO ByteString
 tracker m peer_id = get (head . announceList $ m) $ mkArgs m peer_id
 
+getTrackerResponse :: Metainfo -> String -> IO (Either ByteString TrackerResponse)
+getTrackerResponse m peerId = do
+  resp <- tracker m peerId
+  case decode resp of
+   Right trackerInfo -> return $ mkTrackerResponse trackerInfo
+   Left e -> return $ Left (pack (show e))
+
 --- | URL encode hash as per RFC1738
 --- TODO: Add tests
 --- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or

diff --git a/src/Main.hs b/src/Main.hs
index 127651ffec4f3fafbd20a0b003030ab5807c0eeb..7ba6d96c3bbe5884df4aab5b4de3e3a44278d700 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,21 +1,20 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
-import Prelude hiding (log, length, readFile, writeFile)
-import Data.ByteString.Char8 (ByteString, readFile, writeFile, unpack)
+import Prelude hiding (log, length, readFile)
+import Data.ByteString.Char8 (ByteString, readFile, unpack)
 import System.Environment (getArgs)
 import System.Exit (exitSuccess)
 import System.Directory (doesFileExist)
-import Text.ParserCombinators.Parsec (ParseError)
 
 import FuncTorrent.Bencode (decode)
 import FuncTorrent.Logger (initLogger, logMessage, logStop)
 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
 import FuncTorrent.Peer (handShake, msgLoop)
-import FuncTorrent.Tracker (tracker, peers, mkTrackerResponse)
+import FuncTorrent.Tracker (peers, getTrackerResponse)
 
-logError :: ParseError -> (String -> IO ()) -> IO ()
-logError e logMsg = logMsg $ "parse error: \n" ++ show e
+logError :: String -> (String -> IO ()) -> IO ()
+logError e logMsg = logMsg $ "parse error: \n" ++ e
 
 peerId :: String
 peerId = "-HS0001-*-*-20150215"
@@ -35,6 +34,14 @@ parse [a] = do
     else error "file does not exist"
 parse _ = exit
 
+torrentToMetaInfo :: ByteString -> Either String Metainfo
+torrentToMetaInfo s =
+  case (decode s) of
+   Right d ->
+     mkMetaInfo d
+   Left e ->
+     Left $ show e
+
 main :: IO ()
 main = do
     args <- getArgs
@@ -43,32 +50,21 @@ main = do
     log "Starting up functorrent"
     log $ "Parsing arguments " ++ concat args
     torrentStr <- parse args
-    case decode torrentStr of
-      Right d ->
-          case mkMetaInfo d of
-            Nothing -> log "Unable to make meta info file"
-            Just m -> do
-              log "Input File OK"
-              log $ "Downloading file : " ++ name (info m)
-              log "Trying to fetch peers"
-
-              log $ "Trackers: " ++ head (announceList m)
-              response <- tracker m peerId
-
-              -- TODO: Write to ~/.functorrent/caches
-              writeFile (name (info m) ++ ".cache") response
-
-              case decode response of
-                Right trackerInfo ->
-                    case mkTrackerResponse trackerInfo of
-                      Right peerResp -> do
-                          log $ "Peers List : " ++ (show . peers $ peerResp)
-                          let p1 = head (peers peerResp)
-                          h <- handShake p1 (infoHash m) peerId
-                          log $ "handshake"
-                          msgLoop h (pieces (info m))
-                      Left e -> log $ "Error" ++ unpack e
-                Left e -> logError e log
+    case (torrentToMetaInfo torrentStr) of
+     Right m -> do
+       log "Input File OK"
+       log $ "Downloading file : " ++ name (info m)
+       log "Trying to fetch peers"
 
-      Left e -> logError e log
+       log $ "Trackers: " ++ head (announceList m)
+       trackerResp <- getTrackerResponse m peerId
+       case  trackerResp of
+        Right peerList -> do
+          log $ "Peers List : " ++ (show . peers $ peerList)
+          let p1 = head (peers peerList)
+          h <- handShake p1 (infoHash m) peerId
+          log $ "handshake"
+          msgLoop h (pieces (info m))
+        Left e -> log $ "Error" ++ unpack e
+     Left e -> logError e log
     logStop logR