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(..),
      Metainfo(..),
      Peer,
      TrackerResponse(..),

-     tracker,
+     getTrackerResponse,

      decode,
      encode,
      handShake,
      decode,
      encode,
      handShake,


@@ -13,8 +13,7 @@ module FuncTorrent
      logMessage,
      logStop,
      mkInfo,
      logMessage,
      logStop,
      mkInfo,

-     mkMetaInfo,
-     mkTrackerResponse
+     mkMetaInfo

     ) where
 
 import FuncTorrent.Bencode
     ) 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
 
                                 , 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
 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
         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 = []
 
 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(..),
 {-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Tracker
     (TrackerResponse(..),

-     tracker,

      mkArgs,
      mkArgs,

-     mkTrackerResponse,
+     getTrackerResponse,

      urlEncodeHash
     ) where
 
      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 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(..))
 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
 
 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
 --- | 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
 
 {-# 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 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.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"
 
 peerId :: String
 peerId = "-HS0001-*-*-20150215"


@@ -35,6 +34,14 @@ parse [a] = do
     else error "file does not exist"
 parse _ = exit
 
     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
 main :: IO ()
 main = do
     args <- getArgs


@@ -43,32 +50,21 @@ main = do
     log "Starting up functorrent"
     log $ "Parsing arguments " ++ concat args
     torrentStr <- parse args
     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
     logStop logR