From c2c904f57aedbf048e445c39fed43b37ee60f4b1 Mon Sep 17 00:00:00 2001 From: Ramakrishnan Muthukrishnan Date: Mon, 30 Mar 2015 14:27:36 +0530 Subject: [PATCH] combine announce and announceList slots in the Metainfo record. This eliminates the unnecessary "getter" function getTrackers and simplifies the code a bit. Still a work in progress. --- src/FuncTorrent.hs | 2 +- src/FuncTorrent/Bencode.hs | 6 ++++++ src/FuncTorrent/Metainfo.hs | 21 ++++++++------------- src/Main.hs | 4 ++-- 4 files changed, 17 insertions(+), 16 deletions(-) diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs index e5f9b5c..2841c13 100644 --- a/src/FuncTorrent.hs +++ b/src/FuncTorrent.hs @@ -5,7 +5,7 @@ module FuncTorrent Metainfo, Peer, PeerResp(..), - announce, + announceList, connect, decode, encode, diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs index 8ea530a..96600e2 100644 --- a/src/FuncTorrent/Bencode.hs +++ b/src/FuncTorrent/Bencode.hs @@ -2,6 +2,7 @@ module FuncTorrent.Bencode (BVal(..), InfoDict, + bstrToString, encode, decode ) where @@ -139,3 +140,8 @@ encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs encode (Bint i) = pack $ "i" ++ show i ++ "e" encode (Blist xs) = pack $ "l" ++ unpack (concat $ map encode xs) ++ "e" encode (Bdict d) = concat [concat ["d", encode . Bstr . pack $ k , encode (d ! k) , "e"] | k <- keys d] + +-- getters +bstrToString :: BVal -> Maybe String +bstrToString (Bstr s) = Just $ unpack s +bstrToString _ = Nothing diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 1fd9475..9ff3ce3 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -1,20 +1,19 @@ module FuncTorrent.Metainfo (Info, Metainfo, + announceList, mkMetaInfo, mkInfo, - announce, lengthInBytes, info, name, - getTrackers ) where import Prelude hiding (lookup) import Data.ByteString.Char8 (ByteString, unpack) import Data.Map as M ((!), lookup) -import FuncTorrent.Bencode (BVal(..)) +import FuncTorrent.Bencode (BVal(..), bstrToString) -- only single file mode supported for the time being. data Info = Info { pieceLength :: !Integer @@ -26,7 +25,6 @@ data Info = Info { pieceLength :: !Integer } deriving (Eq, Show) data Metainfo = Metainfo { info :: !Info - , announce :: !(Maybe String) , announceList :: ![String] , creationDate :: !(Maybe String) , comment :: !(Maybe String) @@ -64,10 +62,8 @@ mkMetaInfo (Bdict m) = let (Just info') = mkInfo $ m ! "info" createdBy' = lookup "created by" m encoding' = lookup "encoding" m in Just Metainfo { info = info' - , announce = announce' - >>= (\(Bstr a) -> - Just (unpack a)) - , announceList = getAnnounceList announceList' + , announceList = maybeToList (announce' >>= bstrToString) + ++ getAnnounceList announceList' , creationDate = creationDate' , comment = maybeBstrToString comment' , createdBy = maybeBstrToString createdBy' @@ -75,6 +71,10 @@ mkMetaInfo (Bdict m) = let (Just info') = mkInfo $ m ! "info" } mkMetaInfo _ = Nothing +maybeToList :: Maybe a -> [a] +maybeToList Nothing = [] +maybeToList (Just x) = [x] + getAnnounceList :: Maybe BVal -> [String] getAnnounceList Nothing = [] getAnnounceList (Just (Bint _)) = [] @@ -87,8 +87,3 @@ getAnnounceList (Just (Blist l)) = map (\s -> case s of _ -> "") l getAnnounceList (Just (Bdict _)) = [] - -getTrackers :: Metainfo -> [String] -getTrackers m = case announce m of - Nothing -> announceList m - Just a -> a : announceList m diff --git a/src/Main.hs b/src/Main.hs index c1b3668..cfbcfe3 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,7 @@ import Text.ParserCombinators.Parsec (ParseError) import FuncTorrent.Bencode (decode, BVal(..)) import FuncTorrent.Logger (initLogger, logMessage, logStop) -import FuncTorrent.Metainfo (lengthInBytes, mkMetaInfo, info, name, getTrackers) +import FuncTorrent.Metainfo (lengthInBytes, mkMetaInfo, info, name, announceList) import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg) import FuncTorrent.Tracker (connect, prepareRequest) @@ -51,7 +51,7 @@ main = do let len = lengthInBytes $ info m (Bdict d') = d - trackers = getTrackers m + trackers = announceList m logMsg "Trying to fetch peers: " response <- connect (head trackers) (prepareRequest d' peerId len) -- 2.37.2