+{-
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - 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 <http://www.gnu.org/licenses/>
+ -}
+
{-# LANGUAGE OverloadedStrings #-}
module FuncTorrent.Bencode
- (BVal(..),
- InfoDict,
- bstrToString,
- encode,
- decode
+ (BVal(..)
+ , bValToInteger
+ , bstrToString
+ , decode
+ , encode
) where
import Prelude hiding (length, concat)
-import Control.Applicative ((<*))
import Data.ByteString (ByteString, length, concat)
import Data.ByteString.Char8 (unpack, pack)
-import Data.Functor ((<$>))
-import Data.Map.Strict (Map, fromList, keys, (!))
+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 String 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
-- 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)
-- >>> 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
-- >>> parse bencList "Blist" (pack "l4:spam4:eggsli42eee")
-- 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
--
-- 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",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
-bencDict :: ParsecBS.Parser InfoDict
+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 (unpack k, v)
+ return (k, v)
+ bdictKey = do
+ ds <- many1 digit <* char ':'
+ s <- count (read ds) anyChar
+ return s
+
bencVal :: ParsecBS.Parser BVal
bencVal = Bstr <$> bencStr <|>
encode :: BVal -> ByteString
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
+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]