bencInt = do _ <- spaces
ds <- between (char 'i') (char 'e') numbers
return (read ds)
- where numbers = do d' <- (char '-' <|> digit)
+ where numbers = do d' <- char '-' <|> digit
ds' <- many digit
parseNumber d' ds'
parseNumber '0' [] = return "0"
-- >>> parse bencDict "Bdict" (BC.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 = between (char 'd') (char 'e') $ M.fromList <$> many kvpair
where kvpair = do k <- bencStr
v <- bencVal
return (Bstr k, v)
in show (length s) ++ ":" ++ s
encode (Bint i) = "i" ++ show i ++ "e"
encode (Blist xs) = "l" ++ encodeList xs ++ "e"
- where encodeList [] = ""
- encodeList (x:xs') = encode x ++ encodeList xs'
+ where encodeList = foldr (++ encode x) ""
encode (Bdict d) = "d" ++ encodeDict d ++ "e"
where encodeDict m = concat [encode k ++ encode (m M.! k) | k <- M.keys m]
genPeerId = "-HS0001-20150215"
exit :: IO BC.ByteString
-exit = exitWith ExitSuccess
+exit = exitSuccess
usage :: IO ()
usage = putStrLn "usage: functorrent torrent-file"
-parse :: [String] -> IO (BC.ByteString)
+parse :: [String] -> IO BC.ByteString
parse [] = usage >> exit
parse [a] = BC.readFile a
parse _ = exit
main = do
args <- getArgs
torrentStr <- parse args
- case (Benc.decode torrentStr) of
- Right d -> case (MInfo.mkMetaInfo d) of
+ case Benc.decode torrentStr of
+ Right d -> case MInfo.mkMetaInfo d of
Nothing -> putStrLn "parse error"
Just m -> do
body <- BC.pack <$> T.connect (MInfo.announce m) (T.prepareRequest d genPeerId)
- putStrLn (show (P.getPeers (P.getPeerResponse body)))
+ print (P.getPeers (P.getPeerResponse body))
Left e -> printError e
putStrLn "done"
} 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"))
+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"))
+ (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'
in Just (BC.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"))
+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
getPeers = peers
getPeerResponse :: BC.ByteString -> PeerResp
-getPeerResponse body = case (Benc.decode body) of
+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"))
+ (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'
, incomplete = Nothing
}
where toPortNum = read . ("0x" ++) . BC.unpack . B16.encode
- toIPNum = (L.intercalate ".") .
+ toIPNum = L.intercalate "." .
map (show . toInt . ("0x" ++) . BC.unpack) .
- (U.splitN 2) . B16.encode
+ U.splitN 2 . B16.encode
_ -> PeerResponse { interval = Nothing
, peers = []
, complete = Nothing
-- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
urlEncode :: BC.ByteString -> String
urlEncode 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
+ 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"))
+infoHash :: M.Map Benc.BVal Benc.BVal -> BC.ByteString
+infoHash m = let info = m M.! Benc.Bstr (BC.pack "info")
in (B16.encode . SHA1.hash . BC.pack . Benc.encode) info
peerHash :: String -> BC.ByteString
-peerHash = (B16.encode . SHA1.hash . BC.pack)
+peerHash = B16.encode . SHA1.hash . BC.pack
prepareRequest :: Benc.BVal -> String -> String
prepareRequest (Benc.Bdict d) peer_id = let p = [("info_hash", urlEncode (infoHash d)),
in
List.intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
-connect :: Url -> String -> IO (String)
+connect :: Url -> String -> IO String
connect baseurl qstr = let url = baseurl ++ "?" ++ qstr
in HTTP.simpleHTTP (HTTP.getRequest url) >>=
HTTP.getResponseBody
splitN :: Int -> BC.ByteString -> [BC.ByteString]
splitN n bs | BC.null bs = []
- | otherwise = (BC.take n bs) : splitN n (BC.drop n bs)
+ | otherwise = BC.take n bs : splitN n (BC.drop n bs)