From c324cc92fc790e835da98fb251618af72e1405d0 Mon Sep 17 00:00:00 2001 From: Jaseem Abid Date: Sun, 22 Feb 2015 00:15:57 +0530 Subject: [PATCH] Absolute import everywhere, cleanup --- src/Bencode.hs | 75 +++++++++++++++++++++++------------------------ src/Main.hs | 42 +++++++++++++------------- src/Metainfo.hs | 78 ++++++++++++++++++++++++------------------------- src/Peer.hs | 76 ++++++++++++++++++++++++----------------------- src/Tracker.hs | 56 +++++++++++++++++------------------ 5 files changed, 165 insertions(+), 162 deletions(-) diff --git a/src/Bencode.hs b/src/Bencode.hs index 873c1e1..8018a38 100644 --- a/src/Bencode.hs +++ b/src/Bencode.hs @@ -1,56 +1,55 @@ module Bencode where --- import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Char8 as BC -import qualified Data.Map.Strict as M -import qualified Text.Parsec.ByteString as ParsecBS -import Text.ParserCombinators.Parsec import Control.Applicative ((<*)) -import Data.Functor +import Data.ByteString.Char8 (ByteString, pack, unpack) +import Data.Functor ((<$>)) +import Data.Map.Strict (Map, fromList, keys, (!)) +import Text.ParserCombinators.Parsec +import qualified Text.Parsec.ByteString as ParsecBS data BVal = Bint Integer - | Bstr BC.ByteString + | Bstr ByteString | Blist [BVal] | Bdict InfoDict deriving (Ord, Eq, Show) -type InfoDict = M.Map BVal BVal +type InfoDict = Map BVal BVal -- $setup -- >>> import Data.Either -- | parse strings -- --- >>> parse bencStr "Bstr" (BC.pack "4:spam") +-- >>> parse bencStr "Bstr" (pack "4:spam") -- Right "spam" --- >>> parse bencStr "Bstr" (BC.pack "0:") +-- >>> parse bencStr "Bstr" (pack "0:") -- Right "" --- >>> parse bencStr "Bstr" (BC.pack "0:hello") +-- >>> parse bencStr "Bstr" (pack "0:hello") -- Right "" -- -bencStr :: ParsecBS.Parser BC.ByteString +bencStr :: ParsecBS.Parser ByteString bencStr = do _ <- spaces ds <- many1 digit <* char ':' s <- count (read ds) anyChar - return (BC.pack s) + return (pack s) -- | parse integers -- --- >>> parse bencInt "Bint" (BC.pack "i42e") +-- >>> parse bencInt "Bint" (pack "i42e") -- Right 42 --- >>> parse bencInt "Bint" (BC.pack "i123e") +-- >>> parse bencInt "Bint" (pack "i123e") -- Right 123 --- >>> parse bencInt "Bint" (BC.pack "i1e") +-- >>> parse bencInt "Bint" (pack "i1e") -- Right 1 --- >>> parse bencInt "Bint" (BC.pack "i0e") +-- >>> parse bencInt "Bint" (pack "i0e") -- Right 0 --- >>> parse bencInt "Bint" (BC.pack "i-1e") +-- >>> parse bencInt "Bint" (pack "i-1e") -- Right (-1) --- >>> isLeft $ parse bencInt "Bint" (BC.pack "i01e") +-- >>> isLeft $ parse bencInt "Bint" (pack "i01e") -- True --- >>> isLeft $ parse bencInt "Bint" (BC.pack "i00e") +-- >>> isLeft $ parse bencInt "Bint" (pack "i00e") -- True --- >>> isLeft $ parse bencInt "Bint" (BC.pack "i002e") +-- >>> isLeft $ parse bencInt "Bint" (pack "i002e") -- True bencInt :: ParsecBS.Parser Integer bencInt = do _ <- spaces @@ -67,13 +66,13 @@ bencInt = do _ <- spaces -- | parse lists -- --- >>> parse bencList "Blist" (BC.pack "le") +-- >>> parse bencList "Blist" (pack "le") -- Right [] --- >>> parse bencList "Blist" (BC.pack "l4:spam4:eggse") +-- >>> parse bencList "Blist" (pack "l4:spam4:eggse") -- Right ["spam","eggs"] --- >>> parse bencList "Blist" (BC.pack "l4:spami42ee") +-- >>> parse bencList "Blist" (pack "l4:spami42ee") -- Right ["spam",42] --- >>> parse bencList "Blist" (BC.pack "l4:spam4:eggsli42eee") +-- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee") -- Right ["spam","eggs",[42]] bencList :: ParsecBS.Parser [BVal] bencList = do _ <- spaces @@ -81,16 +80,16 @@ bencList = do _ <- spaces -- | parse dict -- --- >>> parse bencDict "Bdict" (BC.pack "de") +-- >>> parse bencDict "Bdict" (pack "de") -- Right (fromList []) --- >>> parse bencDict "Bdict" (BC.pack "d3:cow3:moo4:spam4:eggse") +-- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse") -- Right (fromList [("cow","moo"),("spam","eggs")]) --- >>> parse bencDict "Bdict" (BC.pack "d4:spaml1:a1:bee") +-- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee") -- Right (fromList [("spam",["a","b"])]) --- >>> parse bencDict "Bdict" (BC.pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee") +-- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee") -- Right (fromList [("publisher","bob"),("publisher-webpage","www.example.com"),("publisher.location","home")]) -bencDict :: ParsecBS.Parser (M.Map BVal BVal) -bencDict = between (char 'd') (char 'e') $ M.fromList <$> many kvpair +bencDict :: ParsecBS.Parser (Map BVal BVal) +bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair where kvpair = do k <- bencStr v <- bencVal return (Bstr k, v) @@ -101,32 +100,32 @@ bencVal = Bstr <$> bencStr <|> Blist <$> bencList <|> Bdict <$> bencDict -decode :: BC.ByteString -> Either ParseError BVal +decode :: ByteString -> Either ParseError BVal decode = parse bencVal "BVal" -- given an input dict or int or string, encode -- it into a bencoded bytestring. -- | encode bencoded-values -- --- >>> encode (Bstr (BC.pack "")) +-- >>> encode (Bstr (pack "")) -- "0:" --- >>> encode (Bstr (BC.pack "spam")) +-- >>> encode (Bstr (pack "spam")) -- "4:spam" -- >>> encode (Bint 0) -- "i0e" -- >>> encode (Bint 42) -- "i42e" --- >>> encode (Blist [(Bstr (BC.pack "spam")), (Bstr (BC.pack "eggs"))]) +-- >>> encode (Blist [(Bstr (pack "spam")), (Bstr (pack "eggs"))]) -- "l4:spam4:eggse" -- >>> encode (Blist []) -- "le" --- >>> encode (Bdict (M.fromList [(Bstr $ BC.pack "spam", Bstr $ BC.pack "eggs")])) +-- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")])) -- "d4:spam4:eggse" encode :: BVal -> String -encode (Bstr bs) = let s = BC.unpack bs +encode (Bstr bs) = let s = unpack bs in show (length s) ++ ":" ++ s encode (Bint i) = "i" ++ show i ++ "e" encode (Blist xs) = "l" ++ encodeList xs ++ "e" where encodeList = foldr ((++) . encode) "" encode (Bdict d) = "d" ++ encodeDict d ++ "e" - where encodeDict m = concat [encode k ++ encode (m M.! k) | k <- M.keys m] + where encodeDict m = concat [encode k ++ encode ((!) m k) | k <- keys m] diff --git a/src/Main.hs b/src/Main.hs index 32dc41a..50eb5d1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,45 +1,47 @@ module Main where +import Prelude hiding (length, readFile) + +import Bencode (decode, BVal(..)) +import Data.ByteString.Char8 as BC (ByteString, pack, length, readFile, length) +import Data.Functor ((<$>)) +import Metainfo (announce, lengthInBytes, mkMetaInfo, info) +import Peer (getPeers, getPeerResponse, handShakeMsg) import System.Environment (getArgs) -import System.Exit -import qualified Data.ByteString.Char8 as BC -import qualified Bencode as Benc -import qualified Metainfo as MInfo -import qualified Tracker as T -import qualified Text.ParserCombinators.Parsec as Parsec -import qualified Peer as P -import Data.Functor - -printError :: Parsec.ParseError -> IO () +import System.Exit (exitSuccess) +import Tracker (connect, prepareRequest) +import Text.ParserCombinators.Parsec (ParseError) + +printError :: ParseError -> IO () printError e = putStrLn $ "parse error: " ++ show e peerId :: String peerId = "-HS0001-*-*-20150215" -exit :: IO BC.ByteString +exit :: IO ByteString exit = exitSuccess usage :: IO () usage = putStrLn "usage: functorrent torrent-file" -parse :: [String] -> IO BC.ByteString +parse :: [String] -> IO ByteString parse [] = usage >> exit -parse [a] = BC.readFile a +parse [a] = readFile a parse _ = exit main :: IO () main = do args <- getArgs torrentStr <- parse args - case Benc.decode torrentStr of + case decode torrentStr of Right d -> - case MInfo.mkMetaInfo d of + case mkMetaInfo d of Nothing -> putStrLn "parse error" Just m -> do - let len = MInfo.lengthInBytes (MInfo.info m) - (Benc.Bdict d') = d - body <- BC.pack <$> T.connect (MInfo.announce m) (T.prepareRequest d' peerId len) - print (P.getPeers (P.getPeerResponse body)) - print (BC.length (P.handShakeMsg d' peerId)) + let len = lengthInBytes $ info m + (Bdict d') = d + body <- pack <$> connect (announce m) (prepareRequest d' peerId len) + print $ getPeers $ getPeerResponse body + print $ length $ handShakeMsg d' peerId Left e -> printError e putStrLn "done" diff --git a/src/Metainfo.hs b/src/Metainfo.hs index db1c97d..ccfd983 100644 --- a/src/Metainfo.hs +++ b/src/Metainfo.hs @@ -1,12 +1,13 @@ module Metainfo where -import qualified Bencode as Benc -import qualified Data.ByteString.Char8 as BC -import qualified Data.Map as M +import Prelude hiding (lookup) +import Bencode (BVal(..)) +import Data.ByteString.Char8 (ByteString, pack, unpack) +import Data.Map as M ((!), lookup) -- only single file mode supported for the time being. data Info = Info { pieceLength :: !Integer - , pieces :: !BC.ByteString + , pieces :: !ByteString , private :: !(Maybe Integer) , name :: !String , lengthInBytes :: !Integer @@ -22,43 +23,42 @@ data Metainfo = Metainfo { info :: !Info , encoding :: !(Maybe String) } deriving (Eq, Show) -mkInfo :: Benc.BVal -> Maybe Info -mkInfo (Benc.Bdict m) = let (Benc.Bint pieceLength') = m M.! Benc.Bstr (BC.pack "piece length") - (Benc.Bstr pieces') = m M.! Benc.Bstr (BC.pack "pieces") - private' = Nothing - (Benc.Bstr name') = m M.! Benc.Bstr (BC.pack "name") - (Benc.Bint length') = m M.! Benc.Bstr (BC.pack "length") - md5sum' = Nothing - in Just Info { pieceLength = pieceLength' - , pieces = pieces' - , private = private' - , name = BC.unpack name' - , lengthInBytes = length' - , md5sum = md5sum' - } +mkInfo :: BVal -> Maybe Info +mkInfo (Bdict m) = let (Bint pieceLength') = m M.! Bstr (pack "piece length") + (Bstr pieces') = m M.! Bstr (pack "pieces") + private' = Nothing + (Bstr name') = m M.! Bstr (pack "name") + (Bint length') = m M.! Bstr (pack "length") + md5sum' = Nothing + in Just Info { pieceLength = pieceLength' + , pieces = pieces' + , private = private' + , name = unpack name' + , lengthInBytes = length' + , md5sum = md5sum'} mkInfo _ = Nothing -maybeBstrToString :: Maybe Benc.BVal -> Maybe String +maybeBstrToString :: Maybe BVal -> Maybe String maybeBstrToString Nothing = Nothing -maybeBstrToString (Just s) = let (Benc.Bstr bs) = s - in Just (BC.unpack bs) +maybeBstrToString (Just s) = let (Bstr bs) = s + in Just (unpack bs) -mkMetaInfo :: Benc.BVal -> Maybe Metainfo -mkMetaInfo (Benc.Bdict m) = let (Just info') = mkInfo (m M.! Benc.Bstr (BC.pack "info")) - (Benc.Bstr announce') = m M.! Benc.Bstr (BC.pack "announce") --- announceList = M.lookup (Benc.Bstr (BC.pack "announce list")) - announceList' = Nothing - -- creationDate = M.lookup (Benc.Bstr (BC.pack "creation date")) m - creationDate' = Nothing - comment' = M.lookup (Benc.Bstr (BC.pack "comment")) m - createdBy' = M.lookup (Benc.Bstr (BC.pack "created by")) m - encoding' = M.lookup (Benc.Bstr (BC.pack "encoding")) m - in Just Metainfo { info = info' - , announce = BC.unpack announce' - , announceList = announceList' - , creationDate = creationDate' - , comment = maybeBstrToString comment' - , createdBy = maybeBstrToString createdBy' - , encoding = maybeBstrToString encoding' - } +mkMetaInfo :: BVal -> Maybe Metainfo +mkMetaInfo (Bdict m) = let (Just info') = mkInfo (m M.! Bstr (pack "info")) + (Bstr announce') = m M.! Bstr (pack "announce") + -- announceList = lookup (Bstr (pack "announce list")) + announceList' = Nothing + -- creationDate = lookup (Bstr (pack "creation date")) m + creationDate' = Nothing + comment' = lookup (Bstr (pack "comment")) m + createdBy' = lookup (Bstr (pack "created by")) m + encoding' = lookup (Bstr (pack "encoding")) m + in Just Metainfo { info = info' + , announce = unpack announce' + , announceList = announceList' + , creationDate = creationDate' + , comment = maybeBstrToString comment' + , createdBy = maybeBstrToString createdBy' + , encoding = maybeBstrToString encoding' + } mkMetaInfo _ = Nothing diff --git a/src/Peer.hs b/src/Peer.hs index f647c61..e27de57 100644 --- a/src/Peer.hs +++ b/src/Peer.hs @@ -1,20 +1,25 @@ module Peer where -import qualified Utils as U -import qualified Bencode as Benc -import qualified Tracker as T -import qualified Data.Map as M -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Base16 as B16 -import qualified Data.ByteString.Lazy as BL -import qualified Data.List as L -import qualified Data.Binary as Bin -import qualified Data.Int as DI - -data Peer = Peer { ip :: String - , port :: Integer - } deriving (Show) - +import Prelude hiding (lookup, concat, replicate, splitAt) + +import Bencode (BVal(..), InfoDict, decode) +import Data.ByteString.Char8 (ByteString, pack, unpack, concat, replicate, splitAt) +import Data.ByteString.Lazy (toChunks) +import Data.Int (Int8) +import Data.List (intercalate) +import Data.Map as M ((!), lookup) +import Tracker (infoHash) +import Utils (splitN) +import qualified Data.Binary as Bin (encode) +import qualified Data.ByteString.Base16 as B16 (encode) + + +type Address = String +type Port = Integer + +data Peer = Peer Address Port + deriving (Show) + data PeerResp = PeerResponse { interval :: Maybe Integer , peers :: [Peer] , complete :: Maybe Integer @@ -27,25 +32,24 @@ toInt = read getPeers :: PeerResp -> [Peer] getPeers = peers -getPeerResponse :: BC.ByteString -> PeerResp -getPeerResponse body = case Benc.decode body of - Right (Benc.Bdict peerM) -> - let (Just (Benc.Bint i)) = M.lookup (Benc.Bstr (BC.pack "lookup")) peerM - (Benc.Bstr peersBS) = peerM M.! Benc.Bstr (BC.pack "peers") - pl = map (\peer -> let (ip', port') = BC.splitAt 4 peer - in Peer { ip = toIPNum ip' - , port = toPortNum port' - }) - (U.splitN 6 peersBS) +getPeerResponse :: ByteString -> PeerResp +getPeerResponse body = case decode body of + Right (Bdict peerM) -> + let (Just (Bint i)) = lookup (Bstr (pack "lookup")) peerM + (Bstr peersBS) = peerM M.! Bstr (pack "peers") + pl = map (\peer -> let (ip', port') = splitAt 4 peer + in Peer (toIPNum ip') (toPortNum port')) + (splitN 6 peersBS) in PeerResponse { interval = Just i , peers = pl , complete = Nothing , incomplete = Nothing } - where toPortNum = read . ("0x" ++) . BC.unpack . B16.encode - toIPNum = L.intercalate "." . - map (show . toInt . ("0x" ++) . BC.unpack) . - U.splitN 2 . B16.encode + where toPortNum = read . ("0x" ++) . unpack . B16.encode + toIPNum = intercalate "." . + map (show . toInt . ("0x" ++) . unpack) . + splitN 2 . B16.encode + _ -> PeerResponse { interval = Nothing , peers = [] , complete = Nothing @@ -53,10 +57,10 @@ getPeerResponse body = case Benc.decode body of } -handShakeMsg :: Benc.InfoDict -> String -> BC.ByteString -handShakeMsg m peer_id = let pstrlen = BC.concat $ BL.toChunks $ Bin.encode (19 :: DI.Int8) - pstr = BC.pack "BitTorrent protocol" - reserved = BC.replicate 8 '\0' - infoH = T.infoHash m - peerID = BC.pack peer_id - in BC.concat [pstrlen, pstr, reserved, infoH, peerID] +handShakeMsg :: InfoDict -> String -> ByteString +handShakeMsg m peer_id = let pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8) + pstr = pack "BitTorrent protocol" + reserved = replicate 8 '\0' + infoH = infoHash m + peerID = pack peer_id + in concat [pstrlen, pstr, reserved, infoH, peerID] diff --git a/src/Tracker.hs b/src/Tracker.hs index dad05e6..65290c3 100644 --- a/src/Tracker.hs +++ b/src/Tracker.hs @@ -1,15 +1,17 @@ module Tracker where -import qualified Data.ByteString.Char8 as BC -import qualified Data.Map as M -import qualified Data.List as List -import qualified Network.HTTP as HTTP -import qualified Network.HTTP.Base as HB -import qualified Bencode as Benc -import qualified Crypto.Hash.SHA1 as SHA1 -import qualified Data.ByteString.Base16 as B16 -import qualified Utils as U -import Data.Char +import Prelude hiding (lookup) + +import Bencode (BVal(..), InfoDict, encode) +import Crypto.Hash.SHA1 (hash) +import Data.ByteString.Char8 (ByteString, pack, unpack) +import Data.Char (chr) +import Data.List (intercalate) +import Data.Map as M (Map, (!)) +import Network.HTTP (simpleHTTP, getRequest, getResponseBody) +import Network.HTTP.Base (urlEncode) +import Utils (splitN) +import qualified Data.ByteString.Base16 as B16 (encode) type Url = String @@ -17,37 +19,33 @@ type Url = String -- -- >>> urlEncodeHash $ BC.pack "123456789abcdef123456789abcdef123456789a" -- "%124vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a" -urlEncodeHash :: BC.ByteString -> String -urlEncodeHash bs = concatMap (encode . BC.unpack) (U.splitN 2 bs) - where encode b@[c1, c2] = let c = chr (read ("0x" ++ b)) - in - escape c c1 c2 - encode _ = "" +urlEncodeHash :: ByteString -> String +urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs) + where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b)) + in escape c c1 c2 + encode' _ = "" escape i c1 c2 | i `elem` nonSpecialChars = [i] | otherwise = "%" ++ [c1] ++ [c2] - where nonSpecialChars = ['A'..'Z'] ++ - ['a'..'z'] ++ - ['0'..'9'] ++ - "-_.~" -infoHash :: M.Map Benc.BVal Benc.BVal -> BC.ByteString -infoHash m = let info = m M.! Benc.Bstr (BC.pack "info") - in (SHA1.hash . BC.pack . Benc.encode) info + nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~" + +infoHash :: Map BVal BVal -> ByteString +infoHash m = let info = m M.! Bstr (pack "info") + in (hash . pack . encode) info -prepareRequest :: Benc.InfoDict -> String -> Integer -> String +prepareRequest :: InfoDict -> String -> Integer -> String prepareRequest d peer_id len = let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)), - ("peer_id", HB.urlEncode peer_id), + ("peer_id", urlEncode peer_id), ("port", "6881"), ("uploaded", "0"), ("downloaded", "0"), ("left", show len), ("compact", "1"), ("event", "started")] - in - List.intercalate "&" [f ++ "=" ++ s | (f,s) <- p] + in intercalate "&" [f ++ "=" ++ s | (f,s) <- p] connect :: Url -> String -> IO String connect baseurl qstr = let url = baseurl ++ "?" ++ qstr - in HTTP.simpleHTTP (HTTP.getRequest url) >>= - HTTP.getResponseBody + in simpleHTTP (getRequest url) >>= + getResponseBody -- 2.37.2