X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FBencode.hs;h=28f0460a828af94d7d47ca978ed3bf4e290f6980;hb=972e7a451abd851317146c196bc675fd11751fc8;hp=89446eabdb0d7fd19ad6abf5b36fa7c33db94bec;hpb=15ba08045c9aee398a808d7134f2111efae4f711;p=functorrent.git diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs index 89446ea..28f0460 100644 --- a/src/FuncTorrent/Bencode.hs +++ b/src/FuncTorrent/Bencode.hs @@ -1,24 +1,79 @@ +{- + - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan + - + - This file is part of FuncTorrent. + - + - FuncTorrent is free software; you can redistribute it and/or modify + - it under the terms of the GNU General Public License as published by + - the Free Software Foundation; either version 3 of the License, or + - (at your option) any later version. + - + - FuncTorrent is distributed in the hope that it will be useful, + - but WITHOUT ANY WARRANTY; without even the implied warranty of + - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + - GNU General Public License for more details. + - + - You should have received a copy of the GNU General Public License + - along with FuncTorrent; if not, see + -} + +{-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Bencode - (BVal(..), - InfoDict, - encode, - decode + (BVal(..) + , bValToInteger + , bstrToString + , decode + , encode ) where -import Control.Applicative ((<*)) -import Data.ByteString.Char8 (ByteString, pack, unpack) -import Data.Functor ((<$>)) -import Data.Map.Strict (Map, fromList, keys, (!)) +import Prelude hiding (length, concat) + +import Data.ByteString (ByteString, length, concat) +import Data.ByteString.Char8 (unpack, pack) +import Data.Char (isLetter, isAscii) +import Data.Map.Strict (Map, fromList, toList) import Text.ParserCombinators.Parsec import qualified Text.Parsec.ByteString as ParsecBS +import Test.QuickCheck data BVal = Bint Integer | Bstr ByteString | Blist [BVal] - | Bdict InfoDict + | Bdict (Map String BVal) deriving (Ord, Eq, Show) -type InfoDict = Map BVal BVal +genNonEmptyString :: Gen String +genNonEmptyString = arbitrary `suchThat` (\s -> ((s /= "") && + (all isAscii s) && + (all isLetter s))) + +instance Arbitrary ByteString where + arbitrary = pack <$> arbitrary + +instance Arbitrary BVal where + arbitrary = sized bval + where + bval :: Int -> Gen BVal + bval 0 = oneof [ Bint <$> arbitrary + , Bstr <$> arbitrary] + bval n = oneof [ Bint <$> arbitrary + , Bstr <$> arbitrary + , Blist <$> vectorOf n (bval (n `div` 4)) + , do keys <- vectorOf n genNonEmptyString + vals <- vectorOf n (bval (n `div` 4)) + return $ Bdict $ fromList $ zip keys vals ] + +-- getters +bValToInteger :: BVal -> Maybe Integer +bValToInteger (Bint x) = Just x +bValToInteger _ = Nothing + +bValToBytestr :: BVal -> Maybe ByteString +bValToBytestr (Bstr bs) = Just bs +bValToBytestr _ = Nothing + +bstrToString :: BVal -> Maybe String +bstrToString bval = unpack <$> bValToBytestr bval -- $setup -- >>> import Data.Either @@ -33,8 +88,7 @@ type InfoDict = Map BVal BVal -- Right "" -- bencStr :: ParsecBS.Parser ByteString -bencStr = do _ <- spaces - ds <- many1 digit <* char ':' +bencStr = do ds <- many1 digit <* char ':' s <- count (read ds) anyChar return (pack s) @@ -57,8 +111,7 @@ bencStr = do _ <- spaces -- >>> isLeft $ parse bencInt "Bint" (pack "i002e") -- True bencInt :: ParsecBS.Parser Integer -bencInt = do _ <- spaces - ds <- between (char 'i') (char 'e') numbers +bencInt = do ds <- between (char 'i') (char 'e') numbers return (read ds) where numbers = do d' <- char '-' <|> digit ds' <- many digit @@ -74,30 +127,34 @@ bencInt = do _ <- spaces -- >>> parse bencList "Blist" (pack "le") -- Right [] -- >>> parse bencList "Blist" (pack "l4:spam4:eggse") --- Right ["spam","eggs"] +-- Right [Bstr "spam",Bstr "eggs"] -- >>> parse bencList "Blist" (pack "l4:spami42ee") --- Right ["spam",42] +-- Right [Bstr "spam",Bint 42] -- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee") --- Right ["spam","eggs",[42]] +-- Right [Bstr "spam",Bstr "eggs",Blist [Bint 42]] bencList :: ParsecBS.Parser [BVal] -bencList = do _ <- spaces - between (char 'l') (char 'e') (many bencVal) +bencList = between (char 'l') (char 'e') (many bencVal) -- | parse dict -- -- >>> parse bencDict "Bdict" (pack "de") -- Right (fromList []) -- >>> parse bencDict "Bdict" (pack "d3:cow3:moo4:spam4:eggse") --- Right (fromList [("cow","moo"),("spam","eggs")]) +-- Right (fromList [("cow",Bstr "moo"),("spam",Bstr "eggs")]) -- >>> parse bencDict "Bdict" (pack "d4:spaml1:a1:bee") --- Right (fromList [("spam",["a","b"])]) +-- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])]) -- >>> 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 (Map BVal BVal) +-- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")]) +bencDict :: ParsecBS.Parser (Map String BVal) bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair - where kvpair = do k <- bencStr + where kvpair = do k <- bdictKey v <- bencVal - return (Bstr k, v) + return (k, v) + bdictKey = do + ds <- many1 digit <* char ':' + s <- count (read ds) alphaNum + return s + bencVal :: ParsecBS.Parser BVal bencVal = Bstr <$> bencStr <|> @@ -108,8 +165,12 @@ bencVal = Bstr <$> bencStr <|> decode :: ByteString -> Either ParseError BVal decode = parse bencVal "BVal" --- given an input dict or int or string, encode --- it into a bencoded bytestring. +-- Encode BVal into a bencoded ByteString. Inverse of decode + +-- TODO: Use builders and lazy byte string to get O(1) concatenation over O(n) +-- provided by lists. + +-- TODO: encode . decode pair might be a good candidate for Quickcheck. -- | encode bencoded-values -- -- >>> encode (Bstr (pack "")) @@ -124,13 +185,14 @@ decode = parse bencVal "BVal" -- "l4:spam4:eggse" -- >>> encode (Blist []) -- "le" --- >>> encode (Bdict (fromList [(Bstr $ pack "spam", Bstr $ pack "eggs")])) +-- >>> encode (Bdict (fromList [("spam", Bstr $ pack "eggs")])) -- "d4:spam4:eggse" -encode :: BVal -> String -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 ! k) | k <- keys m] +encode :: BVal -> ByteString +encode (Bstr bs) = pack $ show (length bs) ++ ":" ++ unpack bs +encode (Bint i) = pack $ "i" ++ show i ++ "e" +encode (Blist xs) = concat ["l", concat $ map encode xs, "e"] +encode (Bdict d) = concat ["d", concat kvlist, "e"] + where + kvlist :: [ByteString] + kvlist = [encPair kv | kv <- toList d] + encPair (k, v) = concat [encode (Bstr (pack k)), encode v]