From: Ramakrishnan Muthukrishnan Date: Sun, 12 Jul 2015 10:52:26 +0000 (+0530) Subject: refactoring to make Main simpler X-Git-Url: https://git.rkrishnan.org/%5B/%5D%20/uri/%22doc.html/install.html?a=commitdiff_plain;h=e047e30d9d83a4f44ad56f0a70c953350a3cb55a;p=functorrent.git refactoring to make Main simpler --- diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs index cd6473c..59fe32f 100644 --- 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 a3313d1..4eece7d 100644 --- 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 b816650..425b5d4 100644 --- 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 127651f..7ba6d96 100644 --- 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